Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-PW6_calypso.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-PW6_calypso.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-PW6_calypso.fcm	(revision 5682)
@@ -13,4 +13,6 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 
 
@@ -29,2 +31,4 @@
 %USER_INC            %NCDF_INC
 %USER_LIB            %NCDF_LIB 
+%CC                  xlc
+%CFLAGS              -O -qcpluscmt
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_debug.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_debug.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_debug.fcm	(revision 5682)
@@ -13,4 +13,6 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 
 
@@ -29,2 +31,4 @@
 %USER_INC            %NCDF_INC
 %USER_LIB            %NCDF_LIB 
+%CC                  xlc
+%CFLAGS              -O -qcpluscmt
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_tools.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_tools.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_tools.fcm	(revision 5682)
@@ -13,4 +13,6 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 
 
@@ -29,2 +31,4 @@
 %USER_INC            %NCDF_INC
 %USER_LIB            %NCDF_LIB 
+%CC                  xlc
+%CFLAGS              -O -qcpluscmt
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm	(revision 5682)
@@ -25,4 +25,6 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -56,2 +58,5 @@
 %USER_INC            %XIOS_INC %NCDF_INC %HDF5_INC
 %USER_LIB            %XIOS_LIB %NCDF_LIB %HDF5_LIB  -lnetcdff -lnetcdf -lstdc++ -lz -lcurl -lgpfs
+
+%CC                  cc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm	(revision 5682)
@@ -13,4 +13,6 @@
 # USER_INC additional include files for the compiler, e.g. -I<include dir>
 # USER_LIB additional libraries to pass to the linker, e.g. -l<library>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 
 
@@ -29,3 +31,5 @@
 %USER_INC %NCDF_INC
 %USER_LIB %NCDF_LIB
+%CC                  icc
+%CFLAGS              -O0
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm	(revision 5682)
@@ -13,4 +13,6 @@
 # USER_INC additional include files for the compiler, e.g. -I<include dir>
 # USER_LIB additional libraries to pass to the linker, e.g. -l<library>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 
 
@@ -29,3 +31,5 @@
 %USER_INC %NCDF_INC
 %USER_LIB %NCDF_LIB
+%CC                  icc
+%CFLAGS              -O0
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm	(revision 5682)
@@ -13,4 +13,6 @@
 # USER_INC additional include files for the compiler, e.g. -I<include dir>
 # USER_LIB additional libraries to pass to the linker, e.g. -l<library>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 
 
@@ -29,3 +31,5 @@
 %USER_INC %NCDF_INC
 %USER_LIB %NCDF_LIB
+%CC                  icc
+%CFLAGS              -O0
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm	(revision 5682)
@@ -25,4 +25,6 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -55,2 +57,4 @@
 %USER_INC            %XIOS_INC %NCDF_INC %HDF5_INC
 %USER_LIB            %XIOS_LIB %NCDF_LIB %HDF5_LIB
+%CC                  icc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm	(revision 5682)
@@ -15,15 +15,17 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir>
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 
 %NCDF_INC            -I/srv/lib/netcdf-x/include
 %NCDF_LIB            -L/srv/lib/netcdf-x/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lcurl -lstdc++
-%XIOS_ROOT           /home/delrosso/XIOS_447/trunk
+%XIOS_ROOT           /home/delrosso/XIOS_1.0/xios-1.0
 %MPI_INTEL           -I/srv/intel/impi/4.1.0.024/include
 %CPP                 cpp
 %FC                  mpiifort
-%FCFLAGS             -r8 -O3 -g -traceback 
+%FCFLAGS             -r8 -O1 -g -traceback -fp-model precise
 %FFLAGS              %FCFLAGS
 %LD                  mpiifort
-%LDFLAGS             
+%LDFLAGS
 %FPPFLAGS            -P -C -traditional
 %AR                  ar
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/OLD/arch-ifort_MERCATOR_CLUSTER.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/OLD/arch-ifort_MERCATOR_CLUSTER.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/OLD/arch-ifort_MERCATOR_CLUSTER.fcm	(revision 5682)
@@ -16,14 +16,17 @@
 
 %NCDF_INC            -I$NETCDF_INC
-%NCDF_LIB            -L $NETCDF_LIB -lnetcdf
+%NCDF_LIB            -L$NETCDF_LIB -lnetcdff -lnetcdf -L$HDF5_LIB -lhdf5_hl -lhdf5 -lz
+
+%CPP                 cpp
 %FC                  mpif90
-%FCFLAGS             -assume byterecl -convert big_endian -i4 -r8 -O2 -fp-model precise
+%FCFLAGS             -O2 -fp-model precise  -traceback -r8  -convert big_endian -assume byterecl
 %FFLAGS              %FCFLAGS
-%LD                  mpif90
+%LD                   mpif90
 %FPPFLAGS            -P -C -traditional
-%LDFLAGS             -O2 -shared-intel 
+%LDFLAGS             -O2
 %AR                  ar
-%ARFLAGS             -r
+%ARFLAGS             -rs
 %MK                  gmake
-%USER_INC            %NCDF_INC
-%USER_LIB            %NCDF_LIB
+%USER_INC            -I$XIOS_INC %NCDF_INC
+%USER_LIB            -L$XIOS_LIB -lxios %NCDF_LIB -lstdc++
+
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/OLD/arch-ifort_linux.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/OLD/arch-ifort_linux.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/OLD/arch-ifort_linux.fcm	(revision 5682)
@@ -17,5 +17,5 @@
 %NCDF_INC            -I/usr/local/netcdf/include 
 %NCDF_LIB            -L /usr/local/netcdf/lib -lnetcdf   
-%FC                  ifort
+%FC                  ifort 
 %FCFLAGS 	     -r8 -O3  -traceback 
 %FFLAGS 	     -r8 -O3  -traceback 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm	(revision 5682)
@@ -24,4 +24,6 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -58,2 +60,5 @@
 #FCFLAGS             -g -traceback -r8 -O0 -xT -ip -vec-report0
 #FFLAGS              -g -traceback -r8 -O0 -xT -ip -vec-report0
+
+%CC                  cc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm	(revision 5682)
@@ -17,4 +17,6 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -48,2 +50,5 @@
 %USER_INC            %XIOS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %NCDF_LIB %XLF90_LIB
+
+%CC                  xlc
+%CFLAGS              -O -qcpluscmt
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-PW7_METO.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-PW7_METO.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-PW7_METO.fcm	(revision 5682)
@@ -15,14 +15,16 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir>
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 
 
-%NCDF_INC            -I/home/cr/ocean/hadcv/netcdf/4.1.3_seq/include
-%NCDF_LIB            -L/home/cr/ocean/hadcv/netcdf/4.1.3_seq/lib -lnetcdf -lnetcdff -lhdf5 -lhdf5_hl -lhdf5_fortran -lz
-%XIOS_INC            -I/home/cr/ocean/hadcv/xios_lib/par/r521/xios/inc
-%XIOS_LIB            -L/home/cr/ocean/hadcv/xios_lib/par/r521/xios/lib -lxios
+%NCDF_INC            -I/home/cr/ocean/hadcv/netcdf/4.1.3_par/include
+%NCDF_LIB            -L/home/cr/ocean/hadcv/netcdf/4.1.3_par/lib -lnetcdf -lnetcdff -lhdf5 -lhdf5_hl -lhdf5_fortran -lz
+%XIOS_INC            -I/home/cr/ocean/hadcv/xios_lib/par/r618/xios/inc
+%XIOS_LIB            -L/home/cr/ocean/hadcv/xios_lib/par/r618/xios/lib -lxios
 %CPP	             cpp
 %FC                  mpxlf90_r
 %FCFLAGS             -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF
-%FFLAGS              -qrealsize=8 -qextname -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF -qfixed
+%FFLAGS             -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF
 %LD                  mpCC_r
 %LDFLAGS             -lxlf90 -L/projects/um1/lib -lsig -O2 -L MASS
@@ -33,2 +35,4 @@
 %USER_INC            %NCDF_INC %XIOS_INC
 %USER_LIB            %NCDF_LIB %XIOS_LIB
+%CC                  xlc
+%CFLAGS              -O -qcpluscmt
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm	(revision 5682)
@@ -15,4 +15,6 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir>
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 
 %NCDF_INC            -I/home/dcalve/netcdf/4.1.3_seq/include
@@ -32,2 +34,5 @@
 %USER_INC            %NCDF_INC %XIOS_INC
 %USER_LIB            %NCDF_LIB %XIOS_LIB
+
+%CC                  xlc
+%CFLAGS              -O -qcpluscmt
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_ADA.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_ADA.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_ADA.fcm	(revision 5682)
@@ -24,4 +24,6 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -32,5 +34,6 @@
 %HDF5_HOME           /smplocal/pub/HDF5/1.8.9/par
 %XIOS_HOME           $WORKDIR/XIOS
-%OASIS_HOME          /not/yet/defined
+####%OASIS_HOME          $WORKDIR/oasis3-mct/BLD
+%OASIS_HOME          /not/defined
 
 %NCDF_INC            -I%NCDF_HOME/include 
@@ -53,2 +56,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  icc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm	(revision 5682)
@@ -24,4 +24,6 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -53,2 +55,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  icc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_CURIE.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_CURIE.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_CURIE.fcm	(revision 5682)
@@ -24,4 +24,6 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -29,7 +31,7 @@
 #  - fcm variables are starting with a % (and not a $)
 #
-%NCDF_HOME           /usr/local/netcdf-4.2_hdf5_parallel
-%HDF5_HOME           /usr/local/hdf5-1.8.9_parallel
-%XIOS_HOME           $WORKDIR/now/models/xios
+%NCDF_HOME            /usr/local/netcdf-4.3.3.1_hdf5_parallel
+%HDF5_HOME           /usr/local/hdf5-1.8.12_parallel
+%XIOS_HOME           $WORKDIR/xios-1.0
 %OASIS_HOME          $WORKDIR/now/models/oa3mct
 
@@ -58,2 +60,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm	(revision 5682)
@@ -29,4 +29,6 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -36,5 +38,5 @@
 %NCDF_HOME           /home/acc/shared
 %HDF5_HOME           /home/acc/shared
-%XIOS_HOME           /home/acc/XIOS
+%XIOS_HOME           /home/acc/XIOS_1.0
 %OASIS_HOME          
 
@@ -58,2 +60,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_VAYU.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_VAYU.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_VAYU.fcm	(revision 5682)
@@ -24,4 +24,6 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -53,2 +55,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm	(revision 5682)
@@ -24,4 +24,6 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -53,2 +55,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-XC40_METO.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-XC40_METO.fcm	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-XC40_METO.fcm	(revision 5682)
@@ -0,0 +1,57 @@
+# compiler options for Archer CRAY XC-40 (using crayftn compiler)
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME           /opt/cray/netcdf-hdf5parallel/4.3.2/CRAY/83
+%HDF5_HOME           /opt/cray/hdf5-parallel/1.8.13/CRAY/83
+%XIOS_HOME           /projects/ocean/nemo/xios/xios_1.0_r618_20150619/XIOS
+
+%NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
+%NCDF_LIB            -L%HDF5_HOME/lib -L%NCDF_HOME/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+
+%CPP                 cpp
+%FC                  ftn
+%FCFLAGS             -emf -s real64 -s integer32  -O2 -hflex_mp=intolerant -Rb
+%FFLAGS              -emf -s real64 -s integer32  -O0 -hflex_mp=strict -Rb
+%LD                  ftn
+%FPPFLAGS            -P -E -traditional-cpp
+%LDFLAGS             -hbyteswapio 
+%AR                  ar 
+%ARFLAGS             -r
+%MK                  gmake
+
+%USER_INC            %XIOS_INC
+%USER_LIB            %XIOS_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-XC_ARCHER.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-XC_ARCHER.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-XC_ARCHER.fcm	(revision 5682)
@@ -24,4 +24,6 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -57,2 +59,5 @@
 #USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 #USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm	(revision 5682)
@@ -24,4 +24,6 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -55,2 +57,5 @@
 #USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 #USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-macport_osx.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-macport_osx.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-macport_osx.fcm	(revision 5682)
@@ -33,4 +33,6 @@
 # USER_INC    complete list of include files
 # USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 #
 # Note that:
@@ -40,5 +42,5 @@
 %NCDF_HOME           /opt/local
 %HDF5_HOME           /opt/local
-%XIOS_HOME           /Users/$( whoami )/XIOS
+%XIOS_HOME           /Users/$( whoami )/xios-1.0
 %OASIS_HOME          /not/defined
 
@@ -62,2 +64,5 @@
 %USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
 %USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm	(revision 5682)
@@ -13,4 +13,6 @@
 # USER_INC    additional include files for the compiler,  e.g. -I<include dir>
 # USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
 # debug: -g  -check bounds -check uninit -check pointers -traceback
 
@@ -31,2 +33,5 @@
 %USER_INC            -I$XIOS_INC %NCDF_INC
 %USER_LIB            -L$XIOS_LIB -lxios %NCDF_LIB -lstdc++
+
+%CC                  cc
+%CFLAGS              -O0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml	(revision 5682)
@@ -34,18 +34,19 @@
 
 	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       />
-	  <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          />
-	  <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                />
+	  <field field_ref="sst"          name="tos" />
+	  <field field_ref="sss"          name="sos" />
+	  <field field_ref="ssh"          name="zos" />
 	</file>
 
 	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    />
+	  <field field_ref="ssu"          name="uos" />
 	</file>
 	
 	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    />
+	  <field field_ref="ssv"          name="vos" />
 	</file>
 	
       </file_group>
+
       <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
 
@@ -53,34 +54,34 @@
 
 	<file id="file4" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <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="ssh2"         name="zossq"    long_name="square_of_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="mldkz5"       />
-	  <field field_ref="mldr10_1"     />
+	  <field field_ref="toce"         name="thetao" />
+	  <field field_ref="soce"         name="so"     />
+	  <field field_ref="sst"          name="tos"    />
+	  <field field_ref="sst2"         name="tossq"  />
+	  <field field_ref="sss"          name="sos"    />
+	  <field field_ref="ssh"          name="zos"    />
+	  <field field_ref="ssh2"         name="zossq"  />
+	  <field field_ref="empmr"        name="wfo"    />
+	  <field field_ref="qsr"          name="rsntds" />
+	  <field field_ref="qt"           name="tohfls" />
+	  <field field_ref="taum"     />
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
 	</file>
 	
 	<file id="file5" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
-	  <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    />
-	  <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" />
+	  <field field_ref="uoce"         name="uo"    />
+	  <field field_ref="ssu"          name="uos"   />
+	  <field field_ref="utau"         name="tauuo" />
 	</file>
 	
 	<file id="file6" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
-	  <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    />
-	  <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" />
+	  <field field_ref="voce"         name="vo"    />
+	  <field field_ref="ssv"          name="vos"   />
+	  <field field_ref="vtau"         name="tauvo" />
 	</file>
 	
 	<file id="file7" name_suffix="_grid_W" description="ocean W grid variables" >
-	  <field field_ref="woce"         name="wo"      long_name="ocean vertical velocity"         />
-	  <field field_ref="avt"          name="difvho"  long_name="ocean_vertical_heat_diffusivity" />
+	  <field field_ref="woce"         name="wo"     />
+	  <field field_ref="avt"          name="difvho" />
 	</file>
 	
@@ -107,10 +108,13 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
    </axis_definition> 
     
@@ -126,4 +130,7 @@
      <grid id="grid_W_2D" domain_ref="grid_W"/>
      <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
+     <grid id="gznl_T_2D" domain_ref="gznl"/>
+     <grid id="gznl_T_3D" domain_ref="gznl" axis_ref="deptht"/>
+     <grid id="gznl_W_3D" domain_ref="gznl" axis_ref="depthw"/>
     </grid_definition>   
   </context>
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg	(revision 5682)
@@ -99,4 +99,6 @@
    ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
    nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
+   ln_apr_dyn  = .false.    !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+
 /
 !-----------------------------------------------------------------------
@@ -129,5 +131,5 @@
 /
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
 !-----------------------------------------------------------------------
 /
@@ -158,10 +160,10 @@
 !          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
 !          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
-   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   '' , ''
+   sn_apr     = 'amm12_mslp'     ,          1        ,  'p_msl'      , .false.      , .false. , 'daily'   ,  ''      ,  ''  , ''
 
-   cn_dir      = './'       !  root directory for the location of the bulk files
-   rn_pref     = 101000._wp !  reference atmospheric pressure   [N/m2]/
+   cn_dir      = './fluxes/' !  root directory for the location of the bulk files
+   rn_pref     = 101000.     !  reference atmospheric pressure   [N/m2]/
    ln_ref_apr  = .false.    !  ref. pressure: global mean Patm (T) or a constant (F)
-   ln_apr_obc  = .false.    !  inverse barometer added to OBC ssh data
+   ln_apr_obc  = .true.    !  inverse barometer added to OBC ssh data
 /
 !-----------------------------------------------------------------------
@@ -355,4 +357,5 @@
 !-----------------------------------------------------------------------
    rn_charn =  100000.     !  Charnock constant for wb induced roughness length
+   nn_z0_met = 1           !  Method for surface roughness computation (0/1/2)
 /
 !-----------------------------------------------------------------------
@@ -393,10 +396,5 @@
 &namptr       !   Poleward Transport Diagnostic
 !-----------------------------------------------------------------------
-   ln_diaznl  = .false.    !  Add zonal means and meridional stream functions
-   ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not
-                           !  (orca configuration only, need input basins mask file named "subbasins.nc"
-   ln_ptrcomp = .false.    !  Add decomposition : overturning
-/
-!-----------------------------------------------------------------------
+/
 &namhsb       !  Heat and salt budgets
 !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/C1D_PAPA/EXP00/iodef.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/C1D_PAPA/EXP00/iodef.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/C1D_PAPA/EXP00/iodef.xml	(revision 5682)
@@ -34,19 +34,19 @@
 	  <field field_ref="empmr"        name="sowaflup"  />
 	  <field field_ref="qsr"          name="soshfldo"  />
-          <field field_ref="saltflx"      name="sosfldow"  />
+      <field field_ref="saltflx"      name="sosfldow"  />
 	  <field field_ref="qt"           name="sohefldo"  />
 	  <field field_ref="mldr10_1"     name="somxl010"  />
 	  <field field_ref="mldkz5"       name="somixhgt"  />
-        </file>
+    </file>
 	
 	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
           <field field_ref="uoce"         name="vozocrtx"  />
           <field field_ref="utau"         name="sozotaux"  />
-        </file>
+    </file>
 	
 	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
           <field field_ref="voce"         name="vomecrty"  /> 
           <field field_ref="vtau"         name="sometauy"  /> 
-        </file>
+    </file>
 	
 	<file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >
@@ -54,5 +54,5 @@
           <field field_ref="avt"          name="votkeavt" />
           <field field_ref="aht2d"        name="soleahtw" />
-        </file>
+    </file>
       </file_group>
 
@@ -72,19 +72,19 @@
 	  <field field_ref="empmr"        name="sowaflup"  />
 	  <field field_ref="qsr"          name="soshfldo"  />
-          <field field_ref="saltflx"      name="sosfldow"  />
+      <field field_ref="saltflx"      name="sosfldow"  />
 	  <field field_ref="qt"           name="sohefldo"  />
 	  <field field_ref="mldr10_1"     name="somxl010"  />
 	  <field field_ref="mldkz5"       name="somixhgt"  />
-        </file>
+    </file>
 	
 	<file id="file6" name_suffix="_grid_U" description="ocean U grid variables" >
           <field field_ref="uoce"         name="vozocrtx"  />
           <field field_ref="utau"         name="sozotaux"  />
-        </file>
+    </file>
 	
 	<file id="file7" name_suffix="_grid_V" description="ocean V grid variables" >
           <field field_ref="voce"         name="vomecrty"  /> 
           <field field_ref="vtau"         name="sometauy"  /> 
-        </file>
+    </file>
 	
 	<file id="file8" name_suffix="_grid_W" description="ocean W grid variables" >
@@ -92,5 +92,5 @@
           <field field_ref="avt"          name="votkeavt" />
           <field field_ref="aht2d"        name="soleahtw" />
-        </file>
+    </file>
       </file_group>
 
@@ -98,4 +98,5 @@
       <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
       <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->   
+
       <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
       <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
@@ -118,10 +119,13 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
    </axis_definition> 
     
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg	(revision 5682)
@@ -42,6 +42,6 @@
    nn_msh      =    0      !  create (=1) a mesh file or not (=0)
    rn_rdt      =  360.     !  time step for the dynamics (and tracer if nn_acc=0)
-   rn_rdtmin   =  360.           !  minimum time step on tracers (used if nn_acc=1)
-   rn_rdtmax   =  360.           !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdtmin   =  360.     !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   =  360.     !  maximum time step on tracers (used if nn_acc=1)
    jphgr_msh   =       1                 !  type of horizontal mesh
    ppglam0     =    -150.0               !  longitude of first raw and column T-point (jphgr_msh = 1)
@@ -102,6 +102,4 @@
 &namsbc_ana    !   analytical surface boundary condition
 !-----------------------------------------------------------------------
-   nn_tau000   =   100     !  gently increase the stress over the first ntau_rst time-steps
-   rn_utau0    =   0.1e0   !  uniform value for the i-stress
 /
 !-----------------------------------------------------------------------
@@ -126,5 +124,5 @@
    sn_prec     = 'forcing_PAPASTATION_1h' ,         1         , 'prec'    ,   .false.    , .false. , 'yearly' , '' , '', ''
    sn_snow     = 'forcing_PAPASTATION_1h' ,         1         , 'snow'    ,   .false.    , .false. , 'yearly' , '' , '', ''
-   ln_2m         = .true.    !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   rn_zqt      =  2.    !  air temperature and humidity referenced at 2m (T) instead 10m (F)
 /
 !-----------------------------------------------------------------------
@@ -133,5 +131,5 @@
 /
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
 !-----------------------------------------------------------------------
 /
@@ -219,4 +217,9 @@
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
+   nn_eos      =  0      !  type of equation of state and Brunt-Vaisala frequency
+                                 !  =-1, TEOS-10
+                                 !  = 0, EOS-80
+                                 !  = 1, S-EOS   (simplified eos)
+   ln_useCT    = .false. ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm
 /
 !-----------------------------------------------------------------------
@@ -241,6 +244,4 @@
 !-----------------------------------------------------------------------
    ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
-   nn_zdmp     =   -1      !  vertical   shape =0    damping throughout the water column
-   nn_file     =    1      !  create a damping.coeff NetCDF file (=1) or not (=0)
 /
 !-----------------------------------------------------------------------
@@ -257,4 +258,8 @@
 /
 !-----------------------------------------------------------------------
+&namc1d_dyndmp !   U & V newtonian damping                              ("key_c1d")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
 &namdyn_hpg    !   Hydrostatic pressure gradient option
 !-----------------------------------------------------------------------
@@ -271,7 +276,5 @@
 &namzdf        !   vertical physics
 !-----------------------------------------------------------------------
-!   rn_avm0     =   5.0e-6  !rbb 1.2e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
-!   rn_avt0     =   5.0e-6  !rbb 1.2e-5  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
-   ln_zdfevd   = .false. !rbb .true.    !  enhanced vertical diffusion (evd) (T) or not (F)
+   ln_zdfevd   = .false.        !  enhanced vertical diffusion (evd) (T) or not (F)
 /
 !-----------------------------------------------------------------------
@@ -290,5 +293,4 @@
 &namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
 !-----------------------------------------------------------------------
-   rn_clim_galp  = 0.267   !  galperin limit
 /
 !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE/EXP00/iodef.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE/EXP00/iodef.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE/EXP00/iodef.xml	(revision 5682)
@@ -42,28 +42,19 @@
 	  <field field_ref="empmr"        name="sowaflup"  />
 	  <field field_ref="qsr"          name="soshfldo"  />
-          <field field_ref="saltflx"      name="sosfldow"  />
+      <field field_ref="saltflx"      name="sosfldow"  />
 	  <field field_ref="qt"           name="sohefldo"  />
 	  <field field_ref="mldr10_1"     name="somxl010"  />
 	  <field field_ref="mldkz5"       name="somixhgt"  />
-           <!-- variables available with MLE
-          <field field_ref="Lf_NHpf"    name="Lf_NHpf"  long_name="MLE:_Lf=NH/f"     />
-	   -->
-       </file>
+    </file>
 	
 	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
           <field field_ref="uoce"         name="vozocrtx"  />
           <field field_ref="utau"         name="sozotaux"  />
-          <!-- variables available with MLE
-          <field field_ref="psiu_mle"     name="psiu_mle"  long_name="MLE_streamfunction_along_i-axis" />
-	  -->
-        </file>
+    </file>
 	
 	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
           <field field_ref="voce"         name="vomecrty"  /> 
           <field field_ref="vtau"         name="sometauy"  /> 
-          <!-- variables available with MLE
-          <field field_ref="psiv_mle"     name="psiv_mle"  long_name="MLE_streamfunction_along_j-axis" />
-	  -->
-        </file>
+    </file>
 	
 	<file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >
@@ -71,5 +62,5 @@
           <field field_ref="avt"          name="votkeavt" />
           <field field_ref="aht2d"        name="soleahtw" />
-        </file>
+    </file>
 
       </file_group>
@@ -95,10 +86,13 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
    </axis_definition> 
     
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg	(revision 5682)
@@ -116,5 +116,5 @@
 /
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
 !-----------------------------------------------------------------------
 /
@@ -245,6 +245,4 @@
 !-----------------------------------------------------------------------
    ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
-   nn_zdmp     =    1      !  vertical   shape =0    damping throughout the water column
-   nn_file     =    1      !  create a damping.coeff NetCDF file (=1) or not (=0)
 /
 !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_BFM/EXP00/iodef.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_BFM/EXP00/iodef.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_BFM/EXP00/iodef.xml	(revision 5682)
@@ -31,9 +31,7 @@
       <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>
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
       <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
-      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
-      </file_group>
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->   
 
       <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
@@ -57,10 +55,13 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
    </axis_definition> 
     
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg	(revision 5682)
@@ -121,5 +121,5 @@
 /
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
 !-----------------------------------------------------------------------
 /
@@ -244,6 +244,4 @@
 !-----------------------------------------------------------------------
    ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
-   nn_zdmp     =    1      !  vertical   shape =0    damping throughout the water column
-   nn_file     =    1      !  create a damping.coeff NetCDF file (=1) or not (=0)
 /
 !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/iodef.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/iodef.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/iodef.xml	(revision 5682)
@@ -43,11 +43,8 @@
 	  <field field_ref="empmr"        name="sowaflup"  />
 	  <field field_ref="qsr"          name="soshfldo"  />
-          <field field_ref="saltflx"      name="sosfldow"  />
+      <field field_ref="saltflx"      name="sosfldow"  />
 	  <field field_ref="qt"           name="sohefldo"  />
 	  <field field_ref="mldr10_1"     name="somxl010"  />
 	  <field field_ref="mldkz5"       name="somixhgt"  />
-           <!-- variables available with MLE
-          <field field_ref="Lf_NHpf"    name="Lf_NHpf"  long_name="MLE:_Lf=NH/f"     />
-	   -->
         </file>
 	
@@ -55,7 +52,4 @@
           <field field_ref="uoce"         name="vozocrtx"  />
           <field field_ref="utau"         name="sozotaux"  />
-          <!-- variables available with MLE
-          <field field_ref="psiu_mle"     name="psiu_mle"  long_name="MLE_streamfunction_along_i-axis" />
-	  -->
         </file>
 	
@@ -63,7 +57,4 @@
           <field field_ref="voce"         name="vomecrty"  /> 
           <field field_ref="vtau"         name="sometauy"  /> 
-          <!-- variables available with MLE
-          <field field_ref="psiv_mle"     name="psiv_mle"  long_name="MLE_streamfunction_along_j-axis" />
-	  -->
         </file>
 	
@@ -132,10 +123,13 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
    </axis_definition> 
     
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg	(revision 5682)
@@ -155,6 +155,4 @@
 !-----------------------------------------------------------------------
    ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
-   nn_zdmp     =    1      !  vertical   shape =0    damping throughout the water column
-   nn_file     =    1      !  create a damping.coeff NetCDF file (=1) or not (=0)
 /
 !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml	(revision 5682)
@@ -42,28 +42,19 @@
 	  <field field_ref="empmr"        name="sowaflup"  />
 	  <field field_ref="qsr"          name="soshfldo"  />
-          <field field_ref="saltflx"      name="sosfldow"  />
+      <field field_ref="saltflx"      name="sosfldow"  />
 	  <field field_ref="qt"           name="sohefldo"  />
 	  <field field_ref="mldr10_1"     name="somxl010"  />
 	  <field field_ref="mldkz5"       name="somixhgt"  />
-           <!-- variables available with MLE
-          <field field_ref="Lf_NHpf"    name="Lf_NHpf"  long_name="MLE:_Lf=NH/f"     />
-	   -->
-       </file>
+    </file>
 	
 	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
           <field field_ref="uoce"         name="vozocrtx"  />
           <field field_ref="utau"         name="sozotaux"  />
-          <!-- variables available with MLE
-          <field field_ref="psiu_mle"     name="psiu_mle"  long_name="MLE_streamfunction_along_i-axis" />
-	  -->
-        </file>
+    </file>
 	
 	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
           <field field_ref="voce"         name="vomecrty"  /> 
           <field field_ref="vtau"         name="sometauy"  /> 
-          <!-- variables available with MLE
-          <field field_ref="psiv_mle"     name="psiv_mle"  long_name="MLE_streamfunction_along_j-axis" />
-	  -->
-        </file>
+    </file>
 	
 	<file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >
@@ -71,5 +62,5 @@
           <field field_ref="avt"          name="votkeavt" />
           <field field_ref="aht2d"        name="soleahtw" />
-        </file>
+    </file>
 
       </file_group>
@@ -95,10 +86,13 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
    </axis_definition> 
     
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg	(revision 5682)
@@ -110,5 +110,5 @@
 /
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
 !-----------------------------------------------------------------------
 /
@@ -195,5 +195,5 @@
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
-   nn_eos      =   2       !  type of equation of state and Brunt-Vaisala frequency
+   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency
 /
 !-----------------------------------------------------------------------
@@ -216,6 +216,4 @@
 !-----------------------------------------------------------------------
    ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
-   nn_zdmp     =    1      !  vertical   shape =0    damping throughout the water column
-   nn_file     =    1      !  create a damping.coeff NetCDF file (=1) or not (=0)
 /
 !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg	(revision 5682)
@@ -6,5 +6,5 @@
 !-----------------------------------------------------------------------
    cn_exp      = "Agulhas" !  experience name 
-   nn_itend    =     480   !  last  time step
+   nn_itend    =   10950   !  last  time step
    nn_stock    =   10950   !  frequency of creation of a restart file (modulo referenced to 1)
    nn_write    =   10950   !  frequency of write in the output file   (modulo referenced to nn_it000)
@@ -94,13 +94,12 @@
    sn_snow     = 'ncar_precip.15JUNE2009_fill' ,        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
    sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the bulk files
-   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
    ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
-   ln_bulk2z   = .false.   !  Air temperature/humidity and wind vectors are referenced at heights rn_zqt and rn_zu
-   rn_zqt      = 3.        !  Air temperature and humidity reference height (m) (ln_bulk2z)
-   rn_zu       = 4.        !  Wind vector reference height (m)                  (ln_bulk2z)
+   rn_zqt      = 10.        !  Air temperature and humidity reference height (m)
+   rn_zu       = 10.        !  Wind vector reference height (m)
    rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
    rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.)
-   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity 
+   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity
                            !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
 /
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml	(revision 5682)
@@ -3,4 +3,155 @@
 
  <context id="nemo" time_origin="1950-01-01 00:00:00" >
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    <field_definition src="./field_def.xml"/>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE." >  <!-- 5d files -->  
+ 
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="e3t"                          />
+	  <field field_ref="toce"         name="thetao"                                                                      operation="instant" freq_op="5d" > @toce_e3t / @e3t </field>
+	  <field field_ref="soce"         name="so"                                                                          operation="instant" freq_op="5d" > @soce_e3t / @e3t </field>
+	  <field field_ref="sst"          name="tos"      />
+	  <field field_ref="sss"          name="sos"      />
+	  <field field_ref="ssh"          name="zos"      />
+	  <field field_ref="sst"          name="tosstd"       long_name="sea surface temperature standard deviation"         operation="instant" freq_op="5d" > sqrt( @sst2 - @sst * @sst ) </field>
+	  <field field_ref="ssh"          name="zosstd"       long_name="sea surface height above geoid standard deviation"  operation="instant" freq_op="5d" > sqrt( @ssh2 - @ssh * @ssh ) </field>
+	  <field field_ref="sst"          name="sstdcy"       long_name="amplitude of sst diurnal cycle"                     operation="average" freq_op="1d" > @sstmax - @sstmin </field>
+	  <field field_ref="mldkz5"                       />
+	  <field field_ref="mldr10_1"                     />
+	  <field field_ref="mldr10_1"     name="mldr10_1dcy"  long_name="amplitude of mldr10_1 diurnal cycle"                operation="average" freq_op="1d" > @mldr10_1max - @mldr10_1min </field>
+	  <field field_ref="empmr"        name="wfo"      />
+	  <field field_ref="qsr"          name="rsntds"   />
+	  <field field_ref="qt"           name="tohfls"   />
+	  <field field_ref="saltflx"      name="sosflxdo" />
+	  <field field_ref="taum"                         />
+	  <field field_ref="wspd"         name="sowindsp" />
+      <field field_ref="precip"       name="soprecip" />
+	  <field field_ref="sbt"                          />
+	</file>
+
+	<file id="file3" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="e3u"                       />
+	  <field field_ref="ssu"          name="uos"   />
+	  <field field_ref="uoce"         name="uo"      operation="instant" freq_op="5d" > @uoce_e3u / @e3u </field>
+	  <field field_ref="utau"         name="tauuo" />
+	</file>
+	
+	<file id="file4" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="e3v"                       />
+	  <field field_ref="ssv"          name="vos"   />
+	  <field field_ref="voce"         name="vo"      operation="instant" freq_op="5d" > @voce_e3v / @e3v </field>
+	  <field field_ref="vtau"         name="tauvo" />
+	</file>
+	
+	<file id="file5" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="e3w"                        />
+	  <field field_ref="woce"         name="wo"     />
+	  <field field_ref="avt"          name="difvho" />
+	</file>
+
+	<file id="file6" name_suffix="_icemod" description="ice variables" >
+	  <field field_ref="ice_pres"   />
+	  <field field_ref="snowthic_cea" name="snd" />
+	  <field field_ref="icethic_cea"  name="sit" />
+	  <field field_ref="iceprod_cea"  name="sip" />
+	  <field field_ref="ist_ipa"    />
+	  <field field_ref="uice_ipa"   />
+	  <field field_ref="vice_ipa"   />
+	  <field field_ref="utau_ice"   />
+	  <field field_ref="vtau_ice"   />
+	  <field field_ref="qsr_io_cea" />
+	  <field field_ref="qns_io_cea" />
+	  <field field_ref="snowpre"    />
+	</file>
+
+	<!--
+	<file id="file8" name_suffix="_Tides" description="tidal harmonics" >
+	  <field field_ref="M2x"          name="M2x"      long_name="M2 Elevation harmonic real part"                       />
+	  <field field_ref="M2y"          name="M2y"      long_name="M2 Elevation harmonic imaginary part"                  />
+	  <field field_ref="M2x_u"        name="M2x_u"    long_name="M2 current barotrope along i-axis harmonic real part "       />
+	  <field field_ref="M2y_u"        name="M2y_u"    long_name="M2 current barotrope along i-axis harmonic imaginary part "  />
+	  <field field_ref="M2x_v"        name="M2x_v"    long_name="M2 current barotrope along j-axis harmonic real part "       />
+	  <field field_ref="M2y_v"        name="M2y_v"    long_name="M2 current barotrope along j-axis harmonic imaginary part "  />
+	</file>
+	-->
+
+      </file_group>
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+    
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+   <axis_definition>  
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </axis_definition> 
+   
+   <domain_definition src="./domain_def.xml"/>
+   
+   <grid_definition>    
+     <grid id="grid_T_2D" domain_ref="grid_T"/>
+     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
+     <grid id="grid_U_2D" domain_ref="grid_U"/>
+     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
+     <grid id="grid_V_2D" domain_ref="grid_V"/>
+     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
+     <grid id="grid_W_2D" domain_ref="grid_W"/>
+     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
+     <grid id="gznl_T_2D" domain_ref="gznl"/>
+     <grid id="gznl_T_3D" domain_ref="gznl" axis_ref="deptht"/>
+     <grid id="gznl_W_3D" domain_ref="gznl" axis_ref="depthw"/>
+    </grid_definition>   
+  </context>
+  
+ <context id="1_nemo" time_origin="1950-01-01 00:00:00" >
     
     <!-- $id$ -->
@@ -54,5 +205,5 @@
 
 	<file id="file3" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    />
+	  <field field_ref="ssu"          name="uos"     long_name="sea_surface_x_velocity"    />
 	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
 	  <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" />
@@ -63,5 +214,5 @@
 	
 	<file id="file4" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    />
+	  <field field_ref="ssv"          name="vos"     long_name="sea_surface_y_velocity"    />
 	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
 	  <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" />
@@ -75,5 +226,5 @@
 	  <field field_ref="avt"          name="difvho"  long_name="ocean_vertical_heat_diffusivity" />
 	</file>
-
+<!--
 	<file id="file6" name_suffix="_icemod" description="ice variables" >
 	  <field field_ref="ice_pres"                     />
@@ -91,5 +242,4 @@
 	</file>
 
-	<!--
 	<file id="file8" name_suffix="_Tides" description="tidal harmonics" >
 	  <field field_ref="M2x"          name="M2x"      long_name="M2 Elevation harmonic real part"                       />
@@ -147,5 +297,4 @@
     </grid_definition>   
   </context>
-  
 
   <context id="xios">
@@ -156,5 +305,5 @@
         We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
 -->
-	  <variable id="buffer_size"               type="integer">5000000</variable>
+	  <variable id="buffer_size"               type="integer">50000000</variable>
 	  <variable id="buffer_server_factor_size" type="integer">2</variable>
 	  <variable id="info_level"                type="integer">0</variable>
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_ar5.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_ar5.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_ar5.xml	(revision 5682)
@@ -32,7 +32,7 @@
       <file_group id="1d" output_freq="1d"  enabled=".TRUE.">                      <!-- 1d files -->
 	<file id="file1" name_suffix="_grid_T_table2.2" >         <!-- grid T  -->
-	  <field field_ref="sst"          name='tos'      long_name="sea_surface_temperature"                              level="2"                      />
-	  <field field_ref="sst2"         name='tossq'    long_name="square_of_sea_surface_temperature"                    level="2"                      />
-	  <field field_ref="mldkz5"       name='omldamax' long_name="ocean_mixed_layer_thickness_defined_by_mixing_scheme" level="2" operation="maximum" />
+	  <field field_ref="sst"          name='tos'      long_name="sea_surface_temperature"                              level="2" />
+	  <field field_ref="sst2"         name='tossq'    long_name="square_of_sea_surface_temperature"                    level="2" />
+	  <field field_ref="mldkz5"       name='omldamax' long_name="ocean_mixed_layer_thickness_defined_by_mixing_scheme" standard_name="ocean_mixed_layer_thickness_defined_by_mixing_scheme" level="2" operation="maximum" />
 	</file>   
       </file_group>
@@ -40,21 +40,21 @@
 ++++++++++++++++++++++++++++++++++++++++++++++   monthly   +++++++++++++++++++++++++++++++++++++++++++++++++
 	  -->
-      <file_group id="1m" output_freq="1mo"     enabled=".TRUE.">                      <!-- real monthly files -->
+      <file_group id="1m" output_freq="1mo" enabled=".TRUE.">                      <!-- real monthly files -->
 	<!--
 ..............................................    grid T   .................................................
 	  -->	  
 	<file id="file2" name_suffix="_grid_T_table2.2" >
-	  <field field_ref="botpres"      name="pbo"      long_name="sea_water_pressure_at_sea_floor"                               />
+	  <field field_ref="botpres"      name="pbo"      long_name="sea_water_pressure_at_sea_floor" />
 	  <!-- pso : sea_water_pressure_at_sea_water_surface = 0 -->
-	  <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                                 />
-	  <field field_ref="ssh2"         name="zossq"    long_name="square_of_sea_surface_height_above_geoid"             level="2" />
-	  <!-- masscello : sea_water_mass_per_unit_area = cellthc*rau0                                          no time changes -->
-	  <field field_ref="cellthc"      name="thkcello" long_name="cell_thickness"                                                 /> <!-- no time changes -->
-	  <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"                                />
-	  <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                              level="1" />
-	  <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"                    level="2" />
-	  <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                                             />
-	  <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                                 level="1" />
-	  <field field_ref="rhop"         name="rhopoto"  long_name="sea_water_potential_density"                          level="2" />
+	  <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"  />
+	  <field field_ref="ssh2"         name="zossq"    long_name="square_of_sea_surface_height_above_geoid"  level="2" />
+	  <!-- masscello : sea_water_mass_per_unit_area = e3t*rau0                                          no time changes -->
+	  <field field_ref="e3t"          name="thkcello" long_name="cell_thickness"                  /> <!-- no time changes -->
+	  <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature" />
+	  <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                   level="1" />
+	  <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"         level="2" />
+	  <field field_ref="soce"         name="so"       long_name="sea_water_salinity"              />
+	  <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                      level="1" />
+	  <field field_ref="rhop"         name="rhopoto"  long_name="sea_water_potential_density"               level="2" />
 	  <!-- no agessc : sea_water_age_since_surface_contact -->
 	  <!-- no cfc11  : moles_per_unit_mass_of_cfc11_in_sea_water -->
@@ -62,17 +62,20 @@
 	  <!-- mlotst    :           ocean_mixed_layer_thickness_defined_by_sigma_t : must be done offline -->
 	  <!-- mlotstsq  : square_of_ocean_mixed_layer_thickness_defined_by_sigma_t : must be done offline -->
-	  <field field_ref="mldkz5"       name='omlmax'   long_name="ocean_mixed_layer_thickness_defined_by_mixing_scheme" level="2" operation="maximum" />
+	  <field field_ref="mldkz5"       name='omlmax'   long_name="ocean_mixed_layer_thickness_defined_by_mixing_scheme" standard_name="ocean_mixed_layer_thickness_defined_by_mixing_scheme" level="2" operation="maximum" />
 	</file>   
 	
 	<file id="file3" name_suffix="_grid_T_table2.5" >
-	  <field field_ref="rain"         name="pr"       long_name="rainfall_flux"                                           level="1" />
-	  <field field_ref="snow_ao_cea"  name="prsn"     long_name="snowfall_flux"                                           level="1" />
-	  <field field_ref="evap_ao_cea"  name="evs"      long_name="water_evaporation_flux"                                  level="1" />
-	  <field field_ref="runoffs"      name="friver"   long_name="water_flux_into_sea_water_from_rivers"                   level="1" />
-	  <field field_ref="calving"      name="ficeberg" long_name="water_flux_into_sea_water_from_icebergs"                 level="1" />
-	  <field field_ref="isnwmlt_cea"  name="fsitherm" long_name="water_flux_into_sea_water_due_to_sea_ice_thermodynamics" level="1" />
-	  <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                               level="1" />
+	  <field field_ref="rain"         name="pr"       long_name="rainfall_flux"                           level="1" />
+	  <field field_ref="snow_ao_cea"  name="prsn"     long_name="snowfall_flux"                           level="1" />
+	  <field field_ref="evap_ao_cea"  name="evs"      long_name="water_evaporation_flux"                  level="1" />
+	  <field field_ref="runoffs"      name="friver"   long_name="water_flux_into_sea_water_from_rivers"   level="1" />
+	  <field field_ref="calving_cea"  name="ficeberg" long_name="water_flux_into_sea_water_from_icebergs" level="1" />
+      <!-- Referenced variable "isnwmlt_cea" is snow melt flux only? -->
+	  <field field_ref="isnwmlt_cea"  name="fsitherm" long_name="water_flux_into_sea_water_due_to_sea_ice_thermodynamics" standard_name="water_flux_into_sea_water_due_to_sea_ice_thermodynamics" level="1" />
+	  <!-- Referenced variable "empmr" is positive upward, "wfo" is positive downward -->
+	  <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                               standard_name="water_flux_into_sea_water"                               level="1" />
 	  <!-- wfonocorr : water_flux_into_sea_water_without_flux_correction : emp - erp -->  
-	  <field field_ref="erp"          name="wfcorr"   long_name="water_flux_correction"                                   level="1" /> <!-- usually = 0 -->
+      <!-- Referenced variable "erp" is newtonian damping term -->
+	  <field field_ref="erp"          name="wfcorr"   long_name="water_flux_correction"                                   standard_name="water_flux_correction"                                   level="1" /> <!-- usually = 0 -->
 	</file>   
 	
@@ -84,5 +87,6 @@
 	  <!-- vsf      : virtual_salt_flux_into_sea_water = fsal_virtual + fsal_real -->
 	  <!-- wfcorr   : virtual_salt_flux_correction                        = 0 --> 
-	  <field field_ref="fsal_virt_cea" name="sfdsi"  long_name="downward_sea_ice_basal_salt_flux"                               level="1" />
+      <!-- Should be field_ref = "fsal_real_cea"? -->
+	  <field field_ref="fsal_virt_cea" name="sfdsi"  long_name="downward_sea_ice_basal_salt_flux" standard_name="downward_sea_ice_basal_salt_flux" level="1" />
 	  <!-- sfriver  : salt_flux_into_sea_water_from_rivers                = 0 --> 
 	</file>   
@@ -101,6 +105,8 @@
 	  <field field_ref="qns"           name="nshfls"      long_name="surface_net_downward_non_solar_flux"                                         level="1" />
 	  <field field_ref="qsr"           name="rsntds"      long_name="surface_net_downward_shortwave_flux"                                         level="1" />
+	  <!-- Should be name="rsdo" -->
 	  <field field_ref="qsr3d"         name="rsds"        long_name="downwelling_shortwave_flux_in_sea_water"                                     level="1" />
-	  <field field_ref="qrp"           name="hfcorr"      long_name="heat_flux_correction"                                                        level="1" />
+      <!-- Referenced variable "qrp" is newtonian damping term -->
+	  <field field_ref="qrp"           name="hfcorr"      long_name="heat_flux_correction" standard_name="heat_flux_correction"                   level="1" />
 	</file>   
 	<!--
@@ -108,13 +114,13 @@
 	-->
 	<file id="file6" name_suffix="_grid_U_table2.3" >
-	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"                                       />
-	  <field field_ref="u_masstr"     name="umo"     long_name="ocean_mass_x_transport"                           level="1" />
-	  <field field_ref="u_heattr"     name="hfx"     long_name="ocean_heat_x_transport"                           level="1" />
-	  <field field_ref="ueiv_heattr"  name="hfxba"   long_name="ocean_heat_x_transport_due_to_bolus_advection"    level="2" />
-	  <field field_ref="udiff_heattr" name="hfxdiff" long_name="ocean_heat_x_transport_due_to_diffusion"          level="2" />
+	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity" />
+	  <field field_ref="u_masstr"     name="umo"     long_name="ocean_mass_x_transport"                        level="1" />
+	  <field field_ref="u_heattr"     name="hfx"     long_name="ocean_heat_x_transport"                        level="1" />
+	  <field field_ref="ueiv_heattr"  name="hfxba"   long_name="ocean_heat_x_transport_due_to_bolus_advection" level="2" />
+	  <field field_ref="udiff_heattr" name="hfxdiff" long_name="ocean_heat_x_transport_due_to_diffusion"       level="2" />
 	</file>   
 	
 	<file id="file7" name_suffix="_grid_U_table2.8" >
-	  <field field_ref="utau"         name="tauuo" long_name="surface_downward_x_stress"                          level="1" />
+	  <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress"                     level="1" />
 	  <!-- tauucorr : surface_downward_x_stress_correction = 0 -->
 	</file>   
@@ -123,13 +129,13 @@
 	-->
 	<file id="file8" name_suffix="_grid_V_table2.3" >
-	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"                                       />
-	  <field field_ref="v_masstr"     name="vmo"     long_name="ocean_mass_y_transport"                           level="1" />
-	  <field field_ref="v_heattr"     name="hfy"     long_name="ocean_heat_y_transport"                           level="1" />
-	  <field field_ref="veiv_heattr"  name="hfyba"   long_name="ocean_heat_y_transport_due_to_bolus_advection"    level="2" />
-	  <field field_ref="vdiff_heattr" name="hfydiff" long_name="ocean_heat_y_transport_due_to_diffusion"          level="2" />
+	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity" />
+	  <field field_ref="v_masstr"     name="vmo"     long_name="ocean_mass_y_transport"                        level="1" />
+	  <field field_ref="v_heattr"     name="hfy"     long_name="ocean_heat_y_transport"                        level="1" />
+	  <field field_ref="veiv_heattr"  name="hfyba"   long_name="ocean_heat_y_transport_due_to_bolus_advection" level="2" />
+	  <field field_ref="vdiff_heattr" name="hfydiff" long_name="ocean_heat_y_transport_due_to_diffusion"       level="2" />
 	</file>   
 	
 	<file id="file9" name_suffix="_grid_V_table2.8" >
-	  <field field_ref="vtau"         name="tauvo" long_name="surface_downward_y_stress"                          level="1" />
+	  <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress"                     level="1" />
 	  <!-- tauvcorr : surface_downward_y_stress_correction = 0 -->
 	</file>   
@@ -138,19 +144,19 @@
 	-->
 	<file id="file10" name_suffix="_grid_W_table2.3" >
-	  <field field_ref="w_masstr"   name="wmo"   long_name="upward_ocean_mass_transport"                                    />
-	  <field field_ref="w_masstr2"  name="wmosq" long_name="square_pf_upward_ocean_mass_transport"                          />
+	  <field field_ref="w_masstr"   name="wmo"   long_name="upward_ocean_mass_transport"           />
+	  <field field_ref="w_masstr2"  name="wmosq" long_name="square_pf_upward_ocean_mass_transport" />
 	</file>   
 	
 	<file id="file11" name_suffix="_grid_W_table2.9" >
-	  <field field_ref="avt"     name="difvho"   long_name="ocean_vertical_heat_diffusivity"                  level="2" />
-	  <field field_ref="avs"     name="difvso"   long_name="ocean_vertical_salt_diffusivity"                  level="2" />
+	  <field field_ref="avt"     name="difvho"   long_name="ocean_vertical_heat_diffusivity"                level="2" />
+	  <field field_ref="avs"     name="difvso"   long_name="ocean_vertical_salt_diffusivity"                level="2" />
 	  <!-- difvtrbo : ocean_vertical_tracer_diffusivity_due_to_background : cte with time, see namelist parameters nn_avb and  nn_havtb -->
-	  <field field_ref="av_tide" name="difvtrto" long_name="ocean_vertical_tracer_diffusivity_due_to_tides"   level="2" />
+	  <field field_ref="av_tide" name="difvtrto" long_name="ocean_vertical_tracer_diffusivity_due_to_tides" level="2" />
 	  <!-- tnpeo     : tendency_of_ocean_potential_energy_content                   : not available -->
 	  <!-- tnpeot    : tendency_of_ocean_potential_energy_content_due_to_tides      : not available -->
 	  <!-- tnpeotb   : tendency_of_ocean_potential_energy_content_due_to_background : not available -->
-	  <field field_ref="avm"     name="difvmo"   long_name="ocean_vertical_momentum_diffusivity"              level="2" />
+	  <field field_ref="avm"     name="difvmo"   long_name="ocean_vertical_momentum_diffusivity"            level="2" />
 	  <!-- difvmbo : ocean_vertical_momentum_diffusivity_due_to_background : cte with time, see namelist parameters nn_avb -->
-	  <field field_ref="av_tide" name="difvmto"  long_name="ocean_vertical_momentum_diffusivity_due_to_tides" level="2" /> <!-- same as tracer -->
+	  <field field_ref="av_tide" name="difvmto"  long_name="ocean_vertical_momentum_diffusivity_due_to_tides" standard_name="ocean_vertical_momentum_diffusivity_due_to_tides" level="2" /> <!-- same as tracer -->
 	  <!-- difvmfdo : ocean_vertical_momentum_diffusivity_due_to_form_drag : ??? -->
 	  <!-- dispkevfo : ocean_kinetic_energy_dissipation_per_unit_area_due_to_vertical_friction : not available -->
@@ -159,5 +165,5 @@
 	<file id="file12" name_suffix="_grid_W_table2.10" >
 	  <!-- if ln_traldf_lap    =  .true. -->
-	  <field field_ref="aht2d_eiv" name="diftrblo" long_name="ocean_tracer_bolus_laplacian_diffusivity"                     level="2" />
+	  <field field_ref="aht2d_eiv" name="diftrblo" long_name="ocean_tracer_bolus_laplacian_diffusivity" level="2" />
 	  <!-- diftrelo : ocean_tracer_epineutral_laplacian_diffusivity : cte with time, see ln_traldf_iso -->
 	  <!-- diftrxylo : ocean_tracer_xy_laplacian_diffusivity : cte with time -->
@@ -175,11 +181,11 @@
 	-->
 	<file id="file13" name_suffix="_scalar_table2.2" >         <!-- scalar -->
-	  <field field_ref="masstot"    name="masso"    long_name="sea_water_mass"                                />
-	  <field field_ref="voltot"     name="volo"     long_name="sea_water_volume"                              />
-	  <field field_ref="sshtot"     name="zosga"    long_name="global_average_sea_level_change"               />
-	  <field field_ref="sshsteric"  name="zossga"   long_name="global_average_steric_sea_level_change"        />
-	  <field field_ref="sshthster"  name="zostoga"  long_name="global_average_thermosteric_sea_level_change"  />
-	  <field field_ref="temptot"    name="thetaoga" long_name="sea_water_potential_temperature"               />
-	  <field field_ref="saltot"     name="soga"     long_name="sea_water_salinity"                            />
+	  <field field_ref="masstot"    name="masso"    long_name="sea_water_mass"                               />
+	  <field field_ref="voltot"     name="volo"     long_name="sea_water_volume"                             />
+	  <field field_ref="sshtot"     name="zosga"    long_name="global_average_sea_level_change"              />
+	  <field field_ref="sshsteric"  name="zossga"   long_name="global_average_steric_sea_level_change"       />
+	  <field field_ref="sshthster"  name="zostoga"  long_name="global_average_thermosteric_sea_level_change" />
+	  <field field_ref="temptot"    name="thetaoga" long_name="sea_water_potential_temperature"              />
+	  <field field_ref="saltot"     name="soga"     long_name="sea_water_salinity"                           />
 	</file>   
 	<!--
@@ -187,26 +193,26 @@
 	-->
 	<file id="file14" name_suffix="_icemod_table2.2" >         <!-- scalar -->
-	  <field field_ref="ice_pres"                     />
-	  <field field_ref="ice_cover"    name="sic"        long_name="sea_ice_area_fraction"                            />
-	  <field field_ref="icethic_cea"  name="sit"        long_name="sea_ice_thickness"                                />
-	  <field field_ref="subl_ai_cea"  name="evap"       long_name="water_evaporation_flux"                           />
-	  <field field_ref="snowthic_cea" name="snd"        long_name="surface_snow_thickness"                           />
+	  <field field_ref="ice_pres" />
+	  <field field_ref="ice_cover"    name="sic"       long_name="sea_ice_area_fraction"                                           />
+	  <field field_ref="icethic_cea"  name="sit"       long_name="sea_ice_thickness"                                               />
+	  <field field_ref="subl_ai_cea"  name="evap"      long_name="water_evaporation_flux" standard_name="water_evaporation_flux"   />
+	  <field field_ref="snowthic_cea" name="snd"       long_name="surface_snow_thickness"                                          />
 	  <!-- snc : surface_snow_area_fraction : same as sic -->
-	  <field field_ref="icealb_cea"   name="ialb"       long_name="Bare Sea Ice Albedo"                              />
+	  <field field_ref="icealb_cea"   name="ialb"      long_name="Bare Sea Ice Albedo"                                             />
 	  <!-- ssi : Sea Ice Salinity : cte = sice = 6, expect in baltic sea = 2 -->
-	  <field field_ref="ist_cea"      name="tsice"      long_name="Surface Temperature of Sea Ice"                   />
+	  <field field_ref="ist_cea"      name="tsice"     long_name="Surface Temperature of Sea Ice"                                  />
 	  <!-- tsnint : Temperature at Interface Between Sea Ice and Snow : not available -->
 	  <!-- pr : Surface Rainfall Rate into the Sea Ice Portion of the Grid Cell = 0 -->
-	  <field field_ref="snow_ai_cea"  name="prsn"       long_name="Surface Snowfall Rate into the Sea Ice Portion of the Grid Cell" />
+	  <field field_ref="snow_ai_cea"  name="prsn"      long_name="Surface Snowfall Rate into the Sea Ice Portion of the Grid Cell" />
 	  <!-- ageice   : Age of Sea Ice : not available ??? -->
 	  <!-- grFrazil : Frazil Sea Ice Growth (Leads) Rate ??? -->
 	  <!-- grCongel : Congelation Sea Ice Growth Rate ??? -->
-	  <field field_ref="licepro_cea"  name="grLateral"  long_name="Lateral Sea Ice Growth Rate"                      />
-	  <field field_ref="sntoice_cea"  name="snoToIce"   long_name="Snow-Ice Formation Rate"                          />
-	  <field field_ref="snowmel_cea"  name="snomelt"    long_name="Snow Melt Rate"                                   />
-	  <field field_ref="ticemel_cea"  name="tmelt"      long_name="Rate of Melt at Upper Surface of Sea Ice"         />
-	  <field field_ref="bicemel_cea"  name="bmelt"      long_name="Rate of Melt at Sea Ice Base"                     />
+	  <field field_ref="licepro_cea"  name="grLateral" long_name="Lateral Sea Ice Growth Rate"                                     />
+	  <field field_ref="sntoice_cea"  name="snoToIce"  long_name="Snow-Ice Formation Rate"                                         />
+	  <field field_ref="snowmel_cea"  name="snomelt"   long_name="Snow Melt Rate"                                                  />
+	  <field field_ref="ticemel_cea"  name="tmelt"     long_name="Rate of Melt at Upper Surface of Sea Ice"                        />
+	  <field field_ref="bicemel_cea"  name="bmelt"     long_name="Rate of Melt at Sea Ice Base"                                    />
 	  <!-- hcice  : Sea Ice Total Heat Content ??? -->
-	  <field field_ref="qsr_ai_cea"   name="rsdssi"     long_name="surface_downwelling_shortwave_flux_in_air"        />
+	  <field field_ref="qsr_ai_cea"   name="rsdssi"    long_name="surface_downwelling_shortwave_flux_in_air"                       />
 	  <!-- rsussi : surface_upwelling_shortwave_flux_in_air ??? -->
 	  <!-- rldssi : surface_downwelling_longwave_flux_in_air ??? -->
@@ -214,10 +220,10 @@
 	  <!-- hfssi  : surface_upward_sensible_heat_flux ??? -->
 	  <!-- hflssi : surface_upward_latent_heat_flux ??? -->
-	  <field field_ref="subl_ai_cea"  name="sblsi"      long_name="surface_snow_and_ice_sublimation_flux"             />
-	  <field field_ref="u_imasstr"    name="transix"    long_name="Eastward Sea Ice Transport"                        />
-	  <field field_ref="v_imasstr"    name="transiy"    long_name="Northward Sea Ice Transport"                       />
-	  <field field_ref="fram_trans"   name="transifs"   long_name="Sea Ice Mass Transport Through Fram Strait"        />
-	  <field field_ref="utau_ice"     name="strairx"    long_name="Eastward Atmospheric Stress On Sea Ice"            />
-	  <field field_ref="vtau_ice"     name="strairy"    long_name="Northward Atmospheric Stress On Sea Ice"           />
+	  <field field_ref="subl_ai_cea"  name="sblsi"     long_name="surface_snow_and_ice_sublimation_flux"                           />
+	  <field field_ref="u_imasstr"    name="transix"   long_name="Eastward Sea Ice Transport"                                      />
+	  <field field_ref="v_imasstr"    name="transiy"   long_name="Northward Sea Ice Transport"                                     />
+	  <field field_ref="fram_trans"   name="transifs"  long_name="Sea Ice Mass Transport Through Fram Strait"                      />
+	  <field field_ref="utau_ice"     name="strairx"   long_name="Eastward Atmospheric Stress On Sea Ice"                          />
+	  <field field_ref="vtau_ice"     name="strairy"   long_name="Northward Atmospheric Stress On Sea Ice"                         />
 	  <!-- strocnx : Eastward Ocean Stress On Sea Ice ??? -->
 	  <!-- strocny : Northward Ocean Stress On Sea Ice ??? -->
@@ -243,11 +249,14 @@
 
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
-   </axis_definition> 
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </axis_definition>
     
    <domain_definition src="./domain_def.xml"/>
@@ -262,4 +271,7 @@
      <grid id="grid_W_2D" domain_ref="grid_W"/>
      <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
+     <grid id="gznl_T_2D" domain_ref="gznl"/>
+     <grid id="gznl_T_3D" domain_ref="gznl" axis_ref="deptht"/>
+     <grid id="gznl_W_3D" domain_ref="gznl" axis_ref="depthw"/>
     </grid_definition>    
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_crs.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_crs.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_crs.xml	(revision 5682)
@@ -34,15 +34,15 @@
 
 	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       />
-	  <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          />
-	  <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                />
+	  <field field_ref="sst"          name="tos" />
+	  <field field_ref="sss"          name="sos" />
+	  <field field_ref="ssh"          name="zos" />
 	</file>
 
 	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    />
+	  <field field_ref="ssu"          name="uos" />
 	</file>
 	
 	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    />
+	  <field field_ref="ssv"          name="vos" />
 	</file>
 	
@@ -54,50 +54,50 @@
 
 	<file id="file4" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <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="ssh2"         name="zossq"    long_name="square_of_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="mldkz5"       />
-	  <field field_ref="mldr10_1"     />
+	  <field field_ref="toce"         name="thetao" />
+	  <field field_ref="soce"         name="so"     />
+	  <field field_ref="sst"          name="tos"    />
+	  <field field_ref="sst2"         name="tossq"  />
+	  <field field_ref="sss"          name="sos"    />
+	  <field field_ref="ssh"          name="zos"    />
+	  <field field_ref="ssh2"         name="zossq"  />
+	  <field field_ref="empmr"        name="wfo"    />
+	  <field field_ref="qsr"          name="rsntds" />
+	  <field field_ref="qt"           name="tohfls" />
+	  <field field_ref="taum"     />
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
 	</file>
 	
 	<file id="file5" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
-	  <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    />
-	  <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" />
+	  <field field_ref="uoce"         name="uo"    />
+	  <field field_ref="ssu"          name="uos"   />
+	  <field field_ref="utau"         name="tauuo" />
 	</file>
 	
 	<file id="file6" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
-	  <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    />
-	  <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" />
+	  <field field_ref="voce"         name="vo"    />
+	  <field field_ref="ssv"          name="vos"   />
+	  <field field_ref="vtau"         name="tauvo" />
 	</file>
 	
 	<file id="file7" name_suffix="_grid_W" description="ocean W grid variables" >
-	  <field field_ref="woce"         name="wo"      long_name="ocean vertical velocity"         />
-	  <field field_ref="avt"          name="difvho"  long_name="ocean_vertical_heat_diffusivity" />
+	  <field field_ref="woce"         name="wo"     />
+	  <field field_ref="avt"          name="difvho" />
 	</file>
 	
 	<file id="file8" name_suffix="_icemod" description="ice variables" >
-	  <field field_ref="ice_pres"                     />
-	  <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"   />
-	  <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        />
-	  <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        />
-	  <field field_ref="ist_ipa"      />
-	  <field field_ref="ioceflxb"     />
-	  <field field_ref="uice_ipa"     />
-	  <field field_ref="vice_ipa"     />
-	  <field field_ref="utau_ice"     />
-	  <field field_ref="vtau_ice"     />
-	  <field field_ref="qsr_io_cea"   />
-	  <field field_ref="qns_io_cea"   />
-	  <field field_ref="snowpre"      />
+	  <field field_ref="ice_pres"   />
+	  <field field_ref="snowthic_cea" name="snd" />
+	  <field field_ref="icethic_cea"  name="sit" />
+	  <field field_ref="iceprod_cea"  name="sip" />
+	  <field field_ref="ist_ipa"    />
+	  <field field_ref="ioceflxb"   />
+	  <field field_ref="uice_ipa"   />
+	  <field field_ref="vice_ipa"   />
+	  <field field_ref="utau_ice"   />
+	  <field field_ref="vtau_ice"   />
+	  <field field_ref="qsr_io_cea" />
+	  <field field_ref="qns_io_cea" />
+	  <field field_ref="snowpre"    />
 	</file>
 	
@@ -124,9 +124,13 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
+      <axis id="deptht"  long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"      unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"     unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"      unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"  unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"  unit="degC"              />
    </axis_definition> 
     
@@ -142,4 +146,7 @@
      <grid id="grid_W_2D" domain_ref="grid_W"/>
      <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
+     <grid id="gznl_T_2D" domain_ref="gznl"/>
+     <grid id="gznl_T_3D" domain_ref="gznl" axis_ref="deptht"/>
+     <grid id="gznl_W_3D" domain_ref="gznl" axis_ref="depthw"/>
     </grid_definition>   
   </context>
@@ -169,15 +176,15 @@
 
 	<file id="file1" name_suffix="_gcrs_T" description="ocean T grid variables" >
-	  <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       />
-	  <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          />
-	  <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                />
+	  <field field_ref="sst"          name="tos" />
+	  <field field_ref="sss"          name="sos" />
+	  <field field_ref="ssh"          name="zos" />
 	</file>
 
 	<file id="file2" name_suffix="_gcrs_U" description="ocean U grid variables" >
-	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
+	  <field field_ref="uoce"         name="uo" />
 	</file>
 	
 	<file id="file3" name_suffix="_gcrs_V" description="ocean V grid variables" >
-	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
+	  <field field_ref="voce"         name="vo" />
 	</file>
 	
@@ -187,26 +194,26 @@
 
 	<file id="file4" name_suffix="_gcrs_T" description="ocean T grid variables" >
-	  <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="sss"          name="sos"      long_name="sea_surface_salinity"                          />
-	  <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                />
-          <field field_ref="eken"         name="eke"      long_name="Kinetic energy"/>
+	  <field field_ref="toce"         name="thetao" />
+	  <field field_ref="soce"         name="so"     />
+	  <field field_ref="sst"          name="tos"    />
+	  <field field_ref="sss"          name="sos"    />
+	  <field field_ref="ssh"          name="zos"    />
+      <field field_ref="eken"         name="eke"    />
 	</file>
 	
 	<file id="file5" name_suffix="_gcrs_U" description="ocean U grid variables" >
-	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
-	  <field field_ref="uocet"         />
-	  <field field_ref="uoces"         />
+	  <field field_ref="uoce"         name="uo" />
+	  <field field_ref="uocet" />
+	  <field field_ref="uoces" />
 	</file>
 	
 	<file id="file6" name_suffix="_gcrs_V" description="ocean V grid variables" >
-	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
-	  <field field_ref="vocet"         />
-	  <field field_ref="voces"         />
+	  <field field_ref="voce"         name="vo" />
+	  <field field_ref="vocet" />
+	  <field field_ref="voces" />
 	</file>
 	
 	<file id="file7" name_suffix="_gcrs_W" description="ocean W grid variables" >
-	  <field field_ref="woce"         name="wo"      long_name="ocean vertical velocity"         />
+	  <field field_ref="woce"         name="wo" />
 	</file>
 
@@ -233,9 +240,14 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-   </axis_definition> 
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </axis_definition>
     
    <domain_definition src="./domain_def.xml"/>
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_default.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_default.xml	(revision 5659)
+++ 	(revision )
@@ -1,170 +1,0 @@
-<?xml version="1.0"?>
-<simulation> 
-
- <context id="nemo" time_origin="1950-01-01 00:00:00" >
-    
-    <!-- $id$ -->
-    
-    <!-- 
-============================================================================================================
-=                                  definition of all existing variables                                    =
-=                                            DO NOT CHANGE                                                 =
-============================================================================================================
-    -->
-    <field_definition src="./field_def.xml"/>
-    <!-- 
-============================================================================================================
-=                                           output files definition                                        =
-=                                            Define your own files                                         =
-=                                         put the variables you want...                                    =
-============================================================================================================
-    -->
-    
-    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
-    
-      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
-      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
-      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
-      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
-      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
-      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->     
-      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
-      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
-
-      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE." >  <!-- 5d files -->  
- 
-	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       />
-	  <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          />
-	  <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                />
-	  <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"               />
-	  <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                            />
-	  <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             />
-	  <field field_ref="ssh2"         name="zossq"    long_name="square_of_sea_surface_height_above_geoid"      />
-	  <field field_ref="mldkz5"       />
-	  <field field_ref="mldr10_1"     />
-	  <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     />
-	  <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           />
-	  <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          />
-	  <field field_ref="saltflx"      name="sosflxdo"  />
-	  <field field_ref="taum"         name="taum" />
-	  <field field_ref="wspd"         name="sowindsp"  />
-          <field field_ref="precip"       name="soprecip" />
-	</file>
-
-	<file id="file3" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    />
-	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
-	  <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" />
-          <!-- variables available with MLE
-          <field field_ref="psiu_mle"     name="psiu_mle"  long_name="MLE_streamfunction_along_i-axis" />
-	  -->
-	</file>
-	
-	<file id="file4" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    />
-	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
-	  <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" />
-          <!-- variables available with MLE
-          <field field_ref="psiv_mle"     name="psiv_mle"  long_name="MLE_streamfunction_along_j-axis" />
-	  -->
-	</file>
-	
-	<file id="file5" name_suffix="_grid_W" description="ocean W grid variables" >
-	  <field field_ref="woce"         name="wo"      long_name="ocean vertical velocity"         />
-	  <field field_ref="avt"          name="difvho"  long_name="ocean_vertical_heat_diffusivity" />
-	</file>
-
-	<file id="file6" name_suffix="_icemod" description="ice variables" >
-	  <field field_ref="ice_pres"                     />
-	  <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"   />
-	  <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        />
-	  <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        />
-	  <field field_ref="ist_ipa"      />
-	  <field field_ref="ioceflxb"     />
-	  <field field_ref="uice_ipa"     />
-	  <field field_ref="vice_ipa"     />
-	  <field field_ref="utau_ice"     />
-	  <field field_ref="vtau_ice"     />
-	  <field field_ref="qsr_io_cea"   />
-	  <field field_ref="qns_io_cea"   />
-	  <field field_ref="snowpre"      />
-	</file>
-
-	<!--
-	<file id="file8" name_suffix="_Tides" description="tidal harmonics" >
-	  <field field_ref="M2x"          name="M2x"      long_name="M2 Elevation harmonic real part"                       />
-	  <field field_ref="M2y"          name="M2y"      long_name="M2 Elevation harmonic imaginary part"                  />
-	  <field field_ref="M2x_u"        name="M2x_u"    long_name="M2 current barotrope along i-axis harmonic real part "       />
-	  <field field_ref="M2y_u"        name="M2y_u"    long_name="M2 current barotrope along i-axis harmonic imaginary part "  />
-	  <field field_ref="M2x_v"        name="M2x_v"    long_name="M2 current barotrope along j-axis harmonic real part "       />
-	  <field field_ref="M2y_v"        name="M2y_v"    long_name="M2 current barotrope along j-axis harmonic imaginary part "  />
-	</file>
-	-->
-      </file_group>
-
-
-      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
-
-
-      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
-      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
-      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
-      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
-
-      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
-      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
-      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
-      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
-
-   </file_definition>
-    
-    <!-- 
-============================================================================================================
-= grid definition = = DO NOT CHANGE =
-============================================================================================================
-    -->
-    
-   <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
-   </axis_definition> 
-    
-   <domain_definition src="./domain_def.xml"/>
-   
-   <grid_definition>    
-     <grid id="grid_T_2D" domain_ref="grid_T"/>
-     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
-     <grid id="grid_U_2D" domain_ref="grid_U"/>
-     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
-     <grid id="grid_V_2D" domain_ref="grid_V"/>
-     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
-     <grid id="grid_W_2D" domain_ref="grid_W"/>
-     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
-    </grid_definition>   
-  </context>
-  
-
-  <context id="xios">
-
-      <variable_definition>
-	
-     <!-- 
-        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
--->
-	  <variable id="buffer_size"               type="integer">5000000</variable>
-	  <variable id="buffer_server_factor_size" type="integer">2</variable>
-	  <variable id="info_level"                type="integer">0</variable>
-	  <variable id="using_server"              type="boolean">false</variable>
-	  <variable id="using_oasis"               type="boolean">false</variable>
-	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
-	
-      </variable_definition>
-               
-  </context>
-  
-</simulation>
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_demo.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_demo.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_demo.xml	(revision 5682)
@@ -64,5 +64,5 @@
 	  <field field_ref="sst"    name="sst_1d_inst" operation="instant" />     <!-- instant value -->
 	  <field field_ref="sst"    name="sst_1d_max"  operation="maximum" />     <!-- max -->
-	  <field field_ref="suoce"  />   <!-- include a U-grid variable in the list -->
+	  <field field_ref="ssu"  />   <!-- include a U-grid variable in the list -->
 	</file>
 	
@@ -78,13 +78,16 @@
     
    <axis_definition>  
-     <axis_group id="deptht" long_name="Vertical T levels" unit="m" positive="down" >
-       <axis id="deptht" />
-       <axis id="deptht_myzoom" zoom_begin="1" zoom_end="10" />
-     </axis_group>
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
+      <axis_group id="deptht" long_name="Vertical T levels" unit="m" positive="down" > 
+         <axis id="deptht" /> 
+         <axis id="deptht_myzoom" zoom_begin="1" zoom_end="10" /> 
+      </axis_group>
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
    </axis_definition> 
     
@@ -100,4 +103,7 @@
      <grid id="grid_W_2D" domain_ref="grid_W"/>
      <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
+     <grid id="gznl_T_2D" domain_ref="gznl"/>
+     <grid id="gznl_T_3D" domain_ref="gznl" axis_ref="deptht"/>
+     <grid id="gznl_W_3D" domain_ref="gznl" axis_ref="depthw"/>
     </grid_definition>    
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_oldstyle.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_oldstyle.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_oldstyle.xml	(revision 5682)
@@ -111,11 +111,14 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
-   </axis_definition> 
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </axis_definition>
     
    <domain_definition src="./domain_def.xml"/>
@@ -130,4 +133,7 @@
      <grid id="grid_W_2D" domain_ref="grid_W"/>
      <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
+     <grid id="gznl_T_2D" domain_ref="gznl"/>
+     <grid id="gznl_T_3D" domain_ref="gznl" axis_ref="deptht"/>
+     <grid id="gznl_W_3D" domain_ref="gznl" axis_ref="depthw"/>
     </grid_definition>   
   </context>
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg	(revision 5682)
@@ -189,5 +189,5 @@
 /
 !-----------------------------------------------------------------------
-&namobs       !  observation usage                                      ('key_diaobs')
+&namobs       !  observation usage
 !-----------------------------------------------------------------------
 /
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/README
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/README	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/README	(revision 5682)
@@ -2,5 +2,16 @@
 # prerequired
 #----------------------------------------------------------------------
-To use these idl tools, you need to download some climatogies and mask files;
+First, you need either :
+- IDL (version 6.4 or above), see : http://www.exelisvis.com/ProductsServices/IDL.aspx
+  In this case, you also need to download SAXO which is a free package of IDL scripts:
+  define $PATH_SAXO, the path where you will download SAXO and get it through svn with the following command.
+  > PATH_SAXO=...
+  > svn checkout http://forge.ipsl.jussieu.fr/saxo/svn/trunk/SRC $PATH_SAXO/SAXO_DIR/SRC
+
+- or the IDL Virtual Machine which is free to use and does not require a license to run , see :
+  http://www.exelisvis.com/Support/HelpArticlesDetail/TabId/219/ArtMID/900/ArticleID/12395/The-IDL-Virtual-Machine.aspx
+  the virtual machine requites std_main.sav that is distributed with this README.
+
+Next, to use these idl tools, you need to download some climatogies and mask files;
 that you can find here: http://dodsp.idris.fr/reee512/NEMO_OUT/ORCA2_LIM/
 
@@ -13,14 +24,13 @@
 # define your std_plot_vardef.sh or std_ts_vardef.sh file
 #----------------------------------------------------------------------
-Use the examples provided in :
+These files are needed to define your PATHs, the experiments and variables names you used in your experiment.
+ - std_plot_vardef.sh is used to do all plots based on temporal mean (maps, vertical profiles...).
+ - std_ts_vardef.sh is used to do all time-series type of plot.
+
+To build you own std_plot_vardef.sh or std_ts_vardef.sh file; use the examples provided such as:
  - std_ts_vardef.sh_example1 or std_ts_vardef.sh_example2
  - std_plot_vardef.sh_example1 or std_plot_vardef.sh_example2
-to build your own std_plot_vardef.sh or std_ts_vardef.sh file.
 
-This file is needed to define you PATH, the experiments and variables names
-
-you can copy std_ts_vardef.sh_example1 con std_ts_vardef.sh
-and std_plot_vardef.sh_example1 std_plot_vardef.sh
-
+Note that if you use the IDL Virtual Machine, the variable SAXO_DIR defined in std_plot_vardef.sh or std_ts_vardef.sh is not used. Any definition will be ok.
 
 #----------------------------------------------------------------------
@@ -32,6 +42,13 @@
 
 
-#----------------------------------------------------------------------
-# short note on: How to build IDL virtual Machine:
+
+
+##########################################################################################################
+# short note for developers of this package on:
+#                   How to build the tarball required for IDL virtual Machine:
+##########################################################################################################
+#
+# we need to recreate std_main.sav as soon as we change IDL programmes files as
+# std_main.sav contains all ".pro" files aready compiled to be used with the virtual machine
 #
 . ./std_plot_vardef.sh # or . ./std_ts_vardef.sh 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb0
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb0	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb0	(revision 5682)
@@ -114,5 +114,5 @@
 export VAR1_Ithick  V1It_PREF    V1It_SUFF
 export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF
-export VAR1_IvelV   V1IvV_PREF   V1IvV_PREF
+export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF
 #===================== EXP2 =====================
 export DATE1_2      DATE2_2
@@ -127,4 +127,4 @@
 export VAR2_Ithick  V2It_PREF    V2It_SUFF
 export VAR2_SNOW    V2SNOW_PREF  V2SNOW_SUFF
-export VAR2_IvelV   V2IvV_PREF   V2IvV_PREF
+export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF
 #
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb2
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb2	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb2	(revision 5682)
@@ -114,5 +114,5 @@
 export VAR1_Ithick  V1It_PREF    V1It_SUFF
 export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF
-export VAR1_IvelV   V1IvV_PREF   V1IvV_PREF
+export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF
 #===================== EXP2 =====================
 export DATE1_2      DATE2_2
@@ -127,4 +127,4 @@
 export VAR2_Ithick  V2It_PREF    V2It_SUFF
 export VAR2_SNOW    V2SNOW_PREF  V2SNOW_SUFF
-export VAR2_IvelV   V2IvV_PREF   V2IvV_PREF
+export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF
 #
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example1
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example1	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example1	(revision 5682)
@@ -112,5 +112,5 @@
 export VAR1_Ithick  V1It_PREF    V1It_SUFF
 export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF
-export VAR1_IvelV   V1IvV_PREF   V1IvV_PREF
+export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF
 #===================== EXP2 =====================
 export DATE1_2      DATE2_2
@@ -125,4 +125,4 @@
 export VAR2_Ithick  V2It_PREF   V2It_SUFF
 export VAR2_SNOW    V2SNOW_PREF V2SNOW_SUFF
-export VAR2_IvelV   V2IvV_PREF   V2IvV_PREF
+export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF
 #
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example2
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example2	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example2	(revision 5682)
@@ -112,5 +112,5 @@
 export VAR1_Ithick  V1It_PREF    V1It_SUFF
 export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF
-export VAR1_IvelV   V1IvV_PREF   V1IvV_PREF
+export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF
 #===================== EXP2 =====================
 export DATE1_2      DATE2_2
@@ -125,4 +125,4 @@
 export VAR2_Ithick  V2It_PREF   V2It_SUFF
 export VAR2_SNOW    V2SNOW_PREF V2SNOW_SUFF
-export VAR2_IvelV   V2IvV_PREF   V2IvV_PREF
+export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF
 #
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm	(revision 5682)
@@ -1,1 +1,1 @@
-bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc
+bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_asminc 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg	(revision 5682)
@@ -94,13 +94,12 @@
    sn_snow     = 'ncar_precip.15JUNE2009_fill' ,        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
    sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the bulk files
-   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
    ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
-   ln_bulk2z   = .false.   !  Air temperature/humidity and wind vectors are referenced at heights rn_zqt and rn_zu
-   rn_zqt      = 3.        !  Air temperature and humidity reference height (m) (ln_bulk2z)
-   rn_zu       = 4.        !  Wind vector reference height (m)                  (ln_bulk2z)
+   rn_zqt      = 10.        !  Air temperature and humidity reference height (m)
+   rn_zu       = 10.        !  Wind vector reference height (m)
    rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
    rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.)
-   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity 
+   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity
                            !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
 /
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml	(revision 5682)
@@ -35,72 +35,82 @@
       <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="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
+      
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->
+      
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
+	
 	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       />
-	  <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          />
-	  <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                />
-	  <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"               />
-	  <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                            />
-	  <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             />
-	  <field field_ref="ssh2"         name="zossq"    long_name="square_of_sea_surface_height_above_geoid"      />
-	  <field field_ref="mldkz5"       />
-	  <field field_ref="mldr10_1"     />
-      <field field_ref="heatc"        name="heatc"    long_name="Heat content vertically integrated"            />
-      <field field_ref="saltc"        name="saltc"    long_name="Salt content vertically integrated"            />
+	  <field field_ref="e3t"      />
+	  <field field_ref="toce"         name="thetao"                                                                      operation="instant" freq_op="5d" > @toce_e3t / @e3t </field>
+	  <field field_ref="soce"         name="so"                                                                          operation="instant" freq_op="5d" > @soce_e3t / @e3t </field>
+	  <field field_ref="sst"          name="tos"   />
+	  <field field_ref="sss"          name="sos"   />
+	  <field field_ref="ssh"          name="zos"   />
+	  <field field_ref="sst"          name="tosstd"       long_name="sea surface temperature standard deviation"         operation="instant" freq_op="5d" > sqrt( @sst2 - @sst * @sst ) </field>
+	  <field field_ref="ssh"          name="zosstd"       long_name="sea surface height above geoid standard deviation"  operation="instant" freq_op="5d" > sqrt( @ssh2 - @ssh * @ssh ) </field>
+	  <field field_ref="sst"          name="sstdcy"       long_name="amplitude of sst diurnal cycle"                     operation="average" freq_op="1d" > @sstmax - @sstmin </field>
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
+	  <field field_ref="mldr10_1"     name="mldr10_1dcy"  long_name="amplitude of mldr10_1 diurnal cycle"                operation="average" freq_op="1d" > @mldr10_1max - @mldr10_1min </field>
+	  <field field_ref="sbt"      />
+	  <field field_ref="heatc"        name="heatc" />
+	  <field field_ref="saltc"        name="saltc" />
 	</file>
 
 	<file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc -->
-	  <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     />
-	  <field field_ref="qsr_oce"      name="qsr_oce"  long_name="downward shortwave flux at ocean surface"           />
-	  <field field_ref="qns_oce"      name="qns_oce"  long_name="downward non solar flux at ocean surface"           />
-	  <field field_ref="qt_oce"       name="qt_oce"   long_name="downward total flux at ocean surface"           />
-	  <field field_ref="qsr_ice"      name="qsr_ice"  long_name="downward shortwave flux at ice surface"           />
-	  <field field_ref="qns_ice"      name="qns_ice"  long_name="downward non solar flux at ice surface"           />
-	  <field field_ref="qtr_ice"      name="qtr_ice"  long_name="shortwave flux transmitted thru the ice"           />
-	  <field field_ref="qt_ice"       name="qt_ice"   long_name="downward total flux at ice surface"           />
-	  <field field_ref="saltflx"      name="sfx"  />
-	  <field field_ref="taum"         name="taum" />
-	  <field field_ref="wspd"         name="windsp"  />
-      <field field_ref="precip"       name="precip" />
+	  <field field_ref="empmr"        name="wfo"      />
+	  <field field_ref="qsr_oce"      name="qsr_oce"  />
+	  <field field_ref="qns_oce"      name="qns_oce"  />
+	  <field field_ref="qt_oce"       name="qt_oce"   />
+	  <field field_ref="qsr_ice"      name="qsr_ice"  />
+	  <field field_ref="qns_ice"      name="qns_ice"  />
+	  <field field_ref="qtr_ice"      name="qtr_ice"  />
+	  <field field_ref="qt_ice"       name="qt_ice"   />
+	  <field field_ref="saltflx"      name="sfx"      />
+	  <field field_ref="taum"         name="taum"     />
+	  <field field_ref="wspd"         name="windsp"   />
+	  <field field_ref="precip"       name="precip"   />
 	  <!-- ice and snow -->
-	  <field field_ref="snowpre"      />
-      <field field_ref="utau_ice"         name="utau_ice" />
-      <field field_ref="vtau_ice"         name="vtau_ice" />
-
+	  <field field_ref="snowpre" />
+	  <field field_ref="utau_ice"     name="utau_ice" />
+	  <field field_ref="vtau_ice"     name="vtau_ice" />
 	</file>
 
 	<file id="file3" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="ssu"          name="uos"     long_name="sea_surface_x_velocity"    />
-	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
-	  <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" />
+	  <field field_ref="e3u" />
+	  <field field_ref="ssu"          name="uos"      />
+	  <field field_ref="uoce"         name="uo"       operation="instant" freq_op="5d" > @uoce_e3u / @e3u </field>
+	  <field field_ref="utau"         name="tauuo"    />
           <!-- available with key_diaar5 -->
-	  <field field_ref="u_masstr"     name="vozomatr"  />
-	  <field field_ref="u_heattr"     name="sozohetr"  />
-      <field field_ref="u_salttr"     name="sozosatr"  />
+	  <field field_ref="u_masstr"     name="vozomatr" />
+	  <field field_ref="u_heattr"     name="sozohetr" />
+      <field field_ref="u_salttr"     name="sozosatr" />
 	</file>
 	
 	<file id="file4" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="ssv"          name="vos"     long_name="sea_surface_y_velocity"    />
-	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
-	  <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" />
+	  <field field_ref="e3v" />
+	  <field field_ref="ssv"          name="vos"      />
+	  <field field_ref="voce"         name="vo"       operation="instant" freq_op="5d" > @voce_e3v / @e3v </field>
+	  <field field_ref="vtau"         name="tauvo"    />
           <!-- available with key_diaar5 -->
-	  <field field_ref="v_masstr"     name="vomematr"  />
-	  <field field_ref="v_heattr"     name="somehetr"  />
-      <field field_ref="v_salttr"     name="somesatr"  />
+	  <field field_ref="v_masstr"     name="vomematr" />
+	  <field field_ref="v_heattr"     name="somehetr" />
+      <field field_ref="v_salttr"     name="somesatr" />
 	</file>
 	
 	<file id="file5" name_suffix="_grid_W" description="ocean W grid variables" >
-	  <field field_ref="woce"         name="wo"      long_name="ocean vertical velocity"         />
-	  <field field_ref="avt"          name="difvho"  long_name="ocean_vertical_heat_diffusivity" />
-	  <field field_ref="w_masstr"     name="vovematr"  />
+	  <field field_ref="e3w" />
+	  <field field_ref="woce"         name="wo"       />
+	  <field field_ref="avt"          name="difvho"   />
+	  <field field_ref="w_masstr"     name="vovematr" />
 	</file>
 
 	<file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." >
-	  <field field_ref="snowthic_cea"     name="snthic"     long_name="surface_snow_thickness"   />
-	  <field field_ref="icethic_cea"      name="sithic"     long_name="sea_ice_thickness"        />
-          <field field_ref="icevolu"          name="sivolu" />
-          <field field_ref="snowvol"          name="snvolu" />
-          <field field_ref="iceconc"          name="siconc"  />
+          <field field_ref="snowthic_cea"    name="snthic" />
+          <field field_ref="icethic_cea"     name="sithic" />
+          <field field_ref="icevolu"         name="sivolu" />
+          <field field_ref="snowvol"         name="snvolu" />
+          <field field_ref="iceconc"         name="siconc" />
 
           <field field_ref="vfxbog"          name="vfxbog" />
@@ -118,137 +128,140 @@
           <field field_ref="icetrp"          name="sivtrp" />
           <field field_ref="snwtrp"          name="snvtrp" />
+          <field field_ref="saltrp"          name="saltrp" />
           <field field_ref="deitrp"          name="deitrp" />
           <field field_ref="destrp"          name="destrp" />
 
-          <field field_ref="sfxbri"           name="sfxbri" />
-          <field field_ref="sfxdyn"           name="sfxdyn" />
-          <field field_ref="sfxres"           name="sfxres" />
-          <field field_ref="sfxbog"           name="sfxbog" />
-          <field field_ref="sfxbom"           name="sfxbom" />
-          <field field_ref="sfxsum"           name="sfxsum" />
-          <field field_ref="sfxsni"           name="sfxsni" />
-          <field field_ref="sfxopw"           name="sfxopw" />
-          <field field_ref="sfx"              name="sfx" />
-
-          <field field_ref="hfxsum"          name="hfxsum"    />
-          <field field_ref="hfxbom"          name="hfxbom"    />
-          <field field_ref="hfxbog"          name="hfxbog"    />
-          <field field_ref="hfxdif"          name="hfxdif"    />
-          <field field_ref="hfxopw"          name="hfxopw"    />
-          <field field_ref="hfxout"          name="hfxout"    />
-          <field field_ref="hfxin"           name="hfxin"    />
-          <field field_ref="hfxsnw"          name="hfxsnw"    />
-          <field field_ref="hfxerr"          name="hfxerr"    />
-          <field field_ref="hfxerr_rem"      name="hfxerr_rem"    />
+          <field field_ref="sfxbri"          name="sfxbri" />
+          <field field_ref="sfxdyn"          name="sfxdyn" />
+          <field field_ref="sfxres"          name="sfxres" />
+          <field field_ref="sfxbog"          name="sfxbog" />
+          <field field_ref="sfxbom"          name="sfxbom" />
+          <field field_ref="sfxsum"          name="sfxsum" />
+          <field field_ref="sfxsni"          name="sfxsni" />
+          <field field_ref="sfxopw"          name="sfxopw" />
+          <field field_ref="sfx"             name="sfx"    />
+
+          <field field_ref="hfxsum"          name="hfxsum"     />
+          <field field_ref="hfxbom"          name="hfxbom"     />
+          <field field_ref="hfxbog"          name="hfxbog"     />
+          <field field_ref="hfxdif"          name="hfxdif"     />
+          <field field_ref="hfxopw"          name="hfxopw"     />
+          <field field_ref="hfxout"          name="hfxout"     />
+          <field field_ref="hfxin"           name="hfxin"      />
+          <field field_ref="hfxsnw"          name="hfxsnw"     />
+          <field field_ref="hfxerr"          name="hfxerr"     />
+          <field field_ref="hfxerr_rem"      name="hfxerr_rem" />
 
 	  <!-- ice-ocean heat flux from mass exchange -->
-          <field field_ref="hfxdyn"          name="hfxdyn"    />
-          <field field_ref="hfxres"          name="hfxres"    />
-          <field field_ref="hfxthd"          name="hfxthd"    />
+          <field field_ref="hfxdyn"          name="hfxdyn" />
+          <field field_ref="hfxres"          name="hfxres" />
+          <field field_ref="hfxthd"          name="hfxthd" />
 	  <!-- ice-atm. heat flux from mass exchange -->
-          <field field_ref="hfxsub"          name="hfxsub"    />
-          <field field_ref="hfxspr"          name="hfxspr"    />
+          <field field_ref="hfxsub"          name="hfxsub" />
+          <field field_ref="hfxspr"          name="hfxspr" />
 
 	  <!-- diags -->
-          <field field_ref="hfxdhc"          name="hfxdhc"    />
-          <field field_ref="hfxtur"          name="hfxtur"    />
-
-          <field field_ref="isst"             name="sst" />
-          <field field_ref="isss"             name="sss" />
-          <field field_ref="micesalt"         name="sisali" />
-          <field field_ref="micet"            name="sitemp" />
-          <field field_ref="icest"            name="sistem" />
-          <field field_ref="icehc"            name="siheco" />
-          <field field_ref="isnowhc"          name="snheco" />
-          <field field_ref="miceage"          name="siages" />
-
-          <field field_ref="uice_ipa"         name="sivelu" />
-          <field field_ref="vice_ipa"         name="sivelv" />
-          <field field_ref="icevel"           name="sivelo" />
-          <field field_ref="idive"            name="sidive" />
-          <field field_ref="ishear"           name="sishea" />
-          <field field_ref="icestr"           name="sistre" />
-
-          <field field_ref="ibrinv"           name="sibrin" />
-          <field field_ref="icecolf"          name="sicolf" />
-
-          <field field_ref="iceage_cat"       name="siagecat"/>
-          <field field_ref="iceconc_cat"      name="siconcat"/>
-          <field field_ref="icethic_cat"      name="sithicat"/>
-          <field field_ref="snowthic_cat"     name="snthicat"/>
-          <field field_ref="salinity_cat"     name="salincat"/>
-          <field field_ref="brinevol_cat"     name="sibricat"/>
+          <field field_ref="hfxdhc"          name="hfxdhc" />
+          <field field_ref="hfxtur"          name="hfxtur" />
+
+          <field field_ref="isst"            name="sst"    />
+          <field field_ref="isss"            name="sss"    />
+          <field field_ref="micesalt"        name="sisali" />
+          <field field_ref="micet"           name="sitemp" />
+          <field field_ref="icest"           name="sistem" />
+          <field field_ref="icehc"           name="siheco" />
+          <field field_ref="isnowhc"         name="snheco" />
+          <field field_ref="miceage"         name="siages" />
+
+          <field field_ref="uice_ipa"        name="sivelu" />
+          <field field_ref="vice_ipa"        name="sivelv" />
+          <field field_ref="icevel"          name="sivelo" />
+          <field field_ref="idive"           name="sidive" />
+          <field field_ref="ishear"          name="sishea" />
+          <field field_ref="icestr"          name="sistre" />
+
+          <field field_ref="ibrinv"          name="sibrin" />
+          <field field_ref="icecolf"         name="sicolf" />
+
+          <field field_ref="iceage_cat"      name="siagecat" />
+          <field field_ref="iceconc_cat"     name="siconcat" />
+          <field field_ref="icethic_cat"     name="sithicat" />
+          <field field_ref="snowthic_cat"    name="snthicat" />
+          <field field_ref="salinity_cat"    name="salincat" />
+          <field field_ref="brinevol_cat"    name="sibricat" />
+	  <field field_ref="icetemp_cat"     name="sitemcat" />
+	  <field field_ref="snwtemp_cat"     name="sntemcat" />
 
 	</file>
 
         <file id="file7" name_suffix="_scalar" description="scalar variables" enabled=".true." >
-          <field field_ref="voltot"       name="scvoltot"  />
-          <field field_ref="sshtot"       name="scsshtot"  />
-          <field field_ref="sshsteric"    name="scsshste"  />
-          <field field_ref="sshthster"    name="scsshtst"  />
-          <field field_ref="masstot"      name="scmastot"  />
-          <field field_ref="temptot"      name="sctemtot"  />
-          <field field_ref="saltot"       name="scsaltot"  />
-
-          <field field_ref="bgtemper"     name="bgtemper"    />
-          <field field_ref="bgsaline"     name="bgsaline"    />
-          <field field_ref="bgheatco"     name="bgheatco"    />
-          <field field_ref="bgsaltco"     name="bgsaltco"    />
-          <field field_ref="bgvolssh"     name="bgvolssh"    /> 
-          <field field_ref="bgvole3t"     name="bgvole3t"    />
-          <field field_ref="bgfrcvol"     name="bgfrcvol"    />
-          <field field_ref="bgfrctem"     name="bgfrctem"    />
-          <field field_ref="bgfrcsal"     name="bgfrcsal"    />
-
-          <field field_ref="ibgvoltot"    name="ibgvoltot"   />
-          <field field_ref="sbgvoltot"    name="sbgvoltot"   />
-          <field field_ref="ibgarea"      name="ibgarea"     />
-          <field field_ref="ibgsaline"    name="ibgsaline"   />
-          <field field_ref="ibgtemper"    name="ibgtemper"   />
-          <field field_ref="ibgheatco"    name="ibgheatco"   />
-          <field field_ref="sbgheatco"    name="sbgheatco"   />
-          <field field_ref="ibgsaltco"    name="ibgsaltco"   />
-
-          <field field_ref="ibgvfx"       name="ibgvfx"      />
-          <field field_ref="ibgvfxbog"    name="ibgvfxbog"      />
-          <field field_ref="ibgvfxopw"    name="ibgvfxopw"      />
-          <field field_ref="ibgvfxsni"    name="ibgvfxsni"      />
-          <field field_ref="ibgvfxdyn"    name="ibgvfxdyn"      />
-          <field field_ref="ibgvfxbom"    name="ibgvfxbom"      />
-          <field field_ref="ibgvfxsum"    name="ibgvfxsum"      />
-          <field field_ref="ibgvfxres"    name="ibgvfxres"      />
-          <field field_ref="ibgvfxspr"    name="ibgvfxspr"      />
-          <field field_ref="ibgvfxsnw"    name="ibgvfxsnw"      />
-          <field field_ref="ibgvfxsub"    name="ibgvfxsub"      />
+          <field field_ref="voltot"       name="scvoltot"   />
+          <field field_ref="sshtot"       name="scsshtot"   />
+          <field field_ref="sshsteric"    name="scsshste"   />
+          <field field_ref="sshthster"    name="scsshtst"   />
+          <field field_ref="masstot"      name="scmastot"   />
+          <field field_ref="temptot"      name="sctemtot"   />
+          <field field_ref="saltot"       name="scsaltot"   />
+
+          <field field_ref="bgtemper"     name="bgtemper"   />
+          <field field_ref="bgsaline"     name="bgsaline"   />
+          <field field_ref="bgheatco"     name="bgheatco"   />
+          <field field_ref="bgsaltco"     name="bgsaltco"   />
+          <field field_ref="bgvolssh"     name="bgvolssh"   /> 
+          <field field_ref="bgvole3t"     name="bgvole3t"   />
+          <field field_ref="bgfrcvol"     name="bgfrcvol"   />
+          <field field_ref="bgfrctem"     name="bgfrctem"   />
+          <field field_ref="bgfrcsal"     name="bgfrcsal"   />
+
+          <field field_ref="ibgvoltot"    name="ibgvoltot"  />
+          <field field_ref="sbgvoltot"    name="sbgvoltot"  />
+          <field field_ref="ibgarea"      name="ibgarea"    />
+          <field field_ref="ibgsaline"    name="ibgsaline"  />
+          <field field_ref="ibgtemper"    name="ibgtemper"  />
+          <field field_ref="ibgheatco"    name="ibgheatco"  />
+          <field field_ref="sbgheatco"    name="sbgheatco"  />
+          <field field_ref="ibgsaltco"    name="ibgsaltco"  />
+
+          <field field_ref="ibgvfx"       name="ibgvfx"     />
+          <field field_ref="ibgvfxbog"    name="ibgvfxbog"  />
+          <field field_ref="ibgvfxopw"    name="ibgvfxopw"  />
+          <field field_ref="ibgvfxsni"    name="ibgvfxsni"  />
+          <field field_ref="ibgvfxdyn"    name="ibgvfxdyn"  />
+          <field field_ref="ibgvfxbom"    name="ibgvfxbom"  />
+          <field field_ref="ibgvfxsum"    name="ibgvfxsum"  />
+          <field field_ref="ibgvfxres"    name="ibgvfxres"  />
+          <field field_ref="ibgvfxspr"    name="ibgvfxspr"  />
+          <field field_ref="ibgvfxsnw"    name="ibgvfxsnw"  />
+          <field field_ref="ibgvfxsub"    name="ibgvfxsub"  />
 
           <field field_ref="ibgsfx"       name="ibgsfx"     />
-          <field field_ref="ibgsfxbri"    name="ibgsfxbri"    />
-          <field field_ref="ibgsfxdyn"    name="ibgsfxdyn" />
-          <field field_ref="ibgsfxres"    name="ibgsfxres" />
-          <field field_ref="ibgsfxbog"    name="ibgsfxbog"      />
-          <field field_ref="ibgsfxopw"    name="ibgsfxopw"      />
-          <field field_ref="ibgsfxsni"    name="ibgsfxsni"      />
-          <field field_ref="ibgsfxbom"    name="ibgsfxbom"      />
-          <field field_ref="ibgsfxsum"    name="ibgsfxsum"      />
-
-          <field field_ref="ibghfxdhc"    name="ibghfxdhc"    />
-          <field field_ref="ibghfxspr"    name="ibghfxspr"    />
-
-          <field field_ref="ibghfxres"    name="ibghfxres"    />
-          <field field_ref="ibghfxsub"    name="ibghfxsub"    />
-          <field field_ref="ibghfxdyn"    name="ibghfxdyn"    />
-          <field field_ref="ibghfxthd"    name="ibghfxthd"    />
-          <field field_ref="ibghfxsum"    name="ibghfxsum"    />
-          <field field_ref="ibghfxbom"    name="ibghfxbom"    />
-          <field field_ref="ibghfxbog"    name="ibghfxbog"    />
-          <field field_ref="ibghfxdif"    name="ibghfxdif"    />
-          <field field_ref="ibghfxopw"    name="ibghfxopw"    />
-          <field field_ref="ibghfxout"    name="ibghfxout"    />
-          <field field_ref="ibghfxin"    name="ibghfxin"    />
-          <field field_ref="ibghfxsnw"    name="ibghfxsnw"    />
-
-          <field field_ref="ibgfrcvol"    name="ibgfrcvol"   />
+          <field field_ref="ibgsfxbri"    name="ibgsfxbri"  />
+          <field field_ref="ibgsfxdyn"    name="ibgsfxdyn"  />
+          <field field_ref="ibgsfxres"    name="ibgsfxres"  />
+          <field field_ref="ibgsfxbog"    name="ibgsfxbog"  />
+          <field field_ref="ibgsfxopw"    name="ibgsfxopw"  />
+          <field field_ref="ibgsfxsni"    name="ibgsfxsni"  />
+          <field field_ref="ibgsfxbom"    name="ibgsfxbom"  />
+          <field field_ref="ibgsfxsum"    name="ibgsfxsum"  />
+
+          <field field_ref="ibghfxdhc"    name="ibghfxdhc"  />
+          <field field_ref="ibghfxspr"    name="ibghfxspr"  />
+
+          <field field_ref="ibghfxres"    name="ibghfxres"  />
+          <field field_ref="ibghfxsub"    name="ibghfxsub"  />
+          <field field_ref="ibghfxdyn"    name="ibghfxdyn"  />
+          <field field_ref="ibghfxthd"    name="ibghfxthd"  />
+          <field field_ref="ibghfxsum"    name="ibghfxsum"  />
+          <field field_ref="ibghfxbom"    name="ibghfxbom"  />
+          <field field_ref="ibghfxbog"    name="ibghfxbog"  />
+          <field field_ref="ibghfxdif"    name="ibghfxdif"  />
+          <field field_ref="ibghfxopw"    name="ibghfxopw"  />
+          <field field_ref="ibghfxout"    name="ibghfxout"  />
+          <field field_ref="ibghfxin"     name="ibghfxin"   />
+          <field field_ref="ibghfxsnw"    name="ibghfxsnw"  />
+
+          <field field_ref="ibgfrcvol"    name="ibgfrcvol"  />
           <field field_ref="ibgfrcsfx"    name="ibgfrcsfx"  />
-          <field field_ref="ibgvolgrm"    name="ibgvolgrm"    />
+          <field field_ref="ibgvolgrm"    name="ibgvolgrm"  />
 
         </file>
@@ -267,10 +280,5 @@
       </file_group>
 
-      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
-      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->   
-
       <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
-
-
       <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
       <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
@@ -292,11 +300,13 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
-      <axis id="ncatice" long_name="Ice categories"   unit="-"  />
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
    </axis_definition> 
     
@@ -312,4 +322,7 @@
      <grid id="grid_W_2D" domain_ref="grid_W"/>
      <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
+     <grid id="gznl_T_2D" domain_ref="gznl"/>
+     <grid id="gznl_T_3D" domain_ref="gznl" axis_ref="deptht"/>
+     <grid id="gznl_W_3D" domain_ref="gznl" axis_ref="depthw"/>
     </grid_definition>   
   </context>
@@ -323,5 +336,5 @@
         We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
 -->
-	  <variable id="buffer_size"               type="integer">5000000</variable>
+	  <variable id="buffer_size"               type="integer">50000000</variable>
 	  <variable id="buffer_server_factor_size" type="integer">2</variable>
 	  <variable id="info_level"                type="integer">0</variable>
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_ar5.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_ar5.xml	(revision 5659)
+++ 	(revision )
@@ -1,288 +1,0 @@
-<?xml version="1.0"?>
-<simulation> 
-  
-  <context id="nemo" time_origin="1900-01-01 00:00:00" >
-
-    <!-- $id$ -->
-    
-    <!-- 
-============================================================================================================
-=                                  definition of all existing variables                                    =
-=                                            DO NOT CHANGE                                                 =
-============================================================================================================
-    -->
-    <field_definition src="./field_def.xml"/>    
-    <!-- 
-============================================================================================================
-=                                                                                                          =
-=                                           output files definition                                        =
-=                                                                                                          =
-=                  http://www2-pcmdi.llnl.gov/svn/repository/cmor/trunk/Tables/CMIP5_Oclim                 =
-=                  http://www2-pcmdi.llnl.gov/svn/repository/cmor/trunk/Tables/CMIP5_Omon                  =
-=                  http://www2-pcmdi.llnl.gov/svn/repository/cmor/trunk/Tables/CMIP5_Oimon                 =              
-=          http://www.clivar.org/organization/wgomd/references/WGOMD_CMIP5_ocean_fields.June2009.pdf       =
-=                                                                                                          =
-============================================================================================================
-    -->
-    
-    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" output_level="10" sync_freq="2mo" min_digits="4">
-      <!--
-+++++++++++++++++++++++++++++++++++++++++++++++   daily   ++++++++++++++++++++++++++++++++++++++++++++++++++
-        -->
-      <file_group id="1d" output_freq="1d"  enabled=".TRUE.">                      <!-- 1d files -->
-	<file id="file1" name_suffix="_grid_T_table2.2" >         <!-- grid T  -->
-	  <field field_ref="sst"          name='tos'      long_name="sea_surface_temperature"                              level="2"                      />
-	  <field field_ref="sst2"         name='tossq'    long_name="square_of_sea_surface_temperature"                    level="2"                      />
-	  <field field_ref="mldkz5"       name='omldamax' long_name="ocean_mixed_layer_thickness_defined_by_mixing_scheme" level="2" operation="maximum" />
-	</file>   
-      </file_group>
-	<!--
-++++++++++++++++++++++++++++++++++++++++++++++   monthly   +++++++++++++++++++++++++++++++++++++++++++++++++
-	  -->
-      <file_group id="1m" output_freq="1mo"     enabled=".TRUE.">                      <!-- real monthly files -->
-	<!--
-..............................................    grid T   .................................................
-	  -->	  
-	<file id="file2" name_suffix="_grid_T_table2.2" >
-	  <field field_ref="botpres"      name="pbo"      long_name="sea_water_pressure_at_sea_floor"                               />
-	  <!-- pso : sea_water_pressure_at_sea_water_surface = 0 -->
-	  <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                                 />
-	  <field field_ref="ssh2"         name="zossq"    long_name="square_of_sea_surface_height_above_geoid"             level="2" />
-	  <!-- masscello : sea_water_mass_per_unit_area = cellthc*rau0                                          no time changes -->
-	  <field field_ref="cellthc"      name="thkcello" long_name="cell_thickness"                                                 /> <!-- no time changes -->
-	  <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"                                />
-	  <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                              level="1" />
-	  <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"                    level="2" />
-	  <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                                             />
-	  <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                                 level="1" />
-	  <field field_ref="rhop"         name="rhopoto"  long_name="sea_water_potential_density"                          level="2" />
-	  <!-- no agessc : sea_water_age_since_surface_contact -->
-	  <!-- no cfc11  : moles_per_unit_mass_of_cfc11_in_sea_water -->
-	  <!-- msftbarot : ocean_barotropic_mass_streamfunction : offline -->
-	  <!-- mlotst    :           ocean_mixed_layer_thickness_defined_by_sigma_t : must be done offline -->
-	  <!-- mlotstsq  : square_of_ocean_mixed_layer_thickness_defined_by_sigma_t : must be done offline -->
-	  <field field_ref="mldkz5"       name='omlmax'   long_name="ocean_mixed_layer_thickness_defined_by_mixing_scheme" level="2" operation="maximum" />
-	</file>   
-	
-	<file id="file3" name_suffix="_grid_T_table2.5" >
-	  <field field_ref="rain"         name="pr"       long_name="rainfall_flux"                                           level="1" />
-	  <field field_ref="snow_ao_cea"  name="prsn"     long_name="snowfall_flux"                                           level="1" />
-	  <field field_ref="evap_ao_cea"  name="evs"      long_name="water_evaporation_flux"                                  level="1" />
-	  <field field_ref="runoffs"      name="friver"   long_name="water_flux_into_sea_water_from_rivers"                   level="1" />
-	  <field field_ref="calving"      name="ficeberg" long_name="water_flux_into_sea_water_from_icebergs"                 level="1" />
-	  <field field_ref="isnwmlt_cea"  name="fsitherm" long_name="water_flux_into_sea_water_due_to_sea_ice_thermodynamics" level="1" />
-	  <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                               level="1" />
-	  <!-- wfonocorr : water_flux_into_sea_water_without_flux_correction : emp - erp -->  
-	  <field field_ref="erp"          name="wfcorr"   long_name="water_flux_correction"                                   level="1" /> <!-- usually = 0 -->
-	</file>   
-	
-	<file id="file4" name_suffix="_grid_T_table2.6" >
-	  <!-- vsfpr    : virtual_salt_flux_into_sea_water_due_to_rainfall    = 0 --> 
-	  <!-- vsfevap  : virtual_salt_flux_into_sea_water_due_to_evaporation = 0 --> 
-	  <!-- vsfriver : virtual_salt_flux_into_sea_water_from_rivers        = 0 --> 	  
-	  <field field_ref="fsal_virt_cea" name="vsfsit" long_name="virtual_salt_flux_into_sea_water_due_to_sea_ice_thermodynamics" level="1" />
-	  <!-- vsf      : virtual_salt_flux_into_sea_water = fsal_virtual + fsal_real -->
-	  <!-- wfcorr   : virtual_salt_flux_correction                        = 0 --> 
-	  <field field_ref="fsal_virt_cea" name="sfdsi"  long_name="downward_sea_ice_basal_salt_flux"                               level="1" />
-	  <!-- sfriver  : salt_flux_into_sea_water_from_rivers                = 0 --> 
-	</file>   
-	
-	<file id="file5" name_suffix="_grid_T_table2.7" >
-	  <!-- hfgeou : upward_geothermal_heat_flux_at_sea_floor : cte, see nambbc and trabbc.F90 -->
-	  <field field_ref="hflx_rain_cea" name="hfrainds"    long_name="temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water"      level="1" />
-	  <field field_ref="hflx_evap_cea" name="hfevapds"    long_name="temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water" level="1" />
-	  <field field_ref="hflx_rnf_cea"  name="hfrunoffds"  long_name="temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water"        level="1" />
-	  <field field_ref="hflx_snow_cea" name="hfsnthermds" long_name="heat_flux_into_sea_water_due_to_snow_thermodynamics"                         level="1" />
-	  <field field_ref="hflx_ice_cea"  name="hfsithermds" long_name="heat_flux_into_sea_water_due_to_sea_ice_thermodynamics"                      level="1" />
-	  <field field_ref="hflx_cal_cea"  name="hfibthermds" long_name="heat_flux_into_sea_water_due_to_iceberg_thermodynamics"                      level="1" />
-	  <!-- rlds   : surface_net_downward_longwave_flux : not available -->
-	  <!-- hfls   : surface_downward_latent_heat_flux  : not available -->
-	  <!-- hfss   : surface_downward_sensible_heat_flux: not available -->
-	  <field field_ref="qns"           name="nshfls"      long_name="surface_net_downward_non_solar_flux"                                         level="1" />
-	  <field field_ref="qsr"           name="rsntds"      long_name="surface_net_downward_shortwave_flux"                                         level="1" />
-	  <field field_ref="qsr3d"         name="rsds"        long_name="downwelling_shortwave_flux_in_sea_water"                                     level="1" />
-	  <field field_ref="qrp"           name="hfcorr"      long_name="heat_flux_correction"                                                        level="1" />
-	</file>   
-	<!--
-..............................................    grid U   .................................................
-	-->
-	<file id="file6" name_suffix="_grid_U_table2.3" >
-	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"                                       />
-	  <field field_ref="u_masstr"     name="umo"     long_name="ocean_mass_x_transport"                           level="1" />
-	  <field field_ref="u_heattr"     name="hfx"     long_name="ocean_heat_x_transport"                           level="1" />
-	  <field field_ref="ueiv_heattr"  name="hfxba"   long_name="ocean_heat_x_transport_due_to_bolus_advection"    level="2" />
-	  <field field_ref="udiff_heattr" name="hfxdiff" long_name="ocean_heat_x_transport_due_to_diffusion"          level="2" />
-	</file>   
-	
-	<file id="file7" name_suffix="_grid_U_table2.8" >
-	  <field field_ref="utau"         name="tauuo" long_name="surface_downward_x_stress"                          level="1" />
-	  <!-- tauucorr : surface_downward_x_stress_correction = 0 -->
-	</file>   
-	<!--
-..............................................    grid V   .................................................
-	-->
-	<file id="file8" name_suffix="_grid_V_table2.3" >
-	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"                                       />
-	  <field field_ref="v_masstr"     name="vmo"     long_name="ocean_mass_y_transport"                           level="1" />
-	  <field field_ref="v_heattr"     name="hfy"     long_name="ocean_heat_y_transport"                           level="1" />
-	  <field field_ref="veiv_heattr"  name="hfyba"   long_name="ocean_heat_y_transport_due_to_bolus_advection"    level="2" />
-	  <field field_ref="vdiff_heattr" name="hfydiff" long_name="ocean_heat_y_transport_due_to_diffusion"          level="2" />
-	</file>   
-	
-	<file id="file9" name_suffix="_grid_V_table2.8" >
-	  <field field_ref="vtau"         name="tauvo" long_name="surface_downward_y_stress"                          level="1" />
-	  <!-- tauvcorr : surface_downward_y_stress_correction = 0 -->
-	</file>   
-	<!--
-..............................................    grid W   .................................................
-	-->
-	<file id="file10" name_suffix="_grid_W_table2.3" >
-	  <field field_ref="w_masstr"   name="wmo"   long_name="upward_ocean_mass_transport"                                    />
-	  <field field_ref="w_masstr2"  name="wmosq" long_name="square_pf_upward_ocean_mass_transport"                          />
-	</file>   
-	
-	<file id="file11" name_suffix="_grid_W_table2.9" >
-	  <field field_ref="avt"     name="difvho"   long_name="ocean_vertical_heat_diffusivity"                  level="2" />
-	  <field field_ref="avs"     name="difvso"   long_name="ocean_vertical_salt_diffusivity"                  level="2" />
-	  <!-- difvtrbo : ocean_vertical_tracer_diffusivity_due_to_background : cte with time, see namelist parameters nn_avb and  nn_havtb -->
-	  <field field_ref="av_tide" name="difvtrto" long_name="ocean_vertical_tracer_diffusivity_due_to_tides"   level="2" />
-	  <!-- tnpeo     : tendency_of_ocean_potential_energy_content                   : not available -->
-	  <!-- tnpeot    : tendency_of_ocean_potential_energy_content_due_to_tides      : not available -->
-	  <!-- tnpeotb   : tendency_of_ocean_potential_energy_content_due_to_background : not available -->
-	  <field field_ref="avm"     name="difvmo"   long_name="ocean_vertical_momentum_diffusivity"              level="2" />
-	  <!-- difvmbo : ocean_vertical_momentum_diffusivity_due_to_background : cte with time, see namelist parameters nn_avb -->
-	  <field field_ref="av_tide" name="difvmto"  long_name="ocean_vertical_momentum_diffusivity_due_to_tides" level="2" /> <!-- same as tracer -->
-	  <!-- difvmfdo : ocean_vertical_momentum_diffusivity_due_to_form_drag : ??? -->
-	  <!-- dispkevfo : ocean_kinetic_energy_dissipation_per_unit_area_due_to_vertical_friction : not available -->
-	</file>
-	
-	<file id="file12" name_suffix="_grid_W_table2.10" >
-	  <!-- if ln_traldf_lap    =  .true. -->
-	  <field field_ref="aht2d_eiv" name="diftrblo" long_name="ocean_tracer_bolus_laplacian_diffusivity"                     level="2" />
-	  <!-- diftrelo : ocean_tracer_epineutral_laplacian_diffusivity : cte with time, see ln_traldf_iso -->
-	  <!-- diftrxylo : ocean_tracer_xy_laplacian_diffusivity : cte with time -->
-	  <!-- if ln_traldf_bilap  =  .true. -->
-	  <!-- field field_ref="diftrbbo" name="aht2d_eiv" long_name="ocean_tracer_bolus_biharmonic_diffusivity"                    level="2" /-->
-	  <!-- diftrebo : ocean_tracer_epineutral_biharmonic_diffusivity : cte with time, see ln_traldf_iso -->
-	  <!-- diftrxybo : ocean_tracer_xy_biharmonic_diffusivity : cte with time -->
-	  <!-- tnkebto : tendency_of_ocean_eddy_kinetic_energy_content_due_to_bolus_transport : not available -->
-	  <!-- difmxylo : ocean_momentum_xy_laplacian_diffusivity : cte with time, see ln_dynldf_lap -->
-	  <!-- difmxybo : ocean_momentum_xy_biharmonic_diffusivity : cte with time, see ln_dynldf_bilap -->
-	  <!-- dispkexyfo : ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction : not available -->
-	</file>   
-	<!--
-..............................................    scalar   .................................................
-	-->
-	<file id="file13" name_suffix="_scalar_table2.2" >         <!-- scalar -->
-	  <field field_ref="masstot"    name="masso"    long_name="sea_water_mass"                                />
-	  <field field_ref="voltot"     name="volo"     long_name="sea_water_volume"                              />
-	  <field field_ref="sshtot"     name="zosga"    long_name="global_average_sea_level_change"               />
-	  <field field_ref="sshsteric"  name="zossga"   long_name="global_average_steric_sea_level_change"        />
-	  <field field_ref="sshthster"  name="zostoga"  long_name="global_average_thermosteric_sea_level_change"  />
-	  <field field_ref="temptot"    name="thetaoga" long_name="sea_water_potential_temperature"               />
-	  <field field_ref="saltot"     name="soga"     long_name="sea_water_salinity"                            />
-	</file>   
-	<!--
-..............................................    icemod   .................................................
-	-->
-	<file id="file14" name_suffix="_icemod_table2.2" >         <!-- scalar -->
-	  <field field_ref="ice_pres"                     />
-	  <field field_ref="ice_cover"    name="sic"        long_name="sea_ice_area_fraction"                            />
-	  <field field_ref="icethic_cea"  name="sit"        long_name="sea_ice_thickness"                                />
-	  <field field_ref="subl_ai_cea"  name="evap"       long_name="water_evaporation_flux"                           />
-	  <field field_ref="snowthic_cea" name="snd"        long_name="surface_snow_thickness"                           />
-	  <!-- snc : surface_snow_area_fraction : same as sic -->
-	  <field field_ref="icealb_cea"   name="ialb"       long_name="Bare Sea Ice Albedo"                              />
-	  <!-- ssi : Sea Ice Salinity : cte = sice = 6, expect in baltic sea = 2 -->
-	  <field field_ref="ist_cea"      name="tsice"      long_name="Surface Temperature of Sea Ice"                   />
-	  <!-- tsnint : Temperature at Interface Between Sea Ice and Snow : not available -->
-	  <!-- pr : Surface Rainfall Rate into the Sea Ice Portion of the Grid Cell = 0 -->
-	  <field field_ref="snow_ai_cea"  name="prsn"       long_name="Surface Snowfall Rate into the Sea Ice Portion of the Grid Cell" />
-	  <!-- ageice   : Age of Sea Ice : not available ??? -->
-	  <!-- grFrazil : Frazil Sea Ice Growth (Leads) Rate ??? -->
-	  <!-- grCongel : Congelation Sea Ice Growth Rate ??? -->
-	  <field field_ref="licepro_cea"  name="grLateral"  long_name="Lateral Sea Ice Growth Rate"                      />
-	  <field field_ref="sntoice_cea"  name="snoToIce"   long_name="Snow-Ice Formation Rate"                          />
-	  <field field_ref="snowmel_cea"  name="snomelt"    long_name="Snow Melt Rate"                                   />
-	  <field field_ref="ticemel_cea"  name="tmelt"      long_name="Rate of Melt at Upper Surface of Sea Ice"         />
-	  <field field_ref="bicemel_cea"  name="bmelt"      long_name="Rate of Melt at Sea Ice Base"                     />
-	  <!-- hcice  : Sea Ice Total Heat Content ??? -->
-	  <field field_ref="qsr_ai_cea"   name="rsdssi"     long_name="surface_downwelling_shortwave_flux_in_air"        />
-	  <!-- rsussi : surface_upwelling_shortwave_flux_in_air ??? -->
-	  <!-- rldssi : surface_downwelling_longwave_flux_in_air ??? -->
-	  <!-- rlussi : surface_upwelling_longwave_flux_in_air ??? -->
-	  <!-- hfssi  : surface_upward_sensible_heat_flux ??? -->
-	  <!-- hflssi : surface_upward_latent_heat_flux ??? -->
-	  <field field_ref="subl_ai_cea"  name="sblsi"      long_name="surface_snow_and_ice_sublimation_flux"             />
-	  <field field_ref="u_imasstr"    name="transix"    long_name="Eastward Sea Ice Transport"                        />
-	  <field field_ref="v_imasstr"    name="transiy"    long_name="Northward Sea Ice Transport"                       />
-	  <field field_ref="fram_trans"   name="transifs"   long_name="Sea Ice Mass Transport Through Fram Strait"        />
-	  <field field_ref="utau_ice"     name="strairx"    long_name="Eastward Atmospheric Stress On Sea Ice"            />
-	  <field field_ref="vtau_ice"     name="strairy"    long_name="Northward Atmospheric Stress On Sea Ice"           />
-	  <!-- strocnx : Eastward Ocean Stress On Sea Ice ??? -->
-	  <!-- strocny : Northward Ocean Stress On Sea Ice ??? -->
-	  <!-- streng  : Compressive Sea Ice Strength ??? -->
-	  <!-- divice  : Strain Rate Divergence of Sea Ice ??? -->
-	  <!-- shrice  : Strain Rate Shear of Sea Ice ??? -->
-	  <!-- ridgice : Sea Ice Ridging Rate ??? -->
-	</file>   
-      </file_group>
-
-      <!-- 
-+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-        -->
-    </file_definition>
-    
-    <!-- 
-============================================================================================================
-=                                           grid definition                                                =
-=                                            DO NOT CHANGE                                                 =
-============================================================================================================
-    -->
-    
-
-   <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
-   </axis_definition> 
-    
-   <domain_definition src="./domain_def.xml"/>
-   
-   <grid_definition>    
-     <grid id="grid_T_2D" domain_ref="grid_T"/>
-     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
-     <grid id="grid_U_2D" domain_ref="grid_U"/>
-     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
-     <grid id="grid_V_2D" domain_ref="grid_V"/>
-     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
-     <grid id="grid_W_2D" domain_ref="grid_W"/>
-     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
-    </grid_definition>    
-
-  </context>
-  
-
-  <context id="xios">
-
-      <variable_definition>
-	
-     <!-- 
-        We must have buffer_size > jpi*jpj*jpk*8*3 (with jpi and jpj the subdomain size)
--->
-	  <variable id="buffer_size"               type="integer">25000000</variable>
-	  <variable id="buffer_server_factor_size" type="integer">2</variable>
-	  <variable id="info_level"                type="integer">0</variable>
-	  <variable id="using_server"              type="boolean">false</variable>
-	  <variable id="using_oasis"               type="boolean">false</variable>
-	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
-	
-      </variable_definition>
-               
-  </context>
-  
-</simulation>
-  
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_default.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_default.xml	(revision 5659)
+++ 	(revision )
@@ -1,336 +1,0 @@
-<?xml version="1.0"?>
-<simulation> 
-
- <context id="nemo" time_origin="1950-01-01 00:00:00" >
-    
-    <!-- $id$ -->
-    
-    <!-- 
-============================================================================================================
-=                                  definition of all existing variables                                    =
-=                                            DO NOT CHANGE                                                 =
-============================================================================================================
-    -->
-    <field_definition src="./field_def.xml"/>
-    <!-- 
-============================================================================================================
-=                                           output files definition                                        =
-=                                            Define your own files                                         =
-=                                         put the variables you want...                                    =
-============================================================================================================
-    -->
-    
-    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
-    
-      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
-
-      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
-
-      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
-
-      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
-
-      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
-
-      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->     
-
-      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE." > <!-- 1d files -->
-
-	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       />
-	  <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          />
-	  <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                />
-	  <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"               />
-	  <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                            />
-	  <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             />
-	  <field field_ref="ssh2"         name="zossq"    long_name="square_of_sea_surface_height_above_geoid"      />
-	  <field field_ref="mldkz5"       />
-	  <field field_ref="mldr10_1"     />
-      <field field_ref="heatc"        name="heatc"    long_name="Heat content vertically integrated"            />
-      <field field_ref="saltc"        name="saltc"    long_name="Salt content vertically integrated"            />
-	</file>
-
-	<file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc -->
-	  <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     />
-	  <field field_ref="qsr_oce"      name="qsr_oce"  long_name="downward shortwave flux at ocean surface"           />
-	  <field field_ref="qns_oce"      name="qns_oce"  long_name="downward non solar flux at ocean surface"           />
-	  <field field_ref="qt_oce"       name="qt_oce"   long_name="downward total flux at ocean surface"           />
-	  <field field_ref="qsr_ice"      name="qsr_ice"  long_name="downward shortwave flux at ice surface"           />
-	  <field field_ref="qns_ice"      name="qns_ice"  long_name="downward non solar flux at ice surface"           />
-	  <field field_ref="qtr_ice"      name="qtr_ice"  long_name="shortwave flux transmitted thru the ice"           />
-	  <field field_ref="qt_ice"       name="qt_ice"   long_name="downward total flux at ice surface"           />
-	  <field field_ref="saltflx"      name="sfx"  />
-	  <field field_ref="taum"         name="taum" />
-	  <field field_ref="wspd"         name="windsp"  />
-      <field field_ref="precip"       name="precip" />
-	  <!-- ice and snow -->
-	  <field field_ref="snowpre"      />
-      <field field_ref="utau_ice"         name="utau_ice" />
-      <field field_ref="vtau_ice"         name="vtau_ice" />
-
-	</file>
-
-	<file id="file3" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    />
-	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
-	  <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" />
-          <!-- available with key_diaar5 -->
-	  <field field_ref="u_masstr"     name="vozomatr"  />
-	  <field field_ref="u_heattr"     name="sozohetr"  />
-      <field field_ref="u_salttr"     name="sozosatr"  />
-	</file>
-	
-	<file id="file4" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    />
-	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
-	  <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" />
-          <!-- available with key_diaar5 -->
-	  <field field_ref="v_masstr"     name="vomematr"  />
-	  <field field_ref="v_heattr"     name="somehetr"  />
-      <field field_ref="v_salttr"     name="somesatr"  />
-	</file>
-	
-	<file id="file5" name_suffix="_grid_W" description="ocean W grid variables" >
-	  <field field_ref="woce"         name="wo"      long_name="ocean vertical velocity"         />
-	  <field field_ref="avt"          name="difvho"  long_name="ocean_vertical_heat_diffusivity" />
-	  <field field_ref="w_masstr"     name="vovematr"  />
-	</file>
-
-	<file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." >
-	  <field field_ref="snowthic_cea"     name="snthic"     long_name="surface_snow_thickness"   />
-	  <field field_ref="icethic_cea"      name="sithic"     long_name="sea_ice_thickness"        />
-          <field field_ref="icevolu"          name="sivolu" />
-          <field field_ref="snowvol"          name="snvolu" />
-          <field field_ref="iceconc"          name="siconc"  />
-
-          <field field_ref="vfxbog"          name="vfxbog" />
-          <field field_ref="vfxdyn"          name="vfxdyn" />
-          <field field_ref="vfxopw"          name="vfxopw" />
-          <field field_ref="vfxsni"          name="vfxsni" />
-          <field field_ref="vfxsum"          name="vfxsum" />
-          <field field_ref="vfxbom"          name="vfxbom" />
-          <field field_ref="vfxres"          name="vfxres" />
-          <field field_ref="vfxice"          name="vfxice" />
-          <field field_ref="vfxsnw"          name="vfxsnw" />
-          <field field_ref="vfxsub"          name="vfxsub" />
-          <field field_ref="vfxspr"          name="vfxspr" />
-
-          <field field_ref="icetrp"          name="sivtrp" />
-          <field field_ref="snwtrp"          name="snvtrp" />
-          <field field_ref="deitrp"          name="deitrp" />
-          <field field_ref="destrp"          name="destrp" />
-
-          <field field_ref="sfxbri"           name="sfxbri" />
-          <field field_ref="sfxdyn"           name="sfxdyn" />
-          <field field_ref="sfxres"           name="sfxres" />
-          <field field_ref="sfxbog"           name="sfxbog" />
-          <field field_ref="sfxbom"           name="sfxbom" />
-          <field field_ref="sfxsum"           name="sfxsum" />
-          <field field_ref="sfxsni"           name="sfxsni" />
-          <field field_ref="sfxopw"           name="sfxopw" />
-          <field field_ref="sfx"              name="sfx" />
-
-          <field field_ref="hfxsum"          name="hfxsum"    />
-          <field field_ref="hfxbom"          name="hfxbom"    />
-          <field field_ref="hfxbog"          name="hfxbog"    />
-          <field field_ref="hfxdif"          name="hfxdif"    />
-          <field field_ref="hfxopw"          name="hfxopw"    />
-          <field field_ref="hfxout"          name="hfxout"    />
-          <field field_ref="hfxin"           name="hfxin"    />
-          <field field_ref="hfxsnw"          name="hfxsnw"    />
-          <field field_ref="hfxerr"          name="hfxerr"    />
-          <field field_ref="hfxerr_rem"      name="hfxerr_rem"    />
-
-	  <!-- ice-ocean heat flux from mass exchange -->
-          <field field_ref="hfxdyn"          name="hfxdyn"    />
-          <field field_ref="hfxres"          name="hfxres"    />
-          <field field_ref="hfxthd"          name="hfxthd"    />
-	  <!-- ice-atm. heat flux from mass exchange -->
-          <field field_ref="hfxsub"          name="hfxsub"    />
-          <field field_ref="hfxspr"          name="hfxspr"    />
-
-	  <!-- diags -->
-          <field field_ref="hfxdhc"          name="hfxdhc"    />
-          <field field_ref="hfxtur"          name="hfxtur"    />
-
-          <field field_ref="isst"             name="sst" />
-          <field field_ref="isss"             name="sss" />
-          <field field_ref="micesalt"         name="sisali" />
-          <field field_ref="micet"            name="sitemp" />
-          <field field_ref="icest"            name="sistem" />
-          <field field_ref="icehc"            name="siheco" />
-          <field field_ref="isnowhc"          name="snheco" />
-          <field field_ref="miceage"          name="siages" />
-
-          <field field_ref="uice_ipa"         name="sivelu" />
-          <field field_ref="vice_ipa"         name="sivelv" />
-          <field field_ref="icevel"           name="sivelo" />
-          <field field_ref="idive"            name="sidive" />
-          <field field_ref="ishear"           name="sishea" />
-          <field field_ref="icestr"           name="sistre" />
-
-          <field field_ref="ibrinv"           name="sibrin" />
-          <field field_ref="icecolf"          name="sicolf" />
-
-          <field field_ref="iceage_cat"       name="siagecat"/>
-          <field field_ref="iceconc_cat"      name="siconcat"/>
-          <field field_ref="icethic_cat"      name="sithicat"/>
-          <field field_ref="snowthic_cat"     name="snthicat"/>
-          <field field_ref="salinity_cat"     name="salincat"/>
-          <field field_ref="brinevol_cat"     name="sibricat"/>
-
-	</file>
-
-        <file id="file7" name_suffix="_scalar" description="scalar variables" enabled=".true." >
-          <field field_ref="voltot"       name="scvoltot"  />
-          <field field_ref="sshtot"       name="scsshtot"  />
-          <field field_ref="sshsteric"    name="scsshste"  />
-          <field field_ref="sshthster"    name="scsshtst"  />
-          <field field_ref="masstot"      name="scmastot"  />
-          <field field_ref="temptot"      name="sctemtot"  />
-          <field field_ref="saltot"       name="scsaltot"  />
-
-          <field field_ref="bgtemper"     name="bgtemper"    />
-          <field field_ref="bgsaline"     name="bgsaline"    />
-          <field field_ref="bgheatco"     name="bgheatco"    />
-          <field field_ref="bgsaltco"     name="bgsaltco"    />
-          <field field_ref="bgvolssh"     name="bgvolssh"    /> 
-          <field field_ref="bgvole3t"     name="bgvole3t"    />
-          <field field_ref="bgfrcvol"     name="bgfrcvol"    />
-          <field field_ref="bgfrctem"     name="bgfrctem"    />
-          <field field_ref="bgfrcsal"     name="bgfrcsal"    />
-
-          <field field_ref="ibgvoltot"    name="ibgvoltot"   />
-          <field field_ref="sbgvoltot"    name="sbgvoltot"   />
-          <field field_ref="ibgarea"      name="ibgarea"     />
-          <field field_ref="ibgsaline"    name="ibgsaline"   />
-          <field field_ref="ibgtemper"    name="ibgtemper"   />
-          <field field_ref="ibgheatco"    name="ibgheatco"   />
-          <field field_ref="sbgheatco"    name="sbgheatco"   />
-          <field field_ref="ibgsaltco"    name="ibgsaltco"   />
-
-          <field field_ref="ibgvfx"       name="ibgvfx"      />
-          <field field_ref="ibgvfxbog"    name="ibgvfxbog"      />
-          <field field_ref="ibgvfxopw"    name="ibgvfxopw"      />
-          <field field_ref="ibgvfxsni"    name="ibgvfxsni"      />
-          <field field_ref="ibgvfxdyn"    name="ibgvfxdyn"      />
-          <field field_ref="ibgvfxbom"    name="ibgvfxbom"      />
-          <field field_ref="ibgvfxsum"    name="ibgvfxsum"      />
-          <field field_ref="ibgvfxres"    name="ibgvfxres"      />
-          <field field_ref="ibgvfxspr"    name="ibgvfxspr"      />
-          <field field_ref="ibgvfxsnw"    name="ibgvfxsnw"      />
-          <field field_ref="ibgvfxsub"    name="ibgvfxsub"      />
-
-          <field field_ref="ibgsfx"       name="ibgsfx"     />
-          <field field_ref="ibgsfxbri"    name="ibgsfxbri"    />
-          <field field_ref="ibgsfxdyn"    name="ibgsfxdyn" />
-          <field field_ref="ibgsfxres"    name="ibgsfxres" />
-          <field field_ref="ibgsfxbog"    name="ibgsfxbog"      />
-          <field field_ref="ibgsfxopw"    name="ibgsfxopw"      />
-          <field field_ref="ibgsfxsni"    name="ibgsfxsni"      />
-          <field field_ref="ibgsfxbom"    name="ibgsfxbom"      />
-          <field field_ref="ibgsfxsum"    name="ibgsfxsum"      />
-
-          <field field_ref="ibghfxdhc"    name="ibghfxdhc"    />
-          <field field_ref="ibghfxspr"    name="ibghfxspr"    />
-
-          <field field_ref="ibghfxres"    name="ibghfxres"    />
-          <field field_ref="ibghfxsub"    name="ibghfxsub"    />
-          <field field_ref="ibghfxdyn"    name="ibghfxdyn"    />
-          <field field_ref="ibghfxthd"    name="ibghfxthd"    />
-          <field field_ref="ibghfxsum"    name="ibghfxsum"    />
-          <field field_ref="ibghfxbom"    name="ibghfxbom"    />
-          <field field_ref="ibghfxbog"    name="ibghfxbog"    />
-          <field field_ref="ibghfxdif"    name="ibghfxdif"    />
-          <field field_ref="ibghfxopw"    name="ibghfxopw"    />
-          <field field_ref="ibghfxout"    name="ibghfxout"    />
-          <field field_ref="ibghfxin"    name="ibghfxin"    />
-          <field field_ref="ibghfxsnw"    name="ibghfxsnw"    />
-
-          <field field_ref="ibgfrcvol"    name="ibgfrcvol"   />
-          <field field_ref="ibgfrcsfx"    name="ibgfrcsfx"  />
-          <field field_ref="ibgvolgrm"    name="ibgvolgrm"    />
-
-        </file>
-
-	<!--
-	<file id="file8" name_suffix="_Tides" description="tidal harmonics" >
-	  <field field_ref="M2x"          name="M2x"      long_name="M2 Elevation harmonic real part"                       />
-	  <field field_ref="M2y"          name="M2y"      long_name="M2 Elevation harmonic imaginary part"                  />
-	  <field field_ref="M2x_u"        name="M2x_u"    long_name="M2 current barotrope along i-axis harmonic real part "       />
-	  <field field_ref="M2y_u"        name="M2y_u"    long_name="M2 current barotrope along i-axis harmonic imaginary part "  />
-	  <field field_ref="M2x_v"        name="M2x_v"    long_name="M2 current barotrope along j-axis harmonic real part "       />
-	  <field field_ref="M2y_v"        name="M2y_v"    long_name="M2 current barotrope along j-axis harmonic imaginary part "  />
-	</file>
-	-->
-
-      </file_group>
-
-      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
-      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->   
-
-      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
-
-
-      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
-      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
-      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
-      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
-
-      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
-      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
-      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
-      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
-
-   </file_definition>
-    
-    <!-- 
-============================================================================================================
-= grid definition = = DO NOT CHANGE =
-============================================================================================================
-    -->
-    
-   <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
-      <axis id="ncatice" long_name="Ice categories"   unit="-"  />
-   </axis_definition> 
-    
-   <domain_definition src="./domain_def.xml"/>
-   
-   <grid_definition>    
-     <grid id="grid_T_2D" domain_ref="grid_T"/>
-     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
-     <grid id="grid_U_2D" domain_ref="grid_U"/>
-     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
-     <grid id="grid_V_2D" domain_ref="grid_V"/>
-     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
-     <grid id="grid_W_2D" domain_ref="grid_W"/>
-     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
-    </grid_definition>   
-  </context>
-  
-
-  <context id="xios">
-
-      <variable_definition>
-	
-     <!-- 
-        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
--->
-	  <variable id="buffer_size"               type="integer">5000000</variable>
-	  <variable id="buffer_server_factor_size" type="integer">2</variable>
-	  <variable id="info_level"                type="integer">0</variable>
-	  <variable id="using_server"              type="boolean">true</variable>
-	  <variable id="using_oasis"               type="boolean">false</variable>
-	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
-	
-      </variable_definition>
-               
-  </context>
-  
-</simulation>
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_demo.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_demo.xml	(revision 5659)
+++ 	(revision )
@@ -1,125 +1,0 @@
-<?xml version="1.0"?>
-<simulation> 
-
-  <context id="nemo" time_origin="1900-01-01 00:00:00" >
-    
-    <!-- $id$ -->
-    
-    <!-- 
-============================================================================================================
-=                                  definition of all existing variables                                    =
-=                                            DO NOT CHANGE                                                 =
-============================================================================================================
-    -->
-    <field_definition src="./field_def.xml"/>
-    <!-- 
-============================================================================================================
-=                                           output files definition                                        =
-=                                            Define your own files                                         =
-=                                         put the variables you want...                                    =
-============================================================================================================
-    -->
-    
-    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4">
-    
-      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."> <!-- 1h files -->
-	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <field field_ref="sst"  />
-	  <field field_ref="qsr"  />
-	</file>
-      </file_group>
-
-     
-      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."> <!-- 1d files -->
-	
-	<!-- example of "hand made" zoom  -->
-	<file id="file2" name_suffix="_grid_T_myzoom" >
-	  <!-- group of variables sharing the same zoom. see zoom definition in domain_def.xml -->
-	  <field_group id="blabla" domain_ref="myzoom" >    
-	    <field field_ref="toce" />
-	    <field field_ref="soce" />
-	  </field_group>
-	</file>
-	
-	<!-- mooring: automatic definition of the file name suffix based on id="0n180wT"  -->
-	<!-- include a group of variables. see field_def.xml for mooring variables definition  -->
-	<file id="0n180wT">
-	  <field_group group_ref="mooring" domain_ref="0n180wT" />  
-	</file>
-	
-	<!-- Equatorial section: automatic definition of the file name suffix based on id="EqT" -->
-	<!-- Zoom over vertical axis. def of axis_ref in the axis_definition bellow -->
-	<file id="EqT" >
-	  <field_group id="EqT" domain_ref="EqT" >
-	    <field field_ref="toce" name="votemper" axis_ref="deptht_myzoom"  />
-	    <field field_ref="sss" />
-	  </field_group>
-	</file>
-	
-	<!-- global file with different operations on data   -->
-	<file id="file3" >
-	  <field field_ref="toce"   default_value="-10" />    <!-- redefine the missing value -->
-	  <field field_ref="sst"    name="sstmooring1" domain_ref="0n180wT"  />   <!-- include a mooring -->
-	  <field field_ref="sst"    name="sst_1d_ave"  />                         <!-- mean -->
-	  <field field_ref="sst"    name="sst_1d_inst" operation="instant" />     <!-- instant value -->
-	  <field field_ref="sst"    name="sst_1d_max"  operation="maximum" />     <!-- max -->
-	  <field field_ref="suoce"  />   <!-- include a U-grid variable in the list -->
-	</file>
-	
-      </file_group>
-      
-    </file_definition>
-    
-    <!-- 
-============================================================================================================
-= grid definition = = DO NOT CHANGE =
-============================================================================================================
-    -->
-    
-   <axis_definition>  
-     <axis_group id="deptht" long_name="Vertical T levels" unit="m" positive="down" >
-       <axis id="deptht" />
-       <axis id="deptht_myzoom" zoom_begin="1" zoom_end="10" />
-     </axis_group>
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
-   </axis_definition> 
-    
-   <domain_definition src="./domain_def.xml"/>
-   
-   <grid_definition>    
-     <grid id="grid_T_2D" domain_ref="grid_T"/>
-     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
-     <grid id="grid_U_2D" domain_ref="grid_U"/>
-     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
-     <grid id="grid_V_2D" domain_ref="grid_V"/>
-     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
-     <grid id="grid_W_2D" domain_ref="grid_W"/>
-     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
-    </grid_definition>    
-
-  </context>
-  
-
-  <context id="xios">
-
-      <variable_definition>
-	
-     <!-- 
-        We must have buffer_size > jpi*jpj*jpk*8*3 (with jpi and jpj the subdomain size)
--->
-	  <variable id="buffer_size"               type="integer">25000000</variable>
-	  <variable id="buffer_server_factor_size" type="integer">2</variable>
-	  <variable id="info_level"                type="integer">0</variable>
-	  <variable id="using_server"              type="boolean">false</variable>
-	  <variable id="using_oasis"               type="boolean">false</variable>
-	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
-	
-      </variable_definition>
-               
-  </context>
-  
-</simulation>
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_oldstyle.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_oldstyle.xml	(revision 5659)
+++ 	(revision )
@@ -1,153 +1,0 @@
-<?xml version="1.0"?>
-<simulation> 
-
- <context id="nemo" time_origin="1900-01-01 00:00:00" >
-    
-    <!-- $id$ -->
-    
-    <!-- 
-============================================================================================================
-=                                  definition of all existing variables                                    =
-=                                            DO NOT CHANGE                                                 =
-============================================================================================================
-    -->
-    <field_definition src="./field_def.xml"/>
-    <!-- 
-============================================================================================================
-=                                           output files definition                                        =
-=                                            Define your own files                                         =
-=                                         put the variables you want...                                    =
-============================================================================================================
-    -->
-    
-    <file_definition type="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="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
-
-	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <field field_ref="toce"         name="votemper"  />
-	  <field field_ref="soce"         name="vosaline"  />
-	  <field field_ref="sst"          name="sosstsst"  />
-	  <field field_ref="sss"          name="sosaline"  />
-	  <field field_ref="ssh"          name="sossheig"  />
-	  <field field_ref="empmr"        name="sowaflup"  />
-	  <field field_ref="qsr"          name="soshfldo"  />
-          <field field_ref="saltflx"      name="sosfldow"  />
-	  <field field_ref="qt"           name="sohefldo"  />
-	  <field field_ref="mldr10_1"     name="somxl010"  />
-	  <field field_ref="mldkz5"       name="somixhgt"  />
-	  <field field_ref="ice_cover"    name="soicecov"  />
-	  <field field_ref="wspd"         name="sowindsp"  />
-	  <field field_ref="erp"          name="sowafldp"  />
-	  <field field_ref="ist_ipa"      name="soicetem"  />
-	  <field field_ref="icealb_cea"   name="soicealb"  />   
-	</file>
-	
-	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="uoce"         name="vozocrtx"  />
-	  <field field_ref="uoce_eiv"     name="vozoeivu"  />
-	  <field field_ref="utau"         name="sozotaux"  />
-	</file>
-	
-	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="voce"         name="vomecrty"  />
-	  <field field_ref="voce_eiv"     name="vomeeivv"  />
-	  <field field_ref="vtau"         name="sometauy"  />
-	</file>
-	
-	<file id="file4" name_suffix="_grid_W" description="ocean V grid variables" >
-	  <field field_ref="woce"         name="vovecrtz" />
-	  <field field_ref="avt"          name="votkeavt" />
-	  <field field_ref="avs"          name="voddmavs" />
-	  <field field_ref="aht2d_eiv"    name="soleaeiw" />
-	</file>
-	
-	<file id="file5" name_suffix="_icemod" description="ocean V grid variables" >
-	  <field field_ref="ice_pres"                     />
-	  <field field_ref="snowthic_cea" name="isnowthi" />
-	  <field field_ref="icethic_cea"  name="iicethic" />
-	  <field field_ref="iceprod_cea"  name="iiceprod" />
-	  <field field_ref="ist_ipa"      name="iicetemp" />
-	  <field field_ref="ioceflxb"     name="ioceflxb" />
-	  <field field_ref="uice_ipa"     name="iicevelu" />
-	  <field field_ref="vice_ipa"     name="iicevelv" />
-	  <field field_ref="utau_ice"     name="iicestru" />
-	  <field field_ref="vtau_ice"     name="iicestrv" />
-	  <field field_ref="qsr_io_cea"   name="iicesflx" />
-	  <field field_ref="qns_io_cea"   name="iicenflx" />
-	  <field field_ref="snowpre"      name="isnowpre" />
-	</file>
-	
-      </file_group>
-
-      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
-      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
-      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
-      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
-      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
-
-      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
-      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
-      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
-      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
-
-   </file_definition>
-    
-    <!-- 
-============================================================================================================
-= grid definition = = DO NOT CHANGE =
-============================================================================================================
-    -->
-    
-   <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
-   </axis_definition> 
-    
-   <domain_definition src="./domain_def.xml"/>
-   
-   <grid_definition>    
-     <grid id="grid_T_2D" domain_ref="grid_T"/>
-     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
-     <grid id="grid_U_2D" domain_ref="grid_U"/>
-     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
-     <grid id="grid_V_2D" domain_ref="grid_V"/>
-     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
-     <grid id="grid_W_2D" domain_ref="grid_W"/>
-     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
-    </grid_definition>   
-  </context>
-
-  <context id="xios">
-
-      <variable_definition>
-	
-     <!-- 
-        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
--->
-	  <variable id="buffer_size"               type="integer">25000000</variable>
-	  <variable id="buffer_server_factor_size" type="integer">2</variable>
-	  <variable id="info_level"                type="integer">0</variable>
-	  <variable id="using_server"              type="boolean">false</variable>
-	  <variable id="using_oasis"               type="boolean">false</variable>
-	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
-	
-      </variable_definition>
-               
-  </context>
-  
-</simulation>
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/cpp_ORCA2_LIM3.fcm
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/cpp_ORCA2_LIM3.fcm	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM3/cpp_ORCA2_LIM3.fcm	(revision 5682)
@@ -1,1 +1,1 @@
- bld::tool::fppkeys key_trabbl key_lim3 key_vvl key_dynspg_ts key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc
+ bld::tool::fppkeys key_trabbl key_lim3 key_vvl key_dynspg_ts key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_asminc 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg	(revision 5682)
@@ -110,5 +110,5 @@
 !!   namsbc_clio     CLIO bulk formulea formulation
 !!   namsbc_core     CORE bulk formulea formulation
-!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namsbc_cpl      CouPLed            formulation                     ("key_oasis3")
 !!   namtra_qsr      penetrative solar radiation
 !!   namsbc_rnf      river runoffs
@@ -199,5 +199,5 @@
 /
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
 !-----------------------------------------------------------------------
 !                    !     description       !  multiple  !    vector   !      vector          ! vector !
@@ -640,5 +640,5 @@
                            !        = 1 add a tke source below the ML
                            !        = 2 add a tke source just at the base of the ML
-                           !        = 3 as = 1 applied on HF part of the stress    ("key_coupled")
+                           !        = 3 as = 1 applied on HF part of the stress    ("key_oasis3")
    rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
    nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/iodef.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/iodef.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/iodef.xml	(revision 5682)
@@ -36,64 +36,64 @@
 
 	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <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="ssh2"         name="zossq"    long_name="square_of_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="mldkz5"       />
-	  <field field_ref="mldr10_1"     />
+	  <field field_ref="toce"         name="thetao" />
+	  <field field_ref="soce"         name="so"     />
+	  <field field_ref="sst"          name="tos"    />
+	  <field field_ref="sst2"         name="tossq"  />
+	  <field field_ref="sss"          name="sos"    />
+	  <field field_ref="ssh"          name="zos"    />
+	  <field field_ref="ssh2"         name="zossq"  />
+	  <field field_ref="empmr"        name="wfo"    />
+	  <field field_ref="qsr"          name="rsntds" />
+	  <field field_ref="qt"           name="tohfls" />
+	  <field field_ref="taum"     />
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
 	</file>
 	
 	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
-	  <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    />
-	  <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" />
+	  <field field_ref="uoce"         name="uo"    />
+	  <field field_ref="ssu"          name="uos"   />
+	  <field field_ref="utau"         name="tauuo" />
 	</file>
 	
 	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
-	  <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    />
-	  <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" />
+	  <field field_ref="voce"         name="vo"    />
+	  <field field_ref="ssv"          name="vos"   />
+	  <field field_ref="vtau"         name="tauvo" />
 	</file>
 	
 	<file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >
-	  <field field_ref="woce"         name="wo"      long_name="ocean vertical velocity"         />
-	  <field field_ref="avt"          name="difvho"  long_name="ocean_vertical_heat_diffusivity" />
+	  <field field_ref="woce"         name="wo"     />
+	  <field field_ref="avt"          name="difvho" />
 	</file>
 	
 	<file id="file5" name_suffix="_icemod" description="ice variables" >
-	  <field field_ref="ice_pres"                     />
-	  <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"   />
-	  <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        />
-	  <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        />
-	  <field field_ref="ist_ipa"      />
-	  <field field_ref="ioceflxb"     />
-	  <field field_ref="uice_ipa"     />
-	  <field field_ref="vice_ipa"     />
-	  <field field_ref="utau_ice"     />
-	  <field field_ref="vtau_ice"     />
-	  <field field_ref="qsr_io_cea"   />
-	  <field field_ref="qns_io_cea"   />
-	  <field field_ref="snowpre"      />
+	  <field field_ref="ice_pres"   />
+	  <field field_ref="snowthic_cea" name="snd" />
+	  <field field_ref="icethic_cea"  name="sit" />
+	  <field field_ref="iceprod_cea"  name="sip" />
+	  <field field_ref="ist_ipa"    />
+	  <field field_ref="ioceflxb"   />
+	  <field field_ref="uice_ipa"   />
+	  <field field_ref="vice_ipa"   />
+	  <field field_ref="utau_ice"   />
+	  <field field_ref="vtau_ice"   />
+	  <field field_ref="qsr_io_cea" />
+	  <field field_ref="qns_io_cea" />
+	  <field field_ref="snowpre"    />
 	</file>
 
 
 	<file id="file6" name_suffix="_ptrc_T" description="sms variables" >
-          <field field_ref="CFC11"      />
-          <field field_ref="C14B" />
+          <field field_ref="CFC11" />
+          <field field_ref="C14B"  />
 	</file>
 	
 	<file id="file7" name_suffix="_diad_T" description="additional diagnostics" >
-          <field field_ref="qtrCFC11"     />
-          <field field_ref="qintCFC11"     />
-          <field field_ref="qtrC14b"     />
-          <field field_ref="qintC14b"     />
-          <field field_ref="fdecay"     />
+          <field field_ref="qtrCFC11"  />
+          <field field_ref="qintCFC11" />
+          <field field_ref="qtrC14b"   />
+          <field field_ref="qintC14b"  />
+          <field field_ref="fdecay"    />
 	</file>
 
@@ -120,10 +120,13 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
    </axis_definition> 
     
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/iodef.xml_cfc
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/iodef.xml_cfc	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/iodef.xml_cfc	(revision 5682)
@@ -1,3 +1,6 @@
 <?xml version="1.0"?>
+
+<!-- WARNING: THIS XML FILE IS FOR THE DEPRECATED XMLIO SERVER: IT WILL NOT WORK WITH XIOS! -->
+
 <simulation> 
   
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg	(revision 5682)
@@ -104,5 +104,5 @@
 /
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
 !-----------------------------------------------------------------------
 /
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml	(revision 5682)
@@ -34,15 +34,15 @@
 
 	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       />
-	  <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          />
-	  <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                />
+	  <field field_ref="sst"          name="tos" />
+	  <field field_ref="sss"          name="sos" />
+	  <field field_ref="ssh"          name="zos" />
 	</file>
 
 	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    />
+	  <field field_ref="ssu"          name="uos" />
 	</file>
 	
 	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    />
+	  <field field_ref="ssv"          name="vos" />
 	</file>
 
@@ -55,4 +55,5 @@
           <field field_ref="tintpp"   name="tintpp"   unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field>
           <field field_ref="pno3tot"  name="pno3tot"  unit="umolN"  > pno3tot * 16. / 122. * 1e6 </field>
+          <field field_ref="ppo4tot"  name="ppo4tot"  unit="umolP"  > ppo4tot * 1. / 122. * 1e6 </field>
           <field field_ref="psiltot"  name="psiltot"  unit="umolC"  > psiltot * 1e6  </field>
           <field field_ref="palktot"  name="palktot"  unit="umolC"  > palktot * 1e6  </field>
@@ -66,58 +67,49 @@
 
 	<file id="file5" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <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="ssh2"         name="zossq"    long_name="square_of_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="mldkz5"       />
-	  <field field_ref="mldr10_1"     />
-           <!-- variables available with MLE
-          <field field_ref="Lf_NHpf"    name="Lf_NHpf"  long_name="MLE:_Lf=NH/f"     />
-	   -->
+	  <field field_ref="toce"         name="thetao" />
+	  <field field_ref="soce"         name="so"     />
+	  <field field_ref="sst"          name="tos"    />
+	  <field field_ref="sst2"         name="tossq"  />
+	  <field field_ref="sss"          name="sos"    />
+	  <field field_ref="ssh"          name="zos"    />
+	  <field field_ref="ssh2"         name="zossq"  />
+	  <field field_ref="empmr"        name="wfo"    />
+	  <field field_ref="qsr"          name="rsntds" />
+	  <field field_ref="qt"           name="tohfls" />
+	  <field field_ref="taum"     />
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
 	</file>
 	
 	<file id="file6" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
-	  <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    />
-	  <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" />
-          <!-- variables available with MLE
-          <field field_ref="psiu_mle"     name="psiu_mle"  long_name="MLE_streamfunction_along_i-axis" />
-	  -->
+	  <field field_ref="uoce"         name="uo"     />
+	  <field field_ref="ssu"          name="uos"    />
+	  <field field_ref="utau"         name="tauuo"  />
 	</file>
 	
 	<file id="file7" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
-	  <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    />
-	  <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" />
-          <!-- variables available with MLE
-          <field field_ref="psiv_mle"     name="psiv_mle"  long_name="MLE_streamfunction_along_j-axis" />
-	  -->
+	  <field field_ref="voce"         name="vo"     />
+	  <field field_ref="ssv"          name="vos"    />
+	  <field field_ref="vtau"         name="tauvo"  />
 	</file>
 	
 	<file id="file8" name_suffix="_grid_W" description="ocean W grid variables" >
-	  <field field_ref="woce"         name="wo"      long_name="ocean vertical velocity"         />
-	  <field field_ref="avt"          name="difvho"  long_name="ocean_vertical_heat_diffusivity" />
+	  <field field_ref="woce"         name="wo"     />
+	  <field field_ref="avt"          name="difvho" />
 	</file>
 	
 	<file id="file9" name_suffix="_icemod" description="ice variables" >
-	  <field field_ref="ice_pres"                     />
-	  <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"   />
-	  <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        />
-	  <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        />
-	  <field field_ref="ist_ipa"      />
-	  <field field_ref="uice_ipa"     />
-	  <field field_ref="vice_ipa"     />
-	  <field field_ref="utau_ice"     />
-	  <field field_ref="vtau_ice"     />
-	  <field field_ref="qsr_io_cea"   />
-	  <field field_ref="qns_io_cea"   />
-	  <field field_ref="snowpre"      />
+	  <field field_ref="ice_pres"   />
+	  <field field_ref="snowthic_cea" name="snd"    />
+	  <field field_ref="icethic_cea"  name="sit"    />
+	  <field field_ref="iceprod_cea"  name="sip"    />
+	  <field field_ref="ist_ipa"    />
+	  <field field_ref="uice_ipa"   />
+	  <field field_ref="vice_ipa"   />
+	  <field field_ref="utau_ice"   />
+	  <field field_ref="vtau_ice"   />
+	  <field field_ref="qsr_io_cea" />
+	  <field field_ref="qns_io_cea" />
+	  <field field_ref="snowpre"    />
 	</file>
 	
@@ -245,10 +237,13 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
    </axis_definition> 
     
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top_cfg	(revision 5682)
@@ -5,5 +5,4 @@
 &namtrc_run     !   run information
 !-----------------------------------------------------------------------
-   ln_top_euler  = .true.    !  use Euler time-stepping for TOP
 /
 !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml	(revision 5682)
@@ -39,4 +39,5 @@
            <field field_ref="tintpp"   name="tintpp"   unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field>
            <field field_ref="pno3tot"  name="pno3tot"  unit="umolN"  > pno3tot * 16. / 122. * 1e6 </field>
+           <field field_ref="ppo4tot"  name="ppo4tot"  unit="umolP"  > ppo4tot * 1. / 122. * 1e6 </field>
            <field field_ref="psiltot"  name="psiltot"  unit="umolC"  > psiltot * 1e6  </field>
            <field field_ref="palktot"  name="palktot"  unit="umolC"  > palktot * 1e6  </field>
@@ -167,10 +168,13 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
    </axis_definition> 
     
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg	(revision 5682)
@@ -67,4 +67,5 @@
 !-----------------------------------------------------------------------
    nn_fsbc     = 1         !  frequency of surface boundary condition computation 
+   ln_rnf      = .false.   !  runoffs
 /  
 !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg	(revision 5682)
@@ -6,5 +6,4 @@
 !-----------------------------------------------------------------------
    nn_writetrc   =  1460     !  time step frequency for sn_tracer outputs
-   ln_top_euler  = .true.    !  use Euler time-stepping for TOP
 /
 !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/iodef.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/iodef.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/iodef.xml	(revision 5682)
@@ -31,64 +31,64 @@
       <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."> <!-- 1d files -->
 
-
 	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <field field_ref="sst"          name="sosstsst"      long_name="sea_surface_temperature"                       />
-	  <field field_ref="sss"          name="sosaline"      long_name="sea_surface_salinity"                          />
-	  <field field_ref="ssh"          name="sossheig"      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="mldr10_1"     />
+	  <field field_ref="sst"          name="sosstsst" />
+	  <field field_ref="sss"          name="sosaline" />
+	  <field field_ref="ssh"          name="sossheig" />
+	  <field field_ref="empmr"        name="wfo"      />
+	  <field field_ref="qsr"          name="rsntds"   />
+	  <field field_ref="qt"           name="tohfls"   />
+	  <field field_ref="mldr10_1" />
 	</file>
 
 	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="suoce"        name="suoce"     long_name="sea_surface_x_velocity"    />
+	  <field field_ref="ssu"          name="suoce" />
 	</file>
 	
 	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="svoce"        name="svoce"     long_name="sea_surface_y_velocity"    />
+	  <field field_ref="ssv"          name="svoce" />
 	</file>
 
       </file_group>
+
       <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
       <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->
 
 	<file id="file4" name_suffix="_grid_T" description="ocean T grid variables" >
-	  <field field_ref="sst"          name="sosstsst"      long_name="sea_surface_temperature"                       />
-	  <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             />
-	  <field field_ref="sss"          name="sosaline"      long_name="sea_surface_salinity"                          />
-	  <field field_ref="ssh"          name="sossheig"      long_name="sea_surface_height_above_geoid"                />
-	  <field field_ref="ssh2"         name="zossq"    long_name="square_of_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="mldkz5"       />
-	  <field field_ref="mldr10_1"     />
+	  <field field_ref="sst"          name="sosstsst" />
+	  <field field_ref="sst2"         name="tossq"    />
+	  <field field_ref="sss"          name="sosaline" />
+	  <field field_ref="ssh"          name="sossheig" />
+	  <field field_ref="ssh2"         name="zossq"    />
+	  <field field_ref="empmr"        name="wfo"      />
+	  <field field_ref="qsr"          name="rsntds"   />
+	  <field field_ref="qt"           name="tohfls"   />
+	  <field field_ref="taum"     />
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
 	</file>
 	
 	<file id="file5" name_suffix="_grid_U" description="ocean U grid variables" >
-	  <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    />
-	  <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" />
+	  <field field_ref="ssu"          name="uos"   />
+	  <field field_ref="utau"         name="tauuo" />
 	</file>
 	
 	<file id="file6" name_suffix="_grid_V" description="ocean V grid variables" >
-	  <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    />
-	  <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" />
+	  <field field_ref="ssv"          name="vos"   />
+	  <field field_ref="vtau"         name="tauvo" />
 	</file>
 	
 	<file id="file7" name_suffix="_icemod" description="ice variables" >
-	  <field field_ref="ice_pres"                     />
-	  <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"   />
-	  <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        />
-	  <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        />
-	  <field field_ref="ist_ipa"      />
-	  <field field_ref="uice_ipa"     />
-	  <field field_ref="vice_ipa"     />
-	  <field field_ref="utau_ice"     />
-	  <field field_ref="vtau_ice"     />
-	  <field field_ref="qsr_io_cea"   />
-	  <field field_ref="qns_io_cea"   />
-	  <field field_ref="snowpre"      />
+	  <field field_ref="ice_pres"   />
+	  <field field_ref="snowthic_cea" name="snd" />
+	  <field field_ref="icethic_cea"  name="sit" />
+	  <field field_ref="iceprod_cea"  name="sip" />
+	  <field field_ref="ist_ipa"    />
+	  <field field_ref="uice_ipa"   />
+	  <field field_ref="vice_ipa"   />
+	  <field field_ref="utau_ice"   />
+	  <field field_ref="vtau_ice"   />
+	  <field field_ref="qsr_io_cea" />
+	  <field field_ref="qns_io_cea" />
+	  <field field_ref="snowpre"    />
 	</file>
    
@@ -115,11 +115,14 @@
     
    <axis_definition>  
-      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
-      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
-      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
-      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
-      <axis id="nfloat" long_name="Float number"      unit="-"  />
-      <axis id="icbcla" long_name="Iceberg class"     unit="-"  />
-   </axis_definition> 
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category class" unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </axis_definition>
     
    <domain_definition src="./domain_def.xml"/>
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/domain_def.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/domain_def.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/domain_def.xml	(revision 5682)
@@ -169,10 +169,15 @@
       </domain_group>
 
-      <domain_group id="scalarpoint">
-         <domain id="scalarpoint" long_name="scalar"/>
-         <!--
-         <domain id="1point" zoom_ibegin="1" zoom_jbegin="1" zoom_ni="1" zoom_nj="1" />
-         -->
+      <domain_group id="scalarpoint"> 
+         <domain id="scalarpoint" long_name="scalar"/> 
+         <!-- 
+         <domain id="1point" zoom_ibegin="1" zoom_jbegin="1" zoom_ni="1" zoom_nj="1" /> 
+         --> 
       </domain_group>
+
+      <domain_group id="gznl">
+         <domain id="ptr" long_name="zonal mean grid" zoom_ibegin="0000"  zoom_jbegin="1" zoom_ni="1" zoom_nj="0000" />
+      </domain_group>
+
 
    </domain_definition>    
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/field_def.xml
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/field_def.xml	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/field_def.xml	(revision 5682)
@@ -13,241 +13,265 @@
    <field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined -->
 
+    <!-- 
+============================================================================================================
+                                  Physical ocean and ice model variables
+============================================================================================================
+    -->
+
       <!-- T grid -->
       
-     <field_group id="grid_T" grid_ref="grid_T_2D" >
-         <field id="toce"         long_name="temperature"                               unit="degC" grid_ref="grid_T_3D"/>
-         <field id="soce"         long_name="salinity"                                  unit="psu"  grid_ref="grid_T_3D"/>
-         <field id="sst"          long_name="sea surface temperature"                   unit="degC"                     />
-         <field id="sst2"         long_name="square of sea surface temperature"         unit="degC2"                    />
-         <field id="sstgrad"      long_name="module of sst gradient"                    unit="degC/m"                   />
-         <field id="sstgrad2"     long_name="square of module of sst gradient"          unit="degC2/m2"                 />
-         <field id="sss"          long_name="sea surface salinity"                      unit="psu"                      />
-         <field id="sss2"         long_name="square of sea surface salinity"            unit="psu2"                     />
-         <field id="ssh"          long_name="sea surface height"                        unit="m"                        />
-         <field id="ssh2"         long_name="square of sea surface height"              unit="m2"                       />
-         <field id="mldkz5"       long_name="mixing layer depth (Turbocline)"           unit="m"                        />
-         <field id="mldr10_1"     long_name="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        />
-         <field id="heatc"        long_name="Heat content vertically integrated"        unit="J/m2"                      />
-         <field id="saltc"        long_name="Salt content vertically integrated"        unit="PSU*kg/m2"                />
+      <field_group id="grid_T" grid_ref="grid_T_2D" >
+         <field id="e3t"          long_name="T-cell thickness"   standard_name="cell_thickness"   unit="m"   grid_ref="grid_T_3D"/>
+
+         <field id="toce"         long_name="temperature"         standard_name="sea_water_potential_temperature"   unit="degC"     grid_ref="grid_T_3D"/>
+         <field id="toce_e3t"     long_name="temperature * e3t"                                                     unit="degC*m"   grid_ref="grid_T_3D" > toce * e3t </field >
+         <field id="soce"         long_name="salinity"            standard_name="sea_water_practical_salinity"      unit="1e-3"     grid_ref="grid_T_3D"/>
+         <field id="soce_e3t"     long_name="salinity * e3t"                                                        unit="1e-3*m"   grid_ref="grid_T_3D" > soce * e3t </field >
+
+         <field id="sst"          long_name="sea surface temperature"             standard_name="sea_surface_temperature"             unit="degC"     />
+         <field id="sst2"         long_name="square of sea surface temperature"   standard_name="square_of_sea_surface_temperature"   unit="degC2"     > 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="degC/m"   />
+         <field id="sstgrad2"     long_name="square of module of sst gradient"                                                        unit="degC2/m2" />
+         <field id="sbt"          long_name="sea bottom temperature"                                                                  unit="degC"     />
+	 
+         <field id="sss"          long_name="sea surface salinity"             standard_name="sea_surface_salinity"   unit="1e-3" />
+         <field id="sss2"         long_name="square of sea surface salinity"                                          unit="1e-6"  > sss * sss </field >
+         <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="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="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="1e-3*kg/m2" />
+
          <!-- EOS -->
-         <field id="alpha"        long_name="thermal expansion"                         unit="1/degC" grid_ref="grid_T_3D"/>
-         <field id="beta"         long_name="haline contraction"                        unit="1/psu"  grid_ref="grid_T_3D"/>
-         <field id="bn2"          long_name="squared Brunt-Vaisala frequency"           unit="1/s"    grid_ref="grid_T_3D"/>
-         <field id="rhop"         long_name="potential density (sigma0)"                unit="kg/m3"  grid_ref="grid_T_3D"/>
+         <field id="alpha"        long_name="thermal expansion"                                                         unit="degC-1" grid_ref="grid_T_3D" />
+         <field id="beta"         long_name="haline contraction"                                                        unit="1e3"    grid_ref="grid_T_3D" />
+         <field id="bn2"          long_name="squared Brunt-Vaisala frequency"                                           unit="s-1"    grid_ref="grid_T_3D" />
+         <field id="rhop"         long_name="potential density (sigma0)"        standard_name="sea_water_sigma_theta"   unit="kg/m3"  grid_ref="grid_T_3D" />
+
          <!-- Energy - horizontal divergence -->
-         <field id="eken"         long_name="kinetic energy"                            unit="m2/s2"  grid_ref="grid_T_3D"/>
-         <field id="hdiv"         long_name="horizontal divergence"                     unit="s-1"    grid_ref="grid_T_3D"/>
+         <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"                        />
+         <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 (max dT/dz)"             unit="m"                        />
-         <field id="mldr10_3"     long_name="Mixed Layer Depth dr=0.03 (ref.10m)"       unit="m"                        />
-         <field id="mldr0_1"      long_name="Mixed Layer Depth dr=0.01 (ref.surf)"      unit="m"                        />
-         <field id="mldr0_3"      long_name="Mixed Layer Depth dr=0.03 (ref.surf)"      unit="m"                        />
-         <field id="mld_dt02"     long_name="Mixed Layer Depth |dt|=0.2 (ref.10m)"      unit="m"                        />
-         <field id="topthdep"     long_name="Top of the thermocline dt=-0.2 (ref.10m)"  unit="m"                        />
-         <field id="pycndep"      long_name="Pycnocline depth dr~dt=-0.2 (ref.10m)"     unit="m"                        />
-         <field id="BLT"          long_name="Barrier Layer Thickness"                   unit="m"                        />
-         <field id="tinv"         long_name="Max of vertical invertion of temperature"  unit="degC"                     />
-         <field id="depti"        long_name="Depth of max. vert. inv. of temperature"   unit="m"                        />
-         <field id="20d"          long_name="Depth of 20C isotherm"                     unit="m"                        />
-         <field id="28d"          long_name="Depth of 28C isotherm"                     unit="m"                        />
-         <field id="hc300"        long_name="Heat content 300 m"                        unit="W"                        />
+         <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="degC"                      />
+         <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="Pressure at sea floor"                     unit="dbar"                     />
-         <!-- variables available with key_diaar5/key_vvl -->
-         <field id="cellthc"      long_name="Cell thickness"                            unit="m"    grid_ref="grid_T_3D"/>
+         <field id="botpres"      long_name="Pressure at sea floor"   standard_name="sea_water_pressure_at_sea_floor"   unit="dbar" />
+
          <!-- variables available with key_vvl -->
-         <field id="tpt_dep"      long_name="T-point depth"                             unit="m"    grid_ref="grid_T_3D"/>
-         <field id="e3tdef"       long_name="T-cell thickness deformation"              unit="%"    grid_ref="grid_T_3D"/>
-     </field_group>
-
-     <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 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_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>
-
+      <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"                                        unit="kg/m2/s"  />
-         <field id="saltflx"      long_name="Downward salt flux"                                           unit="PSU/m2/s"  />
-         <field id="fmmflx"       long_name="Water flux due to freezing/melting"                           unit="kg/m2/s"  />
-         <field id="snowpre"      long_name="Snow precipitation"                                           unit="kg/m2/s"  />
-         <field id="runoffs"      long_name="River Runoffs"                                                unit="Kg/m2/s"  />
-         <field id="precip"       long_name="Total precipitation"                                           unit="kg/m2/s"  />
-
-
-         <field id="qt"           long_name="Net Downward Heat Flux"                                       unit="W/m2"     />
-         <field id="qns"          long_name="non solar Downward Heat Flux"                                 unit="W/m2"     />
-         <field id="qsr"          long_name="Shortwave Radiation"                                          unit="W/m2"     />
-         <field id="qsr3d"        long_name="Shortwave Radiation 3D distribution"  grid_ref="grid_T_3D"    unit="W/m2"     />
-         <field id="qrp"          long_name="Surface Heat Flux: Damping"                                   unit="W/m2"     />
-         <field id="erp"          long_name="Surface Water Flux: Damping"                                  unit="Kg/m2/s"  />
-         <field id="taum"         long_name="wind stress module"                                           unit="N/m2"     />
-         <field id="wspd"         long_name="Wind speed module at 10 m"                                    unit="m/s"      />
+         <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="saltflx"      long_name="Downward salt flux"                                                                                                        unit="1e-3/m2/s" />
+         <field id="fmmflx"       long_name="Water flux due to freezing/melting"                                                                                        unit="kg/m2/s"   />
+         <field id="snowpre"      long_name="Snow precipitation"                   standard_name="snowfall_flux"                                                        unit="kg/m2/s"   />
+         <field id="runoffs"      long_name="River Runoffs"                        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"                         unit="m"        />
+         <!-- * 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="fwfisf"       long_name="Ice shelf melting"                                            unit="Kg/m2/s"  />
-         <field id="qisf"         long_name="Ice Shelf Heat Flux"                                          unit="W/m2"     />
-         <field id="isfgammat"    long_name="transfert coefficient for isf (temperature) "                 unit="m/s"      />
-         <field id="isfgammas"    long_name="transfert coefficient for isf (salinity)    "                 unit="m/s"      />
- 	     <field id="stbl"         long_name="salinity in the Losh tbl                    "                 unit="PSU"      />
-	     <field id="ttbl"         long_name="temperature in the Losh tbl                 "                 unit="C"        />
+         <field id="fwfisf"       long_name="Ice shelf melting"                             unit="kg/m2/s"  />
+         <field id="qisf"         long_name="Ice Shelf Heat Flux"                           unit="W/m2"     />
+         <field id="isfgammat"    long_name="transfert coefficient for isf (temperature)"   unit="m/s"      />
+         <field id="isfgammas"    long_name="transfert coefficient for isf (salinity)"      unit="m/s"      />
+         <field id="stbl"         long_name="salinity in the Losh tbl"                      unit="1e-3"     />
+         <field id="ttbl"         long_name="temperature in the Losh tbl"                   unit="degC"     />
 
          <!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
-         <field id="qlw_oce"      long_name="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     />
-         <field id="qsb_oce"      long_name="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     />
-         <field id="qla_oce"      long_name="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     />
-         <field id="qhc_oce"      long_name="Downward Heat Content of E-P over open ocean"                 unit="W/m2"     />
-         <field id="taum_oce"     long_name="wind stress module over open ocean"                           unit="N/m2"     />
-
-         <!-- available key_coupled -->
-         <field id="snow_ao_cea"   long_name="Snow over ice-free ocean (cell average)"                     unit="kg/m2/s"  />
-         <field id="snow_ai_cea"   long_name="Snow over sea-ice (cell average)"                            unit="kg/m2/s"  />
-         <field id="subl_ai_cea"   long_name="Sublimation over sea-ice (cell average)"                     unit="kg/m2/s"  />
-         <field id="icealb_cea"    long_name="Ice albedo (cell average)"                                   unit="1"        />
-         <field id="calving"       long_name="Calving"                                                     unit="kg/m2/s"  />
-         <!-- available if key_coupled + conservative method -->
-         <field id="rain"          long_name="Liquid precipitation"                                        unit="Kg/m2/s"  />
-         <field id="evap_ao_cea"   long_name="Evaporation over ice-free ocean (cell average)"              unit="kg/m2/s"  />
-         <!-- variables available with key_diaar5 -->
-         <field id="isnwmlt_cea"   long_name="Snow over Ice melting (cell average)"                        unit="kg/m2/s"  />
-         <field id="fsal_virt_cea" long_name="Virtual salt flux due to ice formation (cell average)"       unit="kg/m2/s"  />
-         <field id="fsal_real_cea" long_name="Real salt flux due to ice formation (cell average)"          unit="kg/m2/s"  />
-         <field id="hflx_rain_cea" long_name="heat flux due to rainfall"                                   unit="W/m2"     />
-         <field id="hflx_evap_cea" long_name="heat flux due to evaporation"                                unit="W/m2"     />
-         <field id="hflx_snow_cea" long_name="heat flux due to snow falling over ice-free ocean"           unit="W/m2"     />
-         <field id="hflx_ice_cea"  long_name="heat flux due to ice thermodynamics"                         unit="W/m2"     />
-         <field id="hflx_rnf_cea"  long_name="heat flux due to runoffs"                                    unit="W/m2"     />
-         <field id="hflx_cal_cea"  long_name="heat flux due to calving"                                    unit="W/m2"     />
-         <field id="bicemel_cea"   long_name="Rate of Melt at Sea Ice Base (cell average)"                 unit="kg/m2/s"  />
-         <field id="licepro_cea"   long_name="Lateral Sea Ice Growth Rate (cell average)"                  unit="kg/m2/s"  />
-         <field id="snowmel_cea"   long_name="Snow Melt Rate (cell average)"                               unit="kg/m2/s"  />
-         <field id="sntoice_cea"   long_name="Snow-Ice Formation Rate (cell average)"                      unit="kg/m2/s"  />
-         <field id="ticemel_cea"      long_name="Rate of Melt at Upper Surface of Sea Ice (cell average)"     unit="kg/m2/s"  />
-
-	 <!-- ice fields -->
-
-         <field id="ice_cover"    long_name="Ice fraction"                                                 unit="1"        />
-
-         <field id="qsr_ai_cea"   long_name="Air-Ice downward solar heat flux (cell average)"              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)"             unit="W/m2"     />
+         <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="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_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)"              unit="W/m2"     />
-         <field id="qns_io_cea"   long_name="Ice-Oce downward non-solar heat flux (cell average)"          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)"                                unit="m"        />
-         <field id="icethic_cea"  long_name="Ice thickness (cell average)"                                 unit="m"        />
-         <field id="iceprod_cea"  long_name="Ice production (cell average)"                                unit="m/s"      />
-         <field id="iiceconc"     long_name="Ice concentration"                                            unit=""         />
+         <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)"                       unit="degC"     />
-         <field id="ist_ipa"      long_name="Ice surface temperature (ice presence average)"               unit="degC"     />      
-         <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />      
-         <field id="vice_ipa"     long_name="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />      
+         <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="degC"         />
+         <field id="ist_ipa"      long_name="Ice surface temperature (ice presence average)"               standard_name="surface_temperature"                                unit="degC"         />      
+         <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"             unit="N/m2"     />
-         <field id="vtau_ice"     long_name="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
+         <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"                          unit="kg/s"     />
-         <field id="v_imasstr"    long_name="Sea-ice mass transport along j-axis"                          unit="kg/s"     />
-         <field id="emp_x_sst"    long_name="Concentration/Dilution term on SST"                           unit="kgC/m2/s" />
-         <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                         unit="kgPSU/m2/s" />        
+         <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*degC/m2/s" />
+         <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                                                                                              unit="kg*1e-3/m2/s" />        
        
-         <field id="iceconc"      long_name="ice concentration"                                            unit="%"        />
-         <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />
-         <field id="vice_ipa"     long_name="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />
-       	 <field id="isst"         long_name="sea surface temperature"                                      unit="degC"     />
-         <field id="isss"         long_name="sea surface salinity"                                         unit="psu"      /> 
-         <field id="qt_oce"       long_name="total flux at ocean surface"                                  unit="W/m2"     />
-         <field id="qsr_oce"      long_name="solar heat flux at ocean 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 flux at ice surface"                                    unit="W/m2"     />
-         <field id="qsr_ice"      long_name="solar heat flux at ice surface"                               unit="W/m2"     />
-         <field id="qns_ice"      long_name="non-solar heat flux at ice surface"                           unit="W/m2"     />
-         <field id="qtr_ice"      long_name="solar heat flux transmitted thru the ice"                     unit="W/m2"     />
-         <field id="utau_ice"     long_name="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     />
-         <field id="vtau_ice"     long_name="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
-         <field id="micesalt"     long_name="Mean ice salinity"                                            unit="psu"      />
-         <field id="miceage"      long_name="Mean ice age"                                                 unit="years"    />
+         <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="degC"         />
+         <field id="isss"         long_name="sea surface salinity"                                         standard_name="sea_surface_salinity"                               unit="1e-3"         /> 
+         <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="1e-3"         />
+         <field id="miceage"      long_name="Mean ice age"                                                                                                                    unit="years"        />
 
          <field id="iceage_cat"   long_name="Ice age for categories"                                       unit="days"   axis_ref="ncatice" />
@@ -255,9 +279,11 @@
          <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="ppt"    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="degC"   axis_ref="ncatice" />
+         <field id="snwtemp_cat"  long_name="Snow temperature for categories"                              unit="degC"   axis_ref="ncatice" />
 
          <field id="micet"        long_name="Mean ice temperature"                                         unit="degC"     />
-         <field id="icehc"        long_name="ice total heat content"                                       unit="10^9J"   /> 
+         <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="degC"     />
@@ -266,23 +292,24 @@
          <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="10-8s-1"  />
-         <field id="ishear"       long_name="shear"                                                        unit="10-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="deitrp"       long_name="advected ice enhalpy"                                         unit="W/m2"   />
-         <field id="destrp"       long_name="advected snw enhalpy"                                         unit="W/m2"   />
-
-         <field id="sfxbri"       long_name="brine salt flux"                                              unit="psu*kg/m2/day" />
-         <field id="sfxdyn"       long_name="salt flux from ridging rafting"                               unit="psu*kg/m2/day" />
-         <field id="sfxres"       long_name="salt flux from lipupdate (resultant)"                         unit="psu*kg/m2/day" />
-         <field id="sfxbog"       long_name="salt flux from bot growth"                                    unit="psu*kg/m2/day" />
-         <field id="sfxbom"       long_name="salt flux from bot melt"                                      unit="psu*kg/m2/day" />
-         <field id="sfxsum"       long_name="salt flux from surf melt"                                     unit="psu*kg/m2/day" />
-         <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="psu*kg/m2/day" />
-         <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="psu*kg/m2/day" />
-         <field id="sfx"          long_name="salt flux total"                                              unit="psu*kg/m2/day" />
+         <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="1e-3*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="1e-3*kg/m2/day" />
+         <field id="sfxdyn"       long_name="salt flux from ridging rafting"                               unit="1e-3*kg/m2/day" />
+         <field id="sfxres"       long_name="salt flux from lipupdate (resultant)"                         unit="1e-3*kg/m2/day" />
+         <field id="sfxbog"       long_name="salt flux from bot growth"                                    unit="1e-3*kg/m2/day" />
+         <field id="sfxbom"       long_name="salt flux from bot melt"                                      unit="1e-3*kg/m2/day" />
+         <field id="sfxsum"       long_name="salt flux from surf melt"                                     unit="1e-3*kg/m2/day" />
+         <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="1e-3*kg/m2/day" />
+         <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="1e-3*kg/m2/day" />
+         <field id="sfx"          long_name="salt flux total"                                              unit="1e-3*kg/m2/day" />
 
          <field id="vfxbog"       long_name="daily bottom thermo ice prod."                                unit="m/day"   />
@@ -298,25 +325,37 @@
          <field id="vfxspr"       long_name="snw precipitation on ice"                                     unit="m/day"   />
 
-         <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"  />
+         <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="degC" />
+         <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>
@@ -325,51 +364,69 @@
       
       <field_group id="grid_U"   grid_ref="grid_U_2D">
-         <field id="utau"         long_name="Wind Stress along i-axis"                    unit="N/m2" />
-         <field id="uoce"         long_name="ocean current along i-axis"                  unit="m/s"  grid_ref="grid_U_3D" />
-         <field id="ssu"          long_name="ocean surface current along i-axis"          unit="m/s"     />
-         <field id="uocetr_eff"   long_name="Effective ocean transport along i-axis"      unit="m3/s" grid_ref="grid_U_3D" />
-         <field id="uocet"        long_name="ocean transport along i-axis times temperature" unit="degC.m/s" grid_ref="grid_U_3D" />
-         <field id="uoces"        long_name="ocean transport along i-axis times salinity"    unit="psu.m/s"  grid_ref="grid_U_3D" />
+         <field id="e3u"          long_name="U-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_U_3D" />
+         <field id="utau"         long_name="Wind Stress along i-axis"                               standard_name="surface_downward_x_stress"   unit="N/m2"                            />
+         <field id="uoce"         long_name="ocean current along i-axis"                             standard_name="sea_water_x_velocity"        unit="m/s"        grid_ref="grid_U_3D" />
+         <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="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="degC*m/s"   grid_ref="grid_U_3D" />
+         <field id="uoces"        long_name="ocean transport along i-axis times salinity (CRS)"                                                  unit="1e-3*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"  />
+         <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"              unit="m/s"  grid_ref="grid_U_3D" />
+         <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" />
+
          <!-- uoce_eiv: available with key_trabbl -->
-         <field id="uoce_bbl"     long_name="BBL ocean current along i-axis"              unit="m/s"  grid_ref="grid_U_3D" />
-	     <field id="ahu_bbl"      long_name="BBL diffusive flux along i-axis"             unit="m3/s" />
+         <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"  axis_ref="none" />
+         <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 eulerian mass transport along i-axis"  unit="kg/s" grid_ref="grid_U_3D" />
-         <field id="u_heattr"     long_name="ocean eulerian heat transport along i-axis"  unit="W"    />
-         <field id="u_salttr"     long_name="ocean eulerian salt transport along i-axis"  unit="PSU*kg/s"    />
-         <field id="ueiv_heattr"  long_name="ocean bolus heat transport along i-axis"     unit="W"    />
-         <field id="udiff_heattr" long_name="ocean diffusion heat transport along i-axis" unit="W"    />
-     </field_group>
+         <field id="u_masstr"     long_name="ocean eulerian mass transport along i-axis"    standard_name="ocean_mass_x_transport"                          unit="kg/s"        grid_ref="grid_U_3D" />
+         <field id="u_heattr"     long_name="ocean eulerian heat transport along i-axis"    standard_name="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="1e-3*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="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="vtau"         long_name="Wind Stress along j-axis"                    unit="N/m2" />
-         <field id="voce"         long_name="ocean current along j-axis"                  unit="m/s"  grid_ref="grid_V_3D" />
-         <field id="ssv"          long_name="ocean surface current along j-axis"          unit="m/s"  />
-         <field id="vocetr_eff"   long_name="Effective ocean transport along j-axis"      unit="m3/s" grid_ref="grid_V_3D" />
-         <field id="vocet"        long_name="ocean transport along j-axis times temperature" unit="degC.m/s" grid_ref="grid_V_3D" />
-         <field id="voces"        long_name="ocean transport along j-axis times salinity"    unit="psu.m/s"  grid_ref="grid_V_3D" />
+         <field id="e3v"          long_name="V-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_V_3D" />
+         <field id="vtau"         long_name="Wind Stress along j-axis"                               standard_name="surface_downward_y_stress"   unit="N/m2"                            />
+         <field id="voce"         long_name="ocean current along j-axis"                             standard_name="sea_water_y_velocity"        unit="m/s"        grid_ref="grid_V_3D" />
+         <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="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="degC*m/s"   grid_ref="grid_V_3D" />
+         <field id="voces"        long_name="ocean transport along j-axis times salinity (CRS)"                                                  unit="1e-3*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"  />
+         <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"              unit="m/s"  grid_ref="grid_V_3D" />
+         <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" />
+
          <!-- voce_eiv: available with key_trabbl -->
-         <field id="voce_bbl"     long_name="BBL ocean current along j-axis"              unit="m/s"  grid_ref="grid_V_3D" />
-	     <field id="ahv_bbl"      long_name="BBL diffusive flux along j-axis"             unit="m3/s"                   />
+         <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"  axis_ref="none" />
+         <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 eulerian mass transport along j-axis"  unit="kg/s" grid_ref="grid_V_3D" />
-         <field id="v_heattr"     long_name="ocean eulerian heat transport along j-axis"  unit="W"     />
-         <field id="v_salttr"     long_name="ocean eulerian salt transport along i-axis"  unit="PSU*kg/s"    />
-         <field id="veiv_heattr"  long_name="ocean bolus heat transport along j-axis"     unit="W"     />
-         <field id="vdiff_heattr" long_name="ocean diffusion heat transport along j-axis" unit="W"     />
+         <field id="v_masstr"     long_name="ocean eulerian mass transport along j-axis"    standard_name="ocean_mass_y_transport"                          unit="kg/s"        grid_ref="grid_V_3D" />
+         <field id="v_heattr"     long_name="ocean eulerian heat transport along j-axis"    standard_name="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="1e-3*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="vdiff_heattr" long_name="ocean diffusion heat transport along j-axis"   standard_name="ocean_heat_y_transport_due_to_diffusion"         unit="W"                                />
       </field_group>
       
@@ -377,25 +434,32 @@
       
       <field_group id="grid_W" grid_ref="grid_W_3D">
-        <field id="woce"         long_name="ocean vertical velocity"                  unit="m/s"    />
-        <field id="wocetr_eff"   long_name="effective ocean vertical transport"       unit="m3/s"   />
+        <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"              unit="m/s"    />
+        <field id="woce_eiv"     long_name="EIV ocean vertical velocity"   standard_name="bolus_upward_sea_water_velocity"   unit="m/s" />
+
         <!-- woce_eiv: available with key_trabbl_adv -->
-        <field id="avt"          long_name="vertical eddy diffusivity"                unit="m2/s"   />
-        <field id="avm"          long_name="vertical eddy viscosity"                  unit="m2/s"   />
+        <field id="avt"          long_name="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"           unit="m2/s"   />
+        <field id="avs"          long_name="salt vertical eddy diffusivity"   standard_name="ocean_vertical_salt_diffusivity"   unit="m2/s" />
+
         <!-- avt_evd and avm_evd: available with ln_zdfevd -->
-        <field id="avt_evd"      long_name="enhanced vertical diffusivity"            unit="m2/s"   />
-        <field id="avm_evd"      long_name="enhanced vertical viscosity"              unit="m2/s"   />
+        <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"               unit="m2/s"   />
+        <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_diaar5 -->   
-        <field id="w_masstr"     long_name="vertical mass trasport"                   unit="kg/s"   />
-        <field id="w_masstr2"    long_name="square of vertical mass trasport"         unit="kg2/s2" />
-        
+        <field id="w_masstr"     long_name="vertical 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"                    unit="m2/s"   grid_ref="grid_W_2D" />
-        <field id="aht2d_eiv"    long_name="EIV lateral eddy diffusivity"                unit="m2/s"   grid_ref="grid_W_2D"/>
+        <field id="aht2d"        long_name="lateral eddy diffusivity"       standard_name="ocean_tracer_xy_laplacian_diffusivity"      unit="m2/s"   grid_ref="grid_W_2D" />
+        <field id="aht2d_eiv"    long_name="EIV lateral eddy diffusivity"   standard_name="ocean_tracer_bolus_laplacian_diffusivity"   unit="m2/s"   grid_ref="grid_W_2D" />
       </field_group>
           
@@ -403,283 +467,480 @@
 
       <field_group id="scalar"  domain_ref="1point" >
-         <field id="voltot"     long_name="global mean volume"                         unit="m3"   />
-         <field id="sshtot"     long_name="global mean ssh"                            unit="m"    />
-         <field id="sshsteric"  long_name="global mean ssh steric"                     unit="m"    />
-         <field id="sshthster"  long_name="global mean ssh thermosteric"               unit="m"    />
-         <field id="masstot"    long_name="global mean mass"                           unit="kg"   />
-         <field id="temptot"    long_name="global mean temperature"                    unit="degC" />
-         <field id="saltot"     long_name="global mean salinity"                       unit="psu"  />
-         <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" />
-
-   	 <!-- available with ln_diahsb -->
-		 <field id="bgtemper"     long_name="global mean temperature"                  unit="degC"   />
-		 <field id="bgsaline"     long_name="global mean salinity"                     unit="psu"    />
-		 <field id="bgheatco"     long_name="global mean heat content"                 unit="10^9J"  />
-		 <field id="bgsaltco"     long_name="global mean salt content"                 unit="psu*m3" />
-		 <field id="bgvolssh"     long_name="global mean ssh volume"                   unit="km3"     />
-	     <field id="bgvole3t"     long_name="global mean volume variation (e3t)"           unit="km3"/>
-		 <field id="bgvoltot"     long_name="global mean volume"                       unit="km3"     />
-		 <field id="bgsshtot"     long_name="global mean ssh"                          unit="m"      />
-		 <field id="bgfrcvol"     long_name="global mean volume from forcing"          unit="km3"     />
-		 <field id="bgfrctem"     long_name="global mean heat content from forcing"    unit="10^9J"  />
-		 <field id="bgfrcsal"     long_name="global mean salt content from forcing"    unit="psu*km3" />
-		 <field id="bgmistem"     long_name="global mean temperature error due to free surface" unit="degC" />
-		 <field id="bgmissal"     long_name="global mean salinity error due to free surface"    unit="psu"  />
-      </field_group>
+         <field id="voltot"     long_name="global total 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 mean ssh thermosteric"                 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 mean temperature"                      standard_name="sea_water_potential_temperature"                unit="degC" />
+         <field id="saltot"     long_name="global mean salinity"                         standard_name="sea_water_salinity"                             unit="1e-3" />
+         <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="degC"     />
+    	 <field id="bgsaline"     long_name="drift in global mean salinity wrt timestep 1"                    standard_name="change_over_time_in_sea_water_practical_salinity"      unit="1e-3"     />
+    	 <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="1e-3*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="1e-3*km3" />
+    	 <field id="bgmistem"     long_name="global mean temperature error due to free surface"                                                                                     unit="degC"     />
+    	 <field id="bgmissal"     long_name="global mean salinity error due to free surface"                                                                                        unit="1e-3"     />
+      </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="psu"   />
-	 <field id="ibgtemper"    long_name="global mean ice temperature"              unit="degC"   />
-	 <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="psu*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="psu*m/day"   />
-	 <field id="ibgsfxbri"    long_name="global mean salt flux (brines)"           unit="psu*m/day"   />
-	 <field id="ibgsfxdyn"    long_name="global mean salt flux (dynamic)"          unit="psu*m/day"   />
-	 <field id="ibgsfxres"    long_name="global mean salt flux (resultant)"        unit="psu*m/day"   />
-	 <field id="ibgsfxbog"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   />
-	 <field id="ibgsfxopw"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   />
-	 <field id="ibgsfxsni"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   />
-	 <field id="ibgsfxbom"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   />
-	 <field id="ibgsfxsum"    long_name="global mean salt flux (thermo)"           unit="psu*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="psu*km3"   />
-	 <field id="ibgvolgrm"    long_name="global mean ice growth+melt volume"       unit="km3"      />
+         <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="1e-3"       />
+         <field id="ibgtemper"    long_name="global mean ice temperature"                            unit="degC"       />
+         <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="1e-3*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="1e-3*m/day" />
+         <field id="ibgsfxbri"    long_name="global mean salt flux (brines)"                         unit="1e-3*m/day" />
+         <field id="ibgsfxdyn"    long_name="global mean salt flux (dynamic)"                        unit="1e-3*m/day" />
+         <field id="ibgsfxres"    long_name="global mean salt flux (resultant)"                      unit="1e-3*m/day" />
+         <field id="ibgsfxbog"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
+         <field id="ibgsfxopw"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
+         <field id="ibgsfxsni"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
+         <field id="ibgsfxbom"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
+         <field id="ibgsfxsum"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
+
+         <field id="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="1e-3*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="deg"   />
-        <field id="traj_lat"   long_name="floats latitude"    unit="deg"   />
-        <field id="traj_dep"   long_name="floats depth"       unit="m"     />
-        <field id="traj_temp"  long_name="floats temperature" unit="degC"  />
-        <field id="traj_salt"  long_name="floats salinity"    unit="psu"   />
-        <field id="traj_dens"  long_name="floats density"     unit="kg/m3" />
-        <field id="traj_group" long_name="floats group"       unit="none"  />
+        <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="degC"          />
+        <field id="traj_salt"     long_name="floats salinity"          standard_name="sea_water_practical_salinity"      unit="1e-3"          />
+        <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" domain_ref="grid_T"  > 
-        <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>
+        <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" domain_ref="ptr" > 
+        <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="degC"     grid_ref="gznl_T_3D" />
+        <field id="zotematl"          long_name="Zonal Mean Temperature : Atlantic"            unit="degC"     grid_ref="gznl_T_3D" />
+        <field id="zotempac"          long_name="Zonal Mean Temperature : Pacific"             unit="degC"     grid_ref="gznl_T_3D" />
+        <field id="zotemind"          long_name="Zonal Mean Temperature : Indian"              unit="degC"     grid_ref="gznl_T_3D" />
+        <field id="zotemipc"          long_name="Zonal Mean Temperature : Pacific+Indian"      unit="degC"     grid_ref="gznl_T_3D" />
+        <field id="zosalglo"          long_name="Zonal Mean Salinity : Global"                 unit="1e-3"     grid_ref="gznl_T_3D" />
+        <field id="zosalatl"          long_name="Zonal Mean Salinity : Atlantic"               unit="1e-3"     grid_ref="gznl_T_3D" />
+        <field id="zosalpac"          long_name="Zonal Mean Salinity : Pacific"                unit="1e-3"     grid_ref="gznl_T_3D" />
+        <field id="zosalind"          long_name="Zonal Mean Salinity : Indian"                 unit="1e-3"     grid_ref="gznl_T_3D" />
+        <field id="zosalipc"          long_name="Zonal Mean Salinity : Pacific+Indian"         unit="1e-3"     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="sophtldf"          long_name="Diffusive Heat Transport"                     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="sopstldf"          long_name="Diffusive Salt Transport"                     unit="Giga g/s" grid_ref="gznl_T_2D" />
+      </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_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"                        />
+
+      <!-- ln_traldf_iso=T only (iso-neutral diffusion) -->
+      <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="degC/s" />
+      <field id="strd_dmp"      long_name="salinity   -trend: interior restoring"        unit="1e-3/s" />
+      <field id="ttrd_bbl"      long_name="temperature-trend: bottom boundary layer"     unit="degC/s" />
+      <field id="strd_bbl"      long_name="salinity   -trend: bottom boundary layer"     unit="1e-3/s" />
+      <field id="ttrd_npc"      long_name="temperature-trend: non-penetrative conv."     unit="degC/s" />
+      <field id="strd_npc"      long_name="salinity   -trend: non-penetrative conv."     unit="1e-3/s" />
+      <field id="ttrd_qns"      long_name="temperature-trend: non-solar flux + runoff"   unit="degC/s" />
+      <field id="strd_cdt"      long_name="salinity   -trend: C/D term       + runoff"   unit="degC/s" />
+      <field id="ttrd_qsr"      long_name="temperature-trend: solar penetr. heating"     unit="degC/s" />
+      <field id="ttrd_bbc"      long_name="temperature-trend: geothermal heating"        unit="degC/s" />
+      <field id="ttrd_atf"      long_name="temperature-trend: asselin time filter"       unit="degC/s" />
+      <field id="strd_atf"      long_name="salinity   -trend: asselin time filter"       unit="1e-3/s" />
+
+      <!-- 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/s^3"                        />
+      <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"                        />   
+
+      <!-- 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="degC-1"                       />   
+      <field id="betaPE"        long_name="partial deriv. of PEanom wrt S"       unit="1e3"                          />   
+    </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>
+
+    <!-- 
+============================================================================================================
+                                     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="Alkalini" long_name="Total Alkalinity Concentration"           unit="mmol/m3" />
-       <field id="O2"       long_name="Oxygen Concentration"                     unit="mmol/m3" />
-       <field id="CaCO3"    long_name="Calcite Concentration"                    unit="mmol/m3" />
-       <field id="PO4"      long_name="Phosphate Concentration"                  unit="mmol/m3" />
-       <field id="POC"      long_name="Small organic carbon Concentration"       unit="mmol/m3" />
-       <field id="Si"       long_name="Silicate Concentration"                   unit="mmol/m3" />
-       <field id="PHY"      long_name="(Nano)Phytoplankton Concentration"        unit="mmol/m3" />
-       <field id="ZOO"      long_name="(Micro)Zooplankton Concentration"         unit="mmol/m3" />
-       <field id="DOC"      long_name="Dissolved organic Concentration"          unit="mmol/m3" />
-       <field id="PHY2"     long_name="Diatoms Concentration"                    unit="mmol/m3" />
-       <field id="ZOO2"     long_name="Mesozooplankton Concentration"            unit="mmol/m3" />
-       <field id="DSi"      long_name="Diatoms Silicate Concentration"           unit="mmol/m3" />
-       <field id="Fer"      long_name="Dissolved Iron Concentration"             unit="mmol/m3" />
-       <field id="BFe"      long_name="Big iron particles Concentration"         unit="mmol/m3" />
-       <field id="GOC"      long_name="Big organic carbon Concentration"         unit="mmol/m3" />
-       <field id="SFe"      long_name="Small iron particles Concentration"       unit="mmol/m3" />
-       <field id="DFe"      long_name="Diatoms iron  Concentration"              unit="mmol/m3" />
-       <field id="GSi"      long_name="Sinking biogenic Silicate Concentration"  unit="mmol/m3" />
-       <field id="NFe"      long_name="Nano iron Concentration"                  unit="mmol/m3" />
-       <field id="NCHL"     long_name="Nano chlorophyl Concentration"            unit="mg/m3"   />
-       <field id="DCHL"     long_name="Diatoms chlorophyl Concentration"         unit="mg/m3"   />
-       <field id="NO3"      long_name="Nitrate Concentration"                    unit="mmol/m3" />
-       <field id="NH4"      long_name="Ammonium Concentration"                   unit="mmol/m3" />
+     <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 >
 
        <!-- PISCES with Kriest parametisation : variables available with key_kriest -->
-       <field id="Num"      long_name="Number of organic particles"              unit="nbr" />
+       <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="DOM"      long_name="Dissolved Organic Matter"                 unit="mmol-N/m3" />
+       <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/L" />
+       <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="ration" />
+       <field id="C14B"     long_name="Bomb C14 Concentration"                      unit="1"         />
+       <field id="C14B_E3T"    long_name="C14B * E3T"                               unit="m"  > C14B * e3t </field >
      </field_group>
 
-      <!-- PISCES additional diagnostics on T grid  -->
+     <!-- PISCES additional diagnostics on T grid  -->
+
      <field_group id="diad_T" grid_ref="grid_T_2D">
-       <field id="PH"          long_name="PH"                                      unit="-"          grid_ref="grid_T_3D" />
+       <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="PPPHY"       long_name="Primary production of nanophyto"         unit="molC/m3/s"  grid_ref="grid_T_3D" />
-       <field id="PPPHY2"      long_name="Primary production of diatoms"           unit="molC/m3/s"  grid_ref="grid_T_3D" />
-       <field id="PPNEWN"      long_name="New Primary production of nanophyto"     unit="molC/m3/s"  grid_ref="grid_T_3D" />
-       <field id="PPNEWD"      long_name="New Primary production of diatoms"       unit="molC/m3/s"  grid_ref="grid_T_3D" />
-       <field id="PBSi"        long_name="Primary production of Si diatoms"        unit="molSi/m3/s" grid_ref="grid_T_3D" />
-       <field id="PFeN"        long_name="Primary production of nano iron"         unit="molFe/m3/s" grid_ref="grid_T_3D" />
-       <field id="PFeD"        long_name="Primary production of diatoms iron"      unit="molFe/m3/s" grid_ref="grid_T_3D" />
-       <field id="xfracal"     long_name="Calcifying fraction"                     unit="-"          grid_ref="grid_T_3D" />
-       <field id="PCAL"        long_name="Calcite production"                      unit="molC/m3/s"  grid_ref="grid_T_3D" />
-       <field id="DCAL"        long_name="Calcite dissolution"                     unit="molC/m3/s"  grid_ref="grid_T_3D" />
-       <field id="GRAZ1"       long_name="Grazing by microzooplankton"             unit="molC/m3/s"  grid_ref="grid_T_3D" />
-       <field id="GRAZ2"       long_name="Grazing by mesozooplankton"              unit="molC/m3/s"  grid_ref="grid_T_3D" />
-       <field id="REMIN"       long_name="Oxic remineralization of OM"             unit="molC/m3/s"  grid_ref="grid_T_3D" />
-       <field id="DENIT"       long_name="Anoxic remineralization of OM"           unit="molC/m3/s"  grid_ref="grid_T_3D" />
-       <field id="Nfix"        long_name="Nitrogen fixation"                       unit="molN/m3/s"  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/L"     grid_ref="grid_T_3D" />
-       <field id="Fe3"         long_name="Iron III concentration"                  unit="nmol/L"     grid_ref="grid_T_3D" />
-       <field id="FeL1"        long_name="Complexed Iron concentration with L1"    unit="nmol/L"     grid_ref="grid_T_3D" />
-       <field id="FeL2"        long_name="Complexed Iron concentration with L2"    unit="nmol/L"     grid_ref="grid_T_3D" />
-       <field id="FeP"         long_name="Precipitated Iron III"                   unit="nmol/L"     grid_ref="grid_T_3D" />
-       <field id="TL1"         long_name="Total L1 concentration"                  unit="nmol/L"     grid_ref="grid_T_3D" />
-       <field id="TL2"         long_name="Total L2 concentration"                  unit="nmol/L"     grid_ref="grid_T_3D" />
-       <field id="pdust"       long_name="dust concentration"                      unit="g/L"                          />
-       <field id="Totlig"      long_name="Total ligand concentation"               unit="nmol/L"     grid_ref="grid_T_3D" />
-       <field id="Biron"       long_name="Bioavailable iron"                       unit="nmol/L"     grid_ref="grid_T_3D" />
-       <field id="Sdenit"      long_name="Nitrate reduction in the sediments"      unit="molN/m2/s"                    />
-       <field id="Ironice"     long_name="Iron input/uptake due to sea ice"        unit="molFe/m2/s"                   />
-       <field id="HYDR"        long_name="Iron input from hydrothemal vents"       unit="molFe/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="molC/m2/s"  grid_ref="grid_T_3D" />
-       <field id="EXPFE"       long_name="Export of biogenic iron"                 unit="molFe/m2/s" grid_ref="grid_T_3D" />
-       <field id="EXPSI"       long_name="Export of Silicate"                      unit="molSi/m2/s" grid_ref="grid_T_3D" />
-       <field id="EXPCAL"      long_name="Export of Calcite"                       unit="molC/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"/>
+       <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="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="-"          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="molC/m3/s"  grid_ref="grid_T_3D" />
-       <field id="TPNEW"       long_name="New Primary production of phyto"                     unit="molC/m3/s"  grid_ref="grid_T_3D" />
-       <field id="TPBFE"       long_name="Total biogenic iron production"                      unit="molFe/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="molC/L" />
-       <field id="ZO2MIN"      long_name="Depth of oxygen minimum concentration"               unit="m"       />
-       <field id="INTNFIX"     long_name="Nitrogen fixation rate : vert. integrated"           unit="molN/m2/s"  />
-       <field id="INTPPPHY"    long_name="Vertically integrated primary production by nanophy" unit="molC/m2/s"  />
-       <field id="INTPPPHY2"   long_name="Vertically integrated primary production by diatom"  unit="molC/m2/s"  />
-       <field id="INTPP"       long_name="Vertically integrated primary production by phyto"   unit="molC/m2/s"  />
-       <field id="INTPNEW"     long_name="Vertically integrated new primary production"        unit="molC/m2/s"  />
-       <field id="INTPBFE"     long_name="Vertically integrated of biogenic iron production"   unit="molFe/m2/s" />
-       <field id="INTPBSI"     long_name="Vertically integrated of biogenic Si production"     unit="molSi/m2/s" />
-       <field id="INTPCAL"     long_name="Vertically integrated of calcite production"         unit="molC/m2/s" />
+       <!-- 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="-"  /> 
+       <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"     />
+       <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"  />
+       <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"  />
      </field_group>
 
-    <field_group id="PISCES_scalar"  domain_ref="1point" >
-       <field id="pno3tot"         long_name="global mean nitrate concentration"                  unit="mol/l"   />
-       <field id="psiltot"         long_name="global mean silicate concentration"                 unit="mol/l"   />
-       <field id="palktot"         long_name="global mean alkalinity concentration"               unit="mol/l"   />
-       <field id="pfertot"         long_name="global mean iron concentration"                     unit="mol/l"   />
-       <field id="tcflx"           long_name="total Flux of Carbon out of the ocean"              unit="molC/s" />
-       <field id="tcflxcum"        long_name="cumulative total Flux of Carbon out of the ocean"   unit="molC/s" />
-       <field id="tcexp"           long_name="total Carbon export at 100m"                        unit="molC/s" />
-       <field id="tintpp"          long_name="global total integrated primary production"         unit="molC/s" />
-       <field id="tnfix"           long_name="global total nitrogen fixation"                     unit="molN/s" />
-       <field id="tdenit"          long_name="Total denitrification"                              unit="molN/s" />
+     <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
 ============================================================================================================
     -->
@@ -702,22 +963,21 @@
       <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 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"               />
@@ -730,15 +990,15 @@
       <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 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>
     
@@ -759,121 +1019,4 @@
     </field_group>
     
-    <!-- 
-============================================================================================================
-                     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="psu/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="psu/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="psu/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="psu/s"  grid_ref="grid_T_2D" />
-      <field id="ttrd_ldf"      long_name="temperature-trend: lateral  diffusion"          unit="degC/s" />
-      <field id="strd_ldf"      long_name="salinity   -trend: lateral  diffusion"          unit="psu/s"  />
-      <field id="ttrd_zdf"      long_name="temperature-trend: vertical diffusion"          unit="degC/s" />
-      <field id="strd_zdf"      long_name="salinity   -trend: vertical diffusion"          unit="psu/s"  />
-      <!-- ln_traldf_iso=T only (iso-neutral diffusion) -->
-      <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="psu/s"  />
-      <!-- -->
-      <field id="ttrd_dmp"      long_name="temperature-trend: interior restoring"          unit="degC/s" />
-      <field id="strd_dmp"      long_name="salinity   -trend: interior restoring"          unit="psu/s"  />
-      <field id="ttrd_bbl"      long_name="temperature-trend: bottom boundary layer"       unit="degC/s" />
-      <field id="strd_bbl"      long_name="salinity   -trend: bottom boundary layer"       unit="psu/s"  />
-      <field id="ttrd_npc"      long_name="temperature-trend: non-penetrative conv."       unit="degC/s" />
-      <field id="strd_npc"      long_name="salinity   -trend: non-penetrative conv."       unit="psu/s"  />
-      <field id="ttrd_qns"      long_name="temperature-trend: non-solar flux + runoff"     unit="degC/s" />
-      <field id="strd_cdt"      long_name="salinity   -trend: C/D term       + runoff"     unit="degC/s" />
-      <field id="ttrd_qsr"      long_name="temperature-trend: solar penetr. heating"       unit="degC/s" />
-      <field id="ttrd_bbc"      long_name="temperature-trend: geothermal heating"          unit="degC/s" />
-      <field id="ttrd_atf"      long_name="temperature-trend: asselin time filter"         unit="degC/s" />
-      <field id="strd_atf"      long_name="salinity   -trend: asselin time filter"         unit="psu/s"  />
-      <!-- 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/s^3"  />
-      <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"  />   
-      <!-- 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="SI"     />   
-      <field id="alphaPE"       long_name="- partial deriv. of PEanom wrt T"               unit="/degC"  />   
-      <field id="betaPE"        long_name="partial deriv. of PEanom wrt S"                 unit="/psu"   />   
-    </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>
-
-    </field_definition>
+
+   </field_definition>
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref	(revision 5682)
@@ -14,5 +14,7 @@
 !-----------------------------------------------------------------------
    cn_icerst_in  = "restart_ice_in"   !  suffix of ice restart name (input)
+   cn_icerst_indir = "."              !  directory from which to read input ice restarts
    cn_icerst_out = "restart_ice"      !  suffix of ice restart name (output)
+   cn_icerst_outdir = "."             !  directory in which to write output ice restarts
    ln_limdyn     = .true.             !  ice dynamics (T) or thermodynamics only (F)
    ln_limdmp     = .false.            !  restoring ice thickness and fraction leads   (T => fill  namice_dmp)
@@ -48,11 +50,10 @@
    c_rhg       =  20.0     !  2nd bulk-rhelogy parameter
    etamn       =   0.0e+07 !  minimun value for viscosity
-   creepl      =   1.0e-08 !  creep limit
-   ecc         =   2.0     !  eccentricity of the elliptical yield curve
+   rn_creepl   =   1.0e-08 !  creep limit
+   rn_ecc      =   2.0     !  eccentricity of the elliptical yield curve
    ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s]
-   nevp        =   120     !  number of EVP subcycling iterations
+   nn_nevp     =   120     !  number of EVP subcycling iterations
    telast      =   9600    !  timescale for EVP elastic waves
    alphaevp    =   1.0     !  coefficient for the solution of EVP int. stresses
-   hminrhg     =   0.05     !  ice thickness (m) below which ice velocity equal ocean velocity
 /
 !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref	(revision 5682)
@@ -1,126 +1,136 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/LIM3 :  1 - dynamics/advection/thermo          (namicerun)
-!! namelists    2 - ice intialisation                  (namiceini)
-!!              3 - ice dynamic                        (namicedyn)
-!!              4 - ice advection                      (namicetrp)
-!!              5 - thermodynamic                      (namicethd)
-!!              6 - ice salinity                       (namicesal)
-!!              7 - mechanical redistribution of ice   (namiceitdme)
-!!              8 - ice diagnostics                    (namicedia)
-!!              9 - ice outputs                        (namiceout)
+!! LIM3 namelist :  
+!!              1 - Generic parameters                 (namicerun)
+!!              2 - Ice initialization                 (namiceini)
+!!              3 - Ice discretization                 (namiceitd)
+!!              4 - Ice dynamics and transport         (namicedyn)
+!!              5 - Ice thermodynamics                 (namicethd)
+!!              6 - Ice salinity                       (namicesal)
+!!              7 - Ice mechanical redistribution      (namiceitdme)
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-
-!-----------------------------------------------------------------------
-&namicerun     !   Share parameters for dynamics/advection/thermo
-!-----------------------------------------------------------------------
+!
+!------------------------------------------------------------------------------
+&namicerun     !   Generic parameters
+!------------------------------------------------------------------------------
+   jpl            =    5           !  number of ice  categories
+   nlay_i         =    2           !  number of ice  layers
+   nlay_s         =    1           !  number of snow layers (only 1 is working)
    cn_icerst_in  = "restart_ice"   !  suffix of ice restart name (input)
+   cn_icerst_indir = "."           !  directory from which to read input ice restarts
    cn_icerst_out = "restart_ice"   !  suffix of ice restart name (output)
+   cn_icerst_outdir = "."          !  directory in which to write output ice restarts
    ln_limdyn     = .true.          !  ice dynamics (T) or thermodynamics only (F)
-   amax          = 0.999           !  maximum ice concentration
-   cai           = 1.40e-3         !  atmospheric drag over sea ice (clio)
-   cao           = 1.00e-3         !  atmospheric drag over ocean   (clio)
-   ln_nicep      = .false.         !  Ice points output for debug (yes or no)
-   ln_limdiahsb  = .false.          !  check the heat and salt budgets (T) or not (F)
+   rn_amax       = 0.999           !  maximum tolerated ice concentration 
+   ln_limdiahsb  = .false.         !  check the heat and salt budgets (T) or not (F)
    ln_limdiaout  = .true.          !  output the heat and salt budgets (T) or not (F)
+   ln_icectl     = .false.         !  ice points output for debug (T or F)
+   iiceprt       = 10              !  i-index for debug
+   jiceprt       = 10              !  j-index for debug
 /
-!-----------------------------------------------------------------------
-&namiceini     !   ice initialisation
-!-----------------------------------------------------------------------
-   ln_limini   = .false.   !  activate ice initialization (T) or not (F)
-   thres_sst   =  0.0      !  threshold water temperature for initial sea ice
-   hts_ini_n   =  0.3      !  initial snow thickness in the north
-   hts_ini_s   =  0.3      !        "            "          south
-   hti_ini_n   =  1.0      !  initial ice thickness in the north
-   hti_ini_s   =  1.0      !        "            "         south
-   ati_ini_n   =  0.9      !  initial ice concentration in the north
-   ati_ini_s   =  0.9      !        "            "             south
-   smi_ini_n   =  6.301    !  initial ice salinity in the north
-   smi_ini_s   =  6.301    !        "            "    south
-   tmi_ini_n   =  270.     !  initial ice/snw temp in the north
-   tmi_ini_s   =  270.     !  initial ice/snw temp in the south
+!------------------------------------------------------------------------------
+&namiceini     !   Ice initialization
+!------------------------------------------------------------------------------
+   ln_iceini      = .true.         !  activate ice initialization (T) or not (F)
+   rn_thres_sst   =  2.0           !  maximum water temperature with initial ice (degC)
+   rn_hts_ini_n   =  0.3           !  initial real snow thickness (m), North
+   rn_hts_ini_s   =  0.3           !        "            "             South
+   rn_hti_ini_n   =  3.0           !  initial real ice thickness  (m), North
+   rn_hti_ini_s   =  1.0           !        "            "             South
+   rn_ati_ini_n   =  0.9           !  initial ice concentration   (-), North
+   rn_ati_ini_s   =  0.9           !        "            "             South
+   rn_smi_ini_n   =  6.3           !  initial ice salinity     (g/kg), North
+   rn_smi_ini_s   =  6.3           !        "            "             South
+   rn_tmi_ini_n   =  270.          !  initial ice/snw temperature (K), North
+   rn_tmi_ini_s   =  270.          !        "            "             South
 /
-!-----------------------------------------------------------------------
-&namicedyn     !   ice dynamic
-!-----------------------------------------------------------------------
-   epsd        =   1.0e-20 !  tolerance parameter
-   om          =   0.5     !  relaxation constant 
-   cw          =   5.0e-03 !  drag coefficient for oceanic stress
-   pstar       =   2.0e+04 !  1st bulk-rheology parameter
-   c_rhg       =  20.0     !  2nd bulk-rhelogy parameter
-   creepl      =   1.0e-12 !  creep limit
-   ecc         =   2.0     !  eccentricity of the elliptical yield curve
-   ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s]
-   nevp        = 120       !  number of iterations for subcycling in EVP
-   relast      = 0.333     !  ratio of elastic timescale over ice time step (1/3 if nevp=120 ; 1/9 if nevp=300)
-   alphaevp    =   1.0     !  coefficient for the solution of internal ice stresses
-   hminrhg     =   0.001   !  ice volume (a*h in m) below which ice velocity equal ocean velocity
+!------------------------------------------------------------------------------
+&namiceitd     !   Ice discretization
+!------------------------------------------------------------------------------
+   nn_catbnd      =    2           !  computation of ice category boundaries based on
+                                   !      1: tanh function
+                                   !      2: h^(-alpha), function of rn_himean
+   rn_himean      =    2.0         !  expected domain-average ice thickness (m), nn_catbnd = 2 only
 /
-!-----------------------------------------------------------------------
-&namicethd     !   ice thermodynamic
-!-----------------------------------------------------------------------
-   hmelt       = -0.15     !  maximum melting at the bottom
-   hiccrit     = 0.1       !  ice thickness for lateral accretion 
-                           !         caution 1.0, 1.0 best value to be used!!! (gilles G.)  ????
-   fraz_swi    = 0         !  use of frazil ice collection thickness in function of wind (1.0) or not (0.0)
-   maxfrazb    = 0.0       !  maximum portion of frazil ice collecting at the ice bottom
-   vfrazb      = 0.4166667 !  thresold drift speed for frazil ice collecting at the ice bottom
-   Cfrazb      = 5.0       !  squeezing coefficient for frazil ice collecting at the ice bottom
-   hiclim      = 0.10      !  minimum ice thickness
-   hnzst       = 0.1       !  thickness of the surf. layer in temp. computation
-   parsub      = 1.0       !  switch for snow sublimation or not
-   betas       = 0.6       !  exponent in lead-ice fractionation of snow precipitation 0.66
-                           !        betas = 1 -> equipartition, betas < 1 -> more on leads
-   kappa_i     = 1.0       !  extinction radiation parameter in sea ice (1.0)
-   nconv_i_thd = 50        !  maximal number of iterations for heat diffusion computation
-   maxer_i_thd = 0.0001    !  maximal error in temperature for heat diffusion computation
-   thcon_i_swi = 1         !  switch for computation of thermal conductivity in the ice
-                           !        (0) Untersteiner (1964), (1) Pringle et al. (2007)
+!------------------------------------------------------------------------------
+&namicedyn     !   Ice dynamics and transport
+!------------------------------------------------------------------------------
+   nn_icestr      =    0           !  ice strength parameteriztaion                      
+                                   !     0: Hibler_79     P = pstar*<h>*exp(-c_rhg*A)
+                                   !     1: Rothrock_75   P = Cf*coeff*integral(wr.h^2)    
+   ln_icestr_bvf  =    .false.     !  ice strength function brine volume (T) or not (F)     
+   rn_pe_rdg      =   17.0         !  ridging work divided by pot. energy change in ridging, if nn_icestr = 1
+   rn_pstar       =    2.0e+04     !  ice strength thickness parameter (N/m2), nn_icestr = 0 
+   rn_crhg        =   20.0         !  ice strength conc. parameter (-), nn_icestr = 0       
+   rn_cio         =    5.0e-03     !  ice-ocean drag coefficient           (-)             
+   rn_creepl      =    1.0e-12     !  creep limit (s-1)                                   
+   rn_ecc         =    2.0         !  eccentricity of the elliptical yield curve          
+   nn_nevp        =  120           !  number of EVP subcycles                             
+   rn_relast      =    0.333       !  ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast 
+                                   !     advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300)
+   nn_ahi0        =    2           !  horizontal diffusivity computation
+                                   !     0: use rn_ahi0_ref
+                                   !     1: use rn_ahi0_ref x mean grid cell length / ( 2deg mean grid cell length )
+                                   !     2: use rn_ahi0_ref x grid cell length      / ( 2deg mean grid cell length )
+   rn_ahi0_ref    = 350.0          !  horizontal sea ice diffusivity (m2/s) 
+                                   !     if nn_ahi0 > 0, rn_ahi0_ref is the reference value at a nominal 2 deg resolution
 /
-!-----------------------------------------------------------------------
-&namicesal     !   ice salinity
-!-----------------------------------------------------------------------
-   num_sal     =  2        !  salinity option: 1 -> S = bulk_sal
-                           !                   2 -> S = S(z,t) with a simple parameterization
-                           !                   3 -> S = S(z) profile of Scwharzacher [1959]
-                           !                   4 -> S = S(h) Cox and Weeks [1974]
-   bulk_sal    =  4.0      !  if 1 is used, it represents the ice salinity
-   sal_G       =  5.00     !  restoring salinity for GD
-   time_G      =  1.728e+6 !  restoring time for GD
-   sal_F       =  2.00     !  restoring salinity for flushing
-   time_F      =  8.640e+5 !  restoring time for flushing
-   s_i_max     = 20.0      !  Maximum salinity 
-   s_i_min     =  0.1      !  Minimum tolerated ice salinity
-   s_i_0       =  3.5      !  1st salinity for salinity profile
-   s_i_1       =  4.5      !  2nd salinity for salinity profile
+!------------------------------------------------------------------------------
+&namicehdf     !   Ice horizontal diffusion
+!------------------------------------------------------------------------------
+   nn_convfrq     = 5              !  convergence check frequency of the Crant-Nicholson scheme (perf. optimization)
 /
-!-----------------------------------------------------------------------
-&namiceitdme   !   parameters for mechanical redistribution of ice 
-!-----------------------------------------------------------------------
-   ridge_scheme_swi = 0      !  which ridging scheme using (1=Rothrock,else=Hibler79)
-   Cs               =   0.50 !  shearing energy contribution to ridging
-   Cf               =  17.0  !  ratio of ridging work to PE change in ridging
-   fsnowrdg         =   0.5  !  snow fraction that survives in ridging
-   fsnowrft         =   0.5  !  snow fraction that survives in rafting
-   Gstar            =   0.15 !  fractional area of thin ice being ridged
-   astar            =   0.05 !  equivalent of gstar (0.05 for TH75 and 0.03 for weaker ice)
-   Hstar            = 100.0  !  parameter determining the maximum thickness of ridged ice
-   raft_swi         =   1    !  rafting or not
-   hparmeter        =   0.75 !  threshold thickness for rafting or not
-   Craft            =   5.0  !  coefficient used in the rafting function
-   ridge_por        =   0.3  !  initial porosity of the ridged ice (typically 0.30)
-   partfun_swi      =   1    !  participation function linear, TH75 (0) or exponential Letal07 (1)
-   brinstren_swi    =   0    !  (1) use brine volume to diminish ice strength
+!------------------------------------------------------------------------------
+&namicethd     !   Ice thermodynamics
+!------------------------------------------------------------------------------
+   rn_hnewice  = 0.1               !  thickness for new ice formation in open water (m)
+   ln_frazil   = .false.           !  use frazil ice collection thickness as a function of wind (T) or not (F)
+   rn_maxfrazb = 0.0               !  maximum fraction of frazil ice collecting at the ice base
+   rn_vfrazb   = 0.417             !  thresold drift speed for frazil ice collecting at the ice bottom (m/s)
+   rn_Cfrazb   = 5.0               !  squeezing coefficient for frazil ice collecting at the ice bottom
+   rn_himin    = 0.10              !  minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice
+   rn_betas    = 0.66              !  exponent in lead-ice repratition of snow precipitation
+                                   !     betas = 1 -> equipartition, betas < 1 -> more on leads
+   rn_kappa_i  = 1.0               !  radiation attenuation coefficient in sea ice (m-1)
+   nn_conv_dif = 50                !  maximal number of iterations for heat diffusion computation
+   rn_terr_dif = 0.0001            !  maximum temperature after heat diffusion (degC)
+   nn_ice_thcon= 1                 !  sea ice thermal conductivity
+                                   !     0: k = k0 + beta.S/T (Untersteiner, 1964)
+                                   !     1: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007)
+   nn_monocat  = 0                 !  virtual ITD mono-category parameterizations (1, jpl = 1 only) or not (0)
+                                   !     2: simple piling instead of ridging --- temporary option
+                                   !     3: activate G(he) only              --- temporary option
+                                   !     4: activate lateral melting only    --- temporary option
+  ln_it_qnsice = .true.            !  iterate the surface non-solar flux with surface temperature (T) or not (F)
 /
-!-----------------------------------------------------------------------
-&namicedia     !   ice diagnostics
-!-----------------------------------------------------------------------
-   fmtinf      ='1PE13.5 ' !  format of the output values
-   nfrinf      = 4         !  number of variables written in one line
-   ntmoy       = 1         !  instantaneous values of ice evolution or averaging
-   ninfo       = 1         !  frequency of ouputs on file ice_evolu in case of averaging
+!------------------------------------------------------------------------------
+&namicesal     !   Ice salinity
+!------------------------------------------------------------------------------
+   nn_icesal   =  2                !  ice salinity option
+                                   !     1: constant ice salinity (S=rn_icesal)
+                                   !     2: varying salinity parameterization S(z,t)
+                                   !     3: prescribed salinity profile S(z), Schwarzacher, 1959
+   rn_icesal   =  4.               !  ice salinity (g/kg, nn_icesal = 1 only)
+   rn_sal_gd   =  5.               !  restoring ice salinity, gravity drainage (g/kg)
+   rn_time_gd  =  1.73e+6          !  restoring time scale, gravity drainage  (s)
+   rn_sal_fl   =  2.               !  restoring ice salinity, flushing (g/kg)
+   rn_time_fl  =  8.64e+5          !  restoring time scale, flushing (s)
+   rn_simax    = 20.               !  maximum tolerated ice salinity (g/kg)
+   rn_simin    =  0.1              !  minimum tolerated ice salinity (g/kg)
 /
-!!-----------------------------------------------------------------------
-!&namicehsb       !  Heat and salt budgets 
-!!-----------------------------------------------------------------------
-!/
-
+!------------------------------------------------------------------------------
+&namiceitdme   !   Ice mechanical redistribution (ridging and rafting)
+!------------------------------------------------------------------------------
+   rn_Cs       =   0.5             !  fraction of shearing energy contributing to ridging
+   rn_fsnowrdg =   0.5             !  snow volume fraction that survives in ridging
+   rn_fsnowrft =   0.5             !  snow volume fraction that survives in rafting
+   nn_partfun  =   1               !  type of ridging participation function
+                                   !     0: linear (Thorndike et al, 1975)
+                                   !     1: exponential (Lipscomb, 2007
+   rn_gstar    =   0.15            !  fractional area of thin ice being ridged (nn_partfun = 0)
+   rn_astar    =   0.05            !  exponential measure of ridging ice fraction (nn_partfun = 1)
+   rn_hstar    = 100.0             !  determines the maximum thickness of ridged ice (m) (Hibler, 1980)
+   ln_rafting  =   .true.          !  rafting activated (T) or not (F)
+   rn_hraft    =   0.75            !  threshold thickness for rafting (m)
+   rn_craft    =   5.0             !  squeezing coefficient used in the rafting function
+   rn_por_rdg  =   0.3             !  porosity of newly ridged ice (Lepparanta et al., 1995)
+/
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref	(revision 5682)
@@ -48,12 +48,12 @@
 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    concnno3   =  1.e-6    ! Nitrate half saturation of nanophytoplankton
-   concdno3   =  3.E-6    ! Phosphate half saturation for diatoms
+   concdno3   =  3.E-6    ! Nitrate half saturation for diatoms
    concnnh4   =  1.E-7    ! NH4 half saturation for phyto
    concdnh4   =  3.E-7    ! NH4 half saturation for diatoms
    concnfer   =  1.E-9    ! Iron half saturation for phyto
    concdfer   =  3.E-9    ! Iron half saturation for diatoms
-   concbfe    =  1.E-11   ! Half-saturation for Fe limitation of Bacteria
-   concbnh4   =  2.E-8    ! NH4 half saturation for phyto
-   concbno3   =  2.E-7    ! Phosphate half saturation for diatoms
+   concbfe    =  1.E-11   ! Iron half-saturation for DOC remin.
+   concbnh4   =  2.E-8    ! NH4 half saturation for DOC remin.
+   concbno3   =  2.E-7    ! Nitrate half saturation for DOC remin.
    xsizedia   =  1.E-6    ! Minimum size criteria for diatoms
    xsizephy   =  1.E-6    ! Minimum size criteria for phyto
@@ -61,5 +61,5 @@
    xsizerd    =  3.0      ! Size ratio for diatoms
    xksi1      =  2.E-6    ! half saturation constant for Si uptake
-   xksi2      =  20E-6  ! half saturation constant for Si/C
+   xksi2      =  20E-6    ! half saturation constant for Si/C
    xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization
    qnfelim    =  7.E-6    ! Optimal quota of phyto
@@ -86,10 +86,10 @@
    excret2    =  0.05     ! excretion ratio of diatoms
    ln_newprod =  .true.   ! Enable new parame. of production (T/F) 
-   bresp      =  0.00333  ! Basal respiration rate
-   chlcnm     =  0.033    ! Minimum Chl/C in nanophytoplankton
-   chlcdm     =  0.05     ! Minimum Chl/C in diatoms
-   chlcmin    =  0.004    ! Maximum Chl/c in phytoplankton
+   bresp      =  0.033    ! Basal respiration rate
+   chlcnm     =  0.033    ! Maximum Chl/C in nanophytoplankton
+   chlcdm     =  0.05     ! Maximum Chl/C in diatoms
+   chlcmin    =  0.004    ! Minimum Chl/c in phytoplankton
    fecnm      =  40E-6    ! Maximum Fe/C in nanophytoplankton
-   fecdm      =  40E-6    ! Minimum Fe/C in diatoms
+   fecdm      =  40E-6    ! Maximum Fe/C in diatoms
    grosip     =  0.159    ! mean Si/C ratio
 /
@@ -110,8 +110,8 @@
    resrat2    =  0.005    ! exsudation rate of mesozooplankton
    mzrat2     =  0.03     ! mesozooplankton mortality rate
-   xprefc     =  1.       ! zoo preference for phyto
-   xprefp     =  0.3      ! zoo preference for POC
-   xprefz     =  1.       ! zoo preference for zoo
-   xprefpoc   =  0.3      ! zoo preference for poc
+   xprefc     =  1.       ! mesozoo preference for diatoms
+   xprefp     =  0.3      ! mesozoo preference for nanophyto.
+   xprefz     =  1.       ! mesozoo preference for microzoo.
+   xprefpoc   =  0.3      ! mesozoo preference for poc
    xthresh2zoo = 1E-8     ! zoo feeding threshold for mesozooplankton 
    xthresh2dia = 1E-8     ! diatoms feeding threshold for mesozooplankton 
@@ -119,5 +119,5 @@
    xthresh2poc = 1E-8     ! poc feeding threshold for mesozooplankton 
    xthresh2   =  3E-7     ! Food threshold for grazing
-   xkgraz2    =  20.E-6   ! half sturation constant for meso grazing
+   xkgraz2    =  20.E-6   ! half saturation constant for meso grazing
    epsher2    =  0.35     ! Efficicency of Mesozoo growth
    sigma2     =  0.6      ! Fraction of mesozoo excretion as DOM
@@ -156,5 +156,5 @@
 &nampisrem     !   parameters for remineralization
 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
-   xremik    =  0.35      ! remineralization rate of DOC
+   xremik    =  0.3       ! remineralization rate of DOC
    xremip    =  0.025     ! remineralisation rate of POC
    nitrif    =  0.05      ! NH4 nitrification rate
@@ -207,4 +207,45 @@
 /
 !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisice      !  Prescribed sea ice tracers
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+! constant ocean tracer concentrations are defined in trcice_pisces.F90 (Global, Arctic, Antarctic and Baltic)
+! trc_ice_ratio     * betw 0 and 1: prescribed ice/ocean tracer concentration ratio
+!                   * -1 => the ice-ocean tracer concentration ratio follows the 
+!                           ice-ocean salinity ratio
+!                   * -2 => tracer concentration in sea ice is prescribed and 
+!                           trc_ice_prescr is used
+! trc_ice_prescr    * prescribed tracer concentration. used only if 
+!                     trc_ice_ratio = -2. equals -99 if not used.
+! cn_trc_o          * 'GL' use global ocean values making the Baltic distinction only
+!                     'AA' use specific Arctic/Antarctic/Baltic values
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!    sn_tri_ ! trc_ice_ratio ! trc_ice_prescr !     cn_trc_o
+   sn_tri_dic =           -1.,           -99.,          'AA'
+   sn_tri_doc =            0.,           -99.,          'AA'
+   sn_tri_tal =           -1.,           -99.,          'AA'
+   sn_tri_oxy =           -1.,           -99.,          'AA'
+   sn_tri_cal =            0.,           -99.,          'AA'
+   sn_tri_po4 =           -1.,           -99.,          'AA'
+   sn_tri_poc =            0.,           -99.,          'AA'
+   sn_tri_goc =            0.,           -99.,          'AA'
+   sn_tri_bfe =            0.,           -99.,          'AA'
+   sn_tri_num =            0.,           -99.,          'AA'
+   sn_tri_sil =           -1.,           -99.,          'AA'
+   sn_tri_dsi =            0.,           -99.,          'AA'
+   sn_tri_gsi =            0.,           -99.,          'AA'
+   sn_tri_phy =            0.,           -99.,          'AA'
+   sn_tri_dia =            0.,           -99.,          'AA'
+   sn_tri_zoo =            0.,           -99.,          'AA'
+   sn_tri_mes =            0.,           -99.,          'AA'
+   sn_tri_fer =           -2.,          15E-9,          'AA'
+   sn_tri_sfe =            0.,           -99.,          'AA'
+   sn_tri_dfe =            0.,           -99.,          'AA'
+   sn_tri_nfe =            0.,           -99.,          'AA'
+   sn_tri_nch =            0.,           -99.,          'AA'
+   sn_tri_dch =            0.,           -99.,          'AA'
+   sn_tri_no3 =           -1.,           -99.,          'AA'
+   sn_tri_nh4 =            1.,           -99.,          'AA'
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 &nampiskrp     !   Kriest parameterization : parameters     "key_kriest"
 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_ref
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_ref	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_ref	(revision 5682)
@@ -10,5 +10,5 @@
 !!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
 !!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
-!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namhsb, namsto)
 !!             10 - miscellaneous    (namsol, nammpp, namctl)
 !!             11 - Obs & Assim      (namobs, nam_asminc)
@@ -37,11 +37,16 @@
                            !    = 2 nn_date0 read in restart  ; nn_it000 : check consistancy between namelist and restart
    cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
+   cn_ocerst_indir = "."       !  directory from which to read input ocean restarts
    cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
+   cn_ocerst_outdir = "."      !  directory in which to write output ocean restarts
    nn_istate   =       0   !  output the initial state (1) or not (0)
+   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F)
    nn_stock    =    5475   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_stocklist = 0,0,0,0,0,0,0,0,0,0 ! List of timesteps when a restart file is to be written
    nn_write    =    5475   !  frequency of write in the output file   (modulo referenced to nn_it000)
    ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T)
    ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
-   ln_clobber  = .false.   !  clobber (overwrite) an existing file
+   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard
+   ln_clobber  = .true.   !  clobber (overwrite) an existing file
    nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
 /
@@ -50,5 +55,5 @@
 !!                      ***  Domain namelists  ***
 !!======================================================================
-!!   namcfg       parameters of the configuration      
+!!   namcfg       parameters of the configuration
 !!   namzgr       vertical coordinate
 !!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
@@ -58,5 +63,5 @@
 !
 !-----------------------------------------------------------------------
-&namcfg     !   parameters of the configuration      
+&namcfg     !   parameters of the configuration
 !-----------------------------------------------------------------------
    cp_cfg      =  "default"            !  name of the configuration
@@ -72,8 +77,10 @@
    jperio      =       0               !  lateral cond. type (between 0 and 6)
                                        !  = 0 closed                 ;   = 1 cyclic East-West
-                                       !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot 
+                                       !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
                                        !  = 4 cyclic East-West AND North fold T-point pivot
                                        !  = 5 North fold F-point pivot
                                        !  = 6 cyclic East-West AND North fold F-point pivot
+   ln_use_jattr = .false.              !  use (T) the file attribute: open_ocean_jstart, if present
+                                       !  in netcdf input files, as the start j-row for reading
 /
 !-----------------------------------------------------------------------
@@ -83,5 +90,5 @@
    ln_zps      = .true.    !  z-coordinate - partial steps   (T/F)
    ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F)
-   ln_isfcav   = .false.   !  ice shelf cavity
+   ln_isfcav   = .false.   !  ice shelf cavity               (T/F)
 /
 !-----------------------------------------------------------------------
@@ -99,5 +106,5 @@
                         !!!!!!!  SH94 stretching coefficients  (ln_s_sh94 = .true.)
    rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
-   rn_bb       =    0.8    !  stretching with SH94 s-sigma   
+   rn_bb       =    0.8    !  stretching with SH94 s-sigma
                         !!!!!!!  SF12 stretching coefficient  (ln_s_sf12 = .true.)
    rn_alpha    =    4.4    !  stretching with SF12 s-sigma
@@ -108,5 +115,5 @@
    rn_zb_b     =   -0.2    !  offset for calculating Zb
                         !!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above]
-   rn_thetb    =    1.0    !  bottom control parameter  (0<=thetb<= 1) 
+   rn_thetb    =    1.0    !  bottom control parameter  (0<=thetb<= 1)
 /
 !-----------------------------------------------------------------------
@@ -116,5 +123,5 @@
    rn_bathy    =    0.     !  value of the bathymetry. if (=0) bottom flat at jpkm1
    nn_closea   =    0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
-   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   nn_msh      =    1      !  create (=1) a mesh file or not (=0)
    rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
    rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
@@ -162,9 +169,9 @@
    nn_baro       =    30               !  Number of iterations of barotropic mode
                                        !  during rn_rdt seconds. Only used if ln_bt_nn_auto=F
-   rn_bt_cmax    =    0.8              !  Maximum courant number allowed if ln_bt_nn_auto=T 
+   rn_bt_cmax    =    0.8              !  Maximum courant number allowed if ln_bt_nn_auto=T
    nn_bt_flt     =    1                !  Time filter choice
                                        !  = 0 None
                                        !  = 1 Boxcar over   nn_baro barotropic steps
-                                       !  = 2 Boxcar over 2*nn_baro     "        "  
+                                       !  = 2 Boxcar over 2*nn_baro     "        "
 /
 !-----------------------------------------------------------------------
@@ -213,5 +220,5 @@
 !!   namsbc_core     CORE bulk formulae formulation
 !!   namsbc_mfs      MFS  bulk formulae formulation
-!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namsbc_cpl      CouPLed            formulation                     ("key_oasis3")
 !!   namsbc_sas      StAndalone Surface module
 !!   namtra_qsr      penetrative solar radiation
@@ -233,4 +240,10 @@
    ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core)
    ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs )
+   ln_cpl      = .false.   !  atmosphere coupled   formulation          ( requires key_oasis3 )
+   ln_mixcpl   = .false.   !  forced-coupled mixed formulation          ( requires key_oasis3 )
+   nn_components = 0       !  configuration of the opa-sas OASIS coupling
+                           !  =0 no opa-sas OASIS coupling: default single executable configuration
+                           !  =1 opa-sas OASIS coupling: multi executable configuration, OPA component
+                           !  =2 opa-sas OASIS coupling: multi executable configuration, SAS component 
    ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
    nn_ice      = 2         !  =0 no ice boundary condition   ,
@@ -243,6 +256,6 @@
    ln_rnf      = .true.    !  runoffs                                   (T   => fill namsbc_rnf)
    nn_isf      = 0         !  ice shelf melting/freezing                (/=0 => fill namsbc_isf)
-                           !  0 =no isf                  1 = presence of ISF 
-                           !  2 = bg03 parametrisation   3 = rnf file for isf   
+                           !  0 =no isf                  1 = presence of ISF
+                           !  2 = bg03 parametrisation   3 = rnf file for isf
                            !  4 = ISF fwf specified
                            !  option 1 and 4 need ln_isfcav = .true. (domzgr)
@@ -275,5 +288,5 @@
 &namsbc_flx    !   surface boundary condition : flux formulation
 !-----------------------------------------------------------------------
-!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
 !              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
    sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''       , ''
@@ -318,8 +331,8 @@
    ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
    rn_zqt      = 10.        !  Air temperature and humidity reference height (m)
-   rn_zu       = 10.        !  Wind vector reference height (m)                 
+   rn_zu       = 10.        !  Wind vector reference height (m)
    rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
    rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.)
-   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity 
+   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity
                            !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
 /
@@ -340,5 +353,5 @@
 /
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
 !-----------------------------------------------------------------------
 !                    !     description       !  multiple  !    vector   !      vector          ! vector !
@@ -371,11 +384,14 @@
 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
 !              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
-   sn_usp      = 'sas_grid_U' ,    120           , 'vozocrtx' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''      
+   sn_usp      = 'sas_grid_U' ,    120           , 'vozocrtx' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
    sn_vsp      = 'sas_grid_V' ,    120           , 'vomecrty' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
    sn_tem      = 'sas_grid_T' ,    120           , 'sosstsst' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
    sn_sal      = 'sas_grid_T' ,    120           , 'sosaline' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
    sn_ssh      = 'sas_grid_T' ,    120           , 'sossheig' ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
-
-   ln_3d_uv    = .true.    !  specify whether we are supplying a 3D u,v field
+   sn_e3t      = 'sas_grid_T' ,    120           , 'e3t_m'    ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
+   sn_frq      = 'sas_grid_T' ,    120           , 'frq_m'    ,  .true.    , .true. ,   'yearly'  , ''       , ''             , ''
+
+   ln_3d_uve   = .true.    !  specify whether we are supplying a 3D u,v and e3 field
+   ln_read_frq = .false.    !  specify whether we must read frq or not
    cn_dir      = './'      !  root directory for the location of the bulk files are
 /
@@ -410,5 +426,4 @@
 
    cn_dir       = './'      !  root directory for the location of the runoff files
-   ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F)
    ln_rnf_mouth = .true.    !  specific treatment at rivers mouths
    rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
@@ -418,7 +433,11 @@
    ln_rnf_tem   = .false.   !  read in temperature information for runoff
    ln_rnf_sal   = .false.   !  read in salinity information for runoff
-/
-!-----------------------------------------------------------------------
-&namsbc_isf    !  Top boundary layer (ISF) 
+   ln_rnf_depth_ini = .false.  ! compute depth at initialisation from runoff file
+   rn_rnf_max   = 5.735e-4  !  max value of the runoff climatologie over global domain ( ln_rnf_depth_ini = .true )
+   rn_dep_max   = 150.      !  depth over which runoffs is spread ( ln_rnf_depth_ini = .true )
+   nn_rnf_depth_file = 0    !  create (=1) a runoff depth file or not (=0)
+/
+!-----------------------------------------------------------------------
+&namsbc_isf    !  Top boundary layer (ISF)
 !-----------------------------------------------------------------------
 !              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
@@ -457,5 +476,5 @@
 
    cn_dir      = './'       !  root directory for the location of the bulk files
-   rn_pref     = 101000._wp !  reference atmospheric pressure   [N/m2]/
+   rn_pref     = 101000.    !  reference atmospheric pressure   [N/m2]/
    ln_ref_apr  = .false.    !  ref. pressure: global mean Patm (T) or a constant (F)
    ln_apr_obc  = .false.    !  inverse barometer added to OBC ssh data
@@ -497,8 +516,8 @@
                                                       ! Initial mass required for an iceberg of each class
       rn_initial_mass          = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11
-                                                      ! Proportion of calving mass to apportion to each class  
+                                                      ! Proportion of calving mass to apportion to each class
       rn_distribution          = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02
                                                       ! Ratio between effective and real iceberg mass (non-dim)
-                                                      ! i.e. number of icebergs represented at a point         
+                                                      ! i.e. number of icebergs represented at a point
       rn_mass_scaling          = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1
                                                       ! thickness of newly calved bergs (m)
@@ -509,15 +528,15 @@
       rn_bits_erosion_fraction = 0.                   ! Fraction of erosion melt flux to divert to bergy bits
       rn_sicn_shift            = 0.                   ! Shift of sea-ice concn in erosion flux (0<sicn_shift<1)
-      ln_passive_mode          = .false.              ! iceberg - ocean decoupling   
+      ln_passive_mode          = .false.              ! iceberg - ocean decoupling
       nn_test_icebergs         =  10                  ! Create test icebergs of this class (-1 = no)
                                                       ! Put a test iceberg at each gridpoint in box (lon1,lon2,lat1,lat2)
       rn_test_box              = 108.0,  116.0, -66.0, -58.0
-      rn_speed_limit           = 0.                   ! CFL speed limit for a berg   
+      rn_speed_limit           = 0.                   ! CFL speed limit for a berg
 
 !              ! file name ! frequency (hours) !   variable   ! time interp.   !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
 !              !           !  (if <0  months)  !     name     !   (logical)    !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
       sn_icb =  'calving' ,       -1           , 'calvingmask',  .true.        , .true.  , 'yearly'  , ''       , ''       , ''
-   
-      cn_dir = './' 
+
+      cn_dir = './'
 /
 
@@ -573,4 +592,5 @@
    rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
    rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+   ln_chk_bathy  = .FALSE. !
 /
 !-----------------------------------------------------------------------
@@ -580,15 +600,5 @@
    ln_tide_ramp  = .false.  !
    rdttideramp   =    0.    !
-   clname(1)     =   'M2'   !  name of constituent
-   clname(2)     =   'S2'
-   clname(3)     =   'N2'
-   clname(4)     =   'K1'
-   clname(5)     =   'O1'
-   clname(6)     =   'Q1'
-   clname(7)     =   'M4'
-   clname(8)     =   'K2'
-   clname(9)     =   'P1'
-   clname(10)    =   'Mf'
-   clname(11)    =   'Mm'
+   clname(1)     = 'DUMMY'  !  name of constituent - all tidal components must be set in namelist_cfg
 /
 !-----------------------------------------------------------------------
@@ -605,11 +615,11 @@
                                           !  = 2, use tidal harmonic forcing data from files
                                           !  = 3, use external data AND tidal harmonic forcing
-    cn_dyn3d      =  'none'               !  
+    cn_dyn3d      =  'none'               !
     nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
                                           !  = 1, bdy data are read in 'bdydata   .nc' files
-    cn_tra        =  'none'               ! 
+    cn_tra        =  'none'               !
     nn_tra_dta    =  0                    !  = 0, bdy data are equal to the initial state
                                           !  = 1, bdy data are read in 'bdydata   .nc' files
-    cn_ice_lim      =  'none'             !  
+    cn_ice_lim      =  'none'             !
     nn_ice_lim_dta  =  0                  !  = 0, bdy data are equal to the initial state
                                           !  = 1, bdy data are read in 'bdydata   .nc' files
@@ -620,5 +630,5 @@
     ln_tra_dmp    =.false.                !  open boudaries conditions for tracers
     ln_dyn3d_dmp  =.false.                !  open boundary condition for baroclinic velocities
-    rn_time_dmp   =  1.                   ! Damping time scale in days 
+    rn_time_dmp   =  1.                   ! Damping time scale in days
     rn_time_dmp_out =  1.                 ! Outflow damping time scale
     nn_rimwidth   = 10                    !  width of the relaxation zone
@@ -673,5 +683,5 @@
    rn_bfri2_max =   1.e-1  !  max. bottom drag coefficient (non linear case and ln_loglayer=T)
    rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
-   rn_bfrz0    =    3.e-3  !  bottom roughness [m] if ln_loglayer=T 
+   rn_bfrz0    =    3.e-3  !  bottom roughness [m] if ln_loglayer=T
    ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file )
    rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T)
@@ -690,4 +700,10 @@
 &nambbc        !   bottom temperature boundary condition
 !-----------------------------------------------------------------------
+!              !                              !  (if <0  months)  !  
+!              !  file name      ! frequency (hours) ! variable   ! time interp.   !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                 !  (if <0  months)  !   name     !   (logical)    !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_qgh      ='geothermal_heating.nc',  -12.  , 'heatflow'      ,   .false.      , .true.  , 'yearly'  , ''       , ''       , ''
+   !
+   cn_dir      = './'      !  root directory for the location of the runoff files
    ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
    nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux
@@ -695,4 +711,5 @@
                            !     = 2 variable flux (read in geothermal_heating.nc in mW/m2)
    rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
+
 /
 !-----------------------------------------------------------------------
@@ -719,6 +736,6 @@
 !-----------------------------------------------------------------------
    nn_eos      =  -1     !  type of equation of state and Brunt-Vaisala frequency
-                                 !  =-1, TEOS-10 
-                                 !  = 0, EOS-80 
+                                 !  =-1, TEOS-10
+                                 !  = 0, EOS-80
                                  !  = 1, S-EOS   (simplified eos)
    ln_useCT    = .true.  ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm
@@ -791,14 +808,8 @@
 !-----------------------------------------------------------------------
    ln_tradmp   =  .true.   !  add a damping termn (T) or not (F)
-   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
-                           !                   =XX, damping poleward of XX degrees (XX>0)
-                           !                      + F(distance-to-coast) + Red and Med Seas
    nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
                            !                   =1 no damping in the mixing layer (kz  criteria)
                            !                   =2 no damping in the mixed  layer (rho crieria)
-   rn_surf     =   50.     !  surface time scale of damping   [days]
-   rn_bot      =  360.     !  bottom  time scale of damping   [days]
-   rn_dep      =  800.     !  depth of transition between rn_surf and rn_bot [meters]
-   nn_file     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+   cn_resto    = 'resto.nc' ! Name of file containing restoration coefficient field (use dmp_tools to create this)
 /
 
@@ -817,4 +828,5 @@
 !-----------------------------------------------------------------------
    ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
    ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
    ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
@@ -824,5 +836,5 @@
 &nam_vvl    !   vertical coordinate options
 !-----------------------------------------------------------------------
-   ln_vvl_zstar  = .true.           !  zstar vertical coordinate                   
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
    ln_vvl_ztilde = .false.          !  ztilde vertical coordinate: only high frequency variations
    ln_vvl_layer  = .false.          !  full layer vertical coordinate
@@ -850,4 +862,5 @@
    ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation)
    ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
+   ln_hpg_isf  = .false.   !  s-coordinate (sco ) adapted to isf
    ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
    ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
@@ -945,5 +958,5 @@
                            !        = 1 add a tke source below the ML
                            !        = 2 add a tke source just at the base of the ML
-                           !        = 3 as = 1 applied on HF part of the stress    ("key_coupled")
+                           !        = 3 as = 1 applied on HF part of the stress    ("key_oasis3")
    rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
    nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
@@ -967,18 +980,18 @@
 &namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
 !-----------------------------------------------------------------------
-   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_emin       = 1.e-7   !  minimum value of e   [m2/s2]
    rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
    ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
-   rn_clim_galp  = 0.53    !  galperin limit
-   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   rn_clim_galp  = 0.267   !  galperin limit
    ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
    rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
    rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
-   nn_tkebc_surf =   1     !  surface tke condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
-   nn_tkebc_bot  =   1     !  bottom tke condition (0/1=Dir/Neum)
-   nn_psibc_surf =   1     !  surface psi condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
-   nn_psibc_bot  =   1     !  bottom psi condition (0/1=Dir/Neum)
-   nn_stab_func  =   2     !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
-   nn_clos       =   1     !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+   rn_hsro       =  0.02   !  Minimum surface roughness
+   rn_frac_hs    =   1.3   !  Fraction of wave height as roughness (if nn_z0_met=2)
+   nn_z0_met     =     2   !  Method for surface roughness computation (0/1/2)
+   nn_bc_surf    =     1   !  surface condition (0/1=Dir/Neum)
+   nn_bc_bot     =     1   !  bottom condition (0/1=Dir/Neum)
+   nn_stab_func  =     2   !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =     1   !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
 /
 !-----------------------------------------------------------------------
@@ -1008,4 +1021,5 @@
 !!   namc1d_uvd        data: U & V currents                             ("key_c1d")
 !!   namc1d_dyndmp     U & V newtonian damping                          ("key_c1d")
+!!   namsto            Stochastic parametrization of EOS
 !!======================================================================
 !
@@ -1066,4 +1080,21 @@
    ln_dyndmp   =  .false.  !  add a damping term (T) or not (F)
 /
+!-----------------------------------------------------------------------
+&namsto       ! Stochastic parametrization of EOS
+!-----------------------------------------------------------------------
+   ln_rststo = .false.           ! start from mean parameter (F) or from restart file (T)
+   ln_rstseed = .true.           ! read seed of RNG from restart file
+   cn_storst_in  = "restart_sto" !  suffix of stochastic parameter restart file (input)
+   cn_storst_out = "restart_sto" !  suffix of stochastic parameter restart file (output)
+
+   ln_sto_eos = .false.          ! stochastic equation of state
+   nn_sto_eos = 1                ! number of independent random walks
+   rn_eos_stdxy = 1.4            ! random walk horz. standard deviation (in grid points)
+   rn_eos_stdz  = 0.7            ! random walk vert. standard deviation (in grid points)
+   rn_eos_tcor  = 1440.0         ! random walk time correlation (in timesteps)
+   nn_eos_ord  = 1               ! order of autoregressive processes
+   nn_eos_flt  = 0               ! passes of Laplacian filter
+   rn_eos_lim  = 2.0             ! limitation factor (default = 3.0)
+/
 
 !!======================================================================
@@ -1072,6 +1103,6 @@
 !!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
 !!   namtrd       dynamics and/or tracer trends
+!!   namptr       Poleward Transport Diagnostics
 !!   namflo       float parameters                                      ("key_float")
-!!   namptr       Poleward Transport Diagnostics
 !!   namhsb       Heat and salt budgets
 !!======================================================================
@@ -1127,10 +1158,5 @@
 !-----------------------------------------------------------------------
    ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
-   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions
-   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not
-                           !  (orca configuration only, need input basins mask file named "subbasins.nc"
-   ln_ptrcomp = .true.     !  Add decomposition : overturning
-   nn_fptr    =  1         !  Frequency of ptr computation [time step]
-   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+   ln_subbas  = .false.     !  Atlantic/Pacific/Indian basins computation (T) or not
 /
 !-----------------------------------------------------------------------
@@ -1161,71 +1187,42 @@
 !!            ***  Observation & Assimilation namelists ***
 !!======================================================================
-!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   namobs       observation and model comparison
 !!   nam_asminc   assimilation increments                               ('key_asminc')
 !!======================================================================
 !
 !-----------------------------------------------------------------------
-&namobs       !  observation usage switch                               ('key_diaobs')
-!-----------------------------------------------------------------------
-   ln_t3d     = .false.    ! Logical switch for T profile observations
-   ln_s3d     = .false.    ! Logical switch for S profile observations
-   ln_ena     = .false.    ! Logical switch for ENACT insitu data set
-   !                       !     ln_cor                  Logical switch for Coriolis insitu data set
-   ln_profb   = .false.    ! Logical switch for feedback insitu data set
-   ln_sla     = .false.    ! Logical switch for SLA observations
-
-   ln_sladt   = .false.    ! Logical switch for AVISO SLA data
-
-   ln_slafb   = .false.    ! Logical switch for feedback SLA data
-                           !     ln_ssh                  Logical switch for SSH observations
-
-   ln_sst     = .false.     ! Logical switch for SST observations
-   ln_reysst  = .false.     !     ln_reysst               Logical switch for Reynolds observations
-   ln_ghrsst  = .false.    !     ln_ghrsst               Logical switch for GHRSST observations      
-
-   ln_sstfb   = .false.    ! Logical switch for feedback SST data
-                           !     ln_sss                  Logical switch for SSS observations
-   ln_seaice  = .false.    ! Logical switch for Sea Ice observations
-                           !     ln_vel3d                Logical switch for velocity observations
-                           !     ln_velavcur             Logical switch for velocity daily av. cur.
-                           !     ln_velhrcur             Logical switch for velocity high freq. cur.
-                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP
-                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
-                           !     ln_velfb                Logical switch for feedback velocity data
-                           !     ln_grid_global          Global distribtion of observations
-                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table
-                           !     grid_search_file        Grid search lookup file header
-                           !     enactfiles              ENACT input observation file names
-                           !     coriofiles              Coriolis input observation file name
-   !                       ! profbfiles: Profile feedback input observation file name
-   profbfiles = 'profiles_01.nc'
-                           !     ln_profb_enatim         Enact feedback input time setting switch
-                           !     slafilesact             Active SLA input observation file name
-                           !     slafilespas             Passive SLA input observation file name
-   !                       ! slafbfiles: Feedback SLA input observation file name
-   slafbfiles = 'sla_01.nc'
-                           !     sstfiles                GHRSST input observation file name
-   !                       ! sstfbfiles: Feedback SST input observation file name
-   sstfbfiles = 'sst_01.nc'
-                           !     seaicefiles             Sea Ice input observation file names
-   seaicefiles = 'seaice_01.nc'  
-                           !     velavcurfiles           Vel. cur. daily av. input file name
-                           !     velhvcurfiles           Vel. cur. high freq. input file name
-                           !     velavadcpfiles          Vel. ADCP daily av. input file name
-                           !     velhvadcpfiles          Vel. ADCP high freq. input file name
-                           !     velfbfiles              Vel. feedback input observation file name
-                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS
-                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS
-                           !     n1dint                  Type of vertical interpolation method
-                           !     n2dint                  Type of horizontal interpolation method
-                           !     ln_nea                  Rejection of observations near land switch
-   nmsshc     = 0          ! MSSH correction scheme
-                           !     mdtcorr                 MDT  correction
-                           !     mdtcutoff               MDT cutoff for computed correction
-   ln_altbias = .false.    ! Logical switch for alt bias
-   ln_ignmis  = .true.     ! Logical switch for ignoring missing files
-                           !     endailyavtypes   ENACT daily average types
-   ln_grid_global = .true.
-   ln_grid_search_lookup = .false.
+&namobs       !  observation usage switch
+!-----------------------------------------------------------------------
+   ln_diaobs  = .false.             ! Logical switch for the observation operator
+   ln_t3d     = .false.             ! Logical switch for T profile observations
+   ln_s3d     = .false.             ! Logical switch for S profile observations
+   ln_sla     = .false.             ! Logical switch for SLA observations
+   ln_sst     = .false.             ! Logical switch for SST observations
+   ln_sic     = .false.             ! Logical switch for Sea Ice observations
+   ln_vel3d   = .false.             ! Logical switch for velocity observations
+   ln_altbias = .false.             ! Logical switch for altimeter bias correction
+   ln_nea     = .false.             ! Logical switch for rejection of observations near land
+   ln_grid_global = .true.          ! Logical switch for global distribution of observations
+   ln_grid_search_lookup = .false.  ! Logical switch for obs grid search w/lookup table
+   ln_ignmis  = .true.              ! Logical switch for ignoring missing files
+   ln_s_at_t  = .false.             ! Logical switch for computing model S at T obs if not there
+   ln_sstnight = .false.            ! Logical switch for calculating night-time average for SST obs
+! All of the *files* variables below are arrays. Use namelist_cfg to add more files
+   cn_profbfiles = 'profiles_01.nc'    ! Profile feedback input observation file names
+   cn_slafbfiles = 'sla_01.nc'         ! SLA feedback input observation file names
+   cn_sstfbfiles = 'sst_01.nc'         ! SST feedback input observation file names
+   cn_sicfbfiles = 'sic_01.nc'         ! SIC feedback input observation file names
+   cn_velfbfiles = 'vel_01.nc'         ! Velocity feedback input observation file names
+   cn_altbiasfile = 'altbias.nc'       ! Altimeter bias input file name
+   cn_gridsearchfile = 'gridsearch.nc' ! Grid search file name
+   rn_gridsearchres = 0.5              ! Grid search resolution
+   rn_dobsini = 00010101.000000        ! Initial date in window YYYYMMDD.HHMMSS
+   rn_dobsend = 00010102.000000        ! Final date in window YYYYMMDD.HHMMSS
+   nn_1dint = 0                        ! Type of vertical interpolation method
+   nn_2dint = 0                        ! Type of horizontal interpolation method
+   nn_msshc = 0                        ! MSSH correction scheme
+   rn_mdtcorr = 1.61                   ! MDT  correction
+   rn_mdtcutoff = 65.0                 ! MDT cutoff for computed correction
+   nn_profdavtypes = -1                ! Profile daily average types - array
 /
 !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_top_ref
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_top_ref	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/SHARED/namelist_top_ref	(revision 5682)
@@ -21,5 +21,7 @@
                            !                  = 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
 /
 !-----------------------------------------------------------------------
@@ -50,5 +52,4 @@
 &namtrc_ldf    !   lateral diffusion scheme for passive tracer 
 !-----------------------------------------------------------------------
-   ln_trcldf_diff   =  .true.   !  performs lateral diffusion (T) or not (F)
 !                               !  Type of the operator : 
    ln_trcldf_lap    =  .true.   !     laplacian operator       
@@ -76,14 +77,16 @@
 &namtrc_dmp    !   passive tracer newtonian damping   
 !-----------------------------------------------------------------------
-   nn_hdmp_tr  =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
-                           !                   =XX, damping poleward of XX degrees (XX>0)
-                           !                      + F(distance-to-coast) + Red and Med Seas
    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)
-   rn_surf_tr  =   50.     !  surface time scale of damping   [days]
-   rn_bot_tr   =  360.     !  bottom  time scale of damping   [days]
-   rn_dep_tr   =  800.     !  depth of transition between rn_surf and rn_bot [meters]
-   nn_file_tr  =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+   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)
 /
 !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/cfg.txt
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/cfg.txt	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/cfg.txt	(revision 5682)
@@ -7,7 +7,6 @@
 AMM12 OPA_SRC
 ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC
-ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC
-ISOMIP OPA_SRC
 GYRE OPA_SRC
 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC
 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC
+ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/makenemo
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/makenemo	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/makenemo	(revision 5682)
@@ -200,9 +200,11 @@
 	    ;;
 	add_key)
-	    test $?2 || ( list_add_key=$2 && export ${list_add_key} )
+            # Checking if argument has anything other than whitespace
+            [[ ! "$2" =~ ^\ +$ ]] && { list_add_key=$2; export ${list_add_key}; }
 	    shift
 	    ;;
 	del_key)
-	    test $?2 || ( list_del_key=$2 && export ${list_del_key} )
+            # Checking if argument has anything other than whitespace
+            [[ ! "$2" =~ ^\ +$ ]] && { list_del_key=$2; export ${list_del_key}; }
 	    shift
 	    ;;
@@ -314,13 +316,7 @@
 fi
 
-#- At this stage new configuration has been added,
-#- We add or remove keys
-if [ ${#list_add_key} -ne 0 ] ; then
-    . ${COMPIL_DIR}/Fadd_keys.sh ${NEW_CONF} add_key ${list_add_key}
-fi
-
-if [ ${#list_del_key} -ne 0 ] ; then
-    . ${COMPIL_DIR}/Fdel_keys.sh ${NEW_CONF} del_key ${list_del_key}
-fi
+#- At this stage new configuration has been added, we add or remove keys
+[ ! -z "${list_add_key}" ] && { . ${COMPIL_DIR}/Fadd_keys.sh ${NEW_CONF} add_key ${list_add_key}; }
+[ ! -z "${list_del_key}" ] && { . ${COMPIL_DIR}/Fdel_keys.sh ${NEW_CONF} del_key ${list_del_key}; }
 
 #- check that all keys are really existing...
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/uspcfg.txt
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/uspcfg.txt	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/CONFIG/uspcfg.txt	(revision 5682)
@@ -1,1 +1,2 @@
 ORCA1_CICE # ORCA2_LIM # OPA_SRC TOP_SRC  # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/ORCA1_CICE/v3.6.0/ORCA1_CICE_ctl.txt
+ISOMIP     # GYRE      # OPA_SRC          # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/ISOMIP/v3.6.0/ISOMIP_ctl.txt
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F	(revision 5659)
+++ 	(revision )
@@ -1,1175 +1,0 @@
-!
-! $Id$
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Arrays
-C      
-      Module Agrif_Arrays
-      Use Agrif_Types
-C
-      implicit none
-C      
-      Contains
-C     **************************************************************************
-CCC   Subroutine Agrif_Childbounds
-C     **************************************************************************
-C
-      Subroutine Agrif_Childbounds(nbdim,lboundloc,uboundloc,
-     &                 pttab,petab,pttruetab,cetruetab,memberin)
-C
-CCC   Description:
-CCC   Subroutine calculating the global indices of the child grid
-C
-C
-C     Declarations:
-C
-
-C
-C     Arguments
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim) :: lboundloc,uboundloc
-      INTEGER,DIMENSION(nbdim) :: pttab,petab,pttruetab,cetruetab
-      LOGICAL :: memberin
-C
-C     Local variables
-      INTEGER :: i,lbglob,ubglob
-C
-#ifdef key_mpp_mpi
-      INTEGER :: indglob1,indglob2
-#endif
-C
-C
-      do i = 1,nbdim
-C
-        lbglob = lboundloc(i)
-        ubglob = uboundloc(i)
-C
-#ifdef key_mpp_mpi
-C
-        Call AGRIF_InvLoc(lbglob,Agrif_ProcRank,i,indglob1)
-C
-        Call AGRIF_InvLoc(ubglob,Agrif_ProcRank,i,indglob2)
-C
-        pttruetab(i) = max(pttab(i),indglob1)        
-C
-        cetruetab(i) = min(petab(i),indglob2)                 
-C
-#else
-C
-        pttruetab(i) = max(pttab(i),lbglob)        
-C
-        cetruetab(i) = min(petab(i),ubglob)
-C
-#endif
-C
-      enddo
-
-      memberin = .TRUE.
-
-      do i=1,nbdim
-        IF (cetruetab(i) < pttruetab(i)) THEN
-          memberin = .FALSE.
-          EXIT
-        ENDIF
-      enddo
-C
-      Return
-C
-C
-      End Subroutine Agrif_Childbounds
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_Get_bound
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_Get_bound(Variable,
-     &                           lower,upper,indice,nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to get the lower and the upper boundaries of a
-C     table. Output datas are scalar.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      ! we want extract boundaries of this table
-      TYPE(AGRIF_Variable), Pointer :: Variable    
-      INTEGER              :: lower,upper ! output data
-      ! direction in wich we want to know the dimension
-      INTEGER              :: indice      
-      INTEGER              :: nbdim       ! dimension of the table
-C
-C     Local variables
-C
-
-      lower = Variable % lb(indice)
-      upper = Variable % ub(indice)
-      return
-C
-      End Subroutine Agrif_nbdim_Get_bound       
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Get_bound_dimension
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_Get_bound_dimension(Variable,
-     &                              lower,upper,nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to get the lower and the upper boundaries of a
-C        table. Output datas are scalar.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      ! we want extract boundaries of this table
-      TYPE(AGRIF_Variable), Pointer     :: Variable    
-      INTEGER                  :: nbdim       ! dimension of the table
-      INTEGER,DIMENSION(nbdim) :: lower,upper ! output data
-C
-C     Local variables       
-C
-      lower = Variable % lb(1:nbdim)
-      upper = Variable % ub(1:nbdim)
-      return
-C
-      End Subroutine Agrif_nbdim_Get_bound_dimension     
-      
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_allocation
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_allocation(Variable,inf,sup,nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to Allocate the table Variable
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_Variable), Pointer     :: Variable    
-      INTEGER                  :: nbdim       ! dimension of the table
-      INTEGER,DIMENSION(nbdim) :: inf,sup
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-         allocate(Variable%array1(
-     &            inf(1):sup(1)))
-      CASE (2)
-          allocate(Variable%array2(
-     &            inf(1):sup(1),
-     &            inf(2):sup(2)))
-      CASE (3)
-         allocate(Variable%array3(
-     &            inf(1):sup(1),
-     &            inf(2):sup(2),
-     &            inf(3):sup(3)))
-      CASE (4)
-         allocate(Variable%array4(
-     &            inf(1):sup(1),
-     &            inf(2):sup(2),
-     &            inf(3):sup(3),
-     &            inf(4):sup(4)))
-      CASE (5)
-         allocate(Variable%array5(
-     &            inf(1):sup(1),
-     &            inf(2):sup(2),
-     &            inf(3):sup(3),
-     &            inf(4):sup(4),
-     &            inf(5):sup(5)))
-      CASE (6)
-         allocate(Variable%array6(
-     &            inf(1):sup(1),
-     &            inf(2):sup(2),
-     &            inf(3):sup(3),
-     &            inf(4):sup(4),
-     &            inf(5):sup(5),
-     &            inf(6):sup(6)))
-      END SELECT
-C
-      return
-C
-      End Subroutine Agrif_nbdim_allocation
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_deallocation
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_deallocation(Variable,nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to give the same value to the table Variable
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_Variable), Pointer     :: Variable    
-      INTEGER                  :: nbdim       ! dimension of the table
-C
-C     Local variables       
-C
-
-      SELECT CASE (nbdim)
-      CASE (1)
-         Deallocate(Variable%array1)
-      CASE (2)
-         Deallocate(Variable%array2)
-      CASE (3)
-         Deallocate(Variable%array3)
-      CASE (4)
-         Deallocate(Variable%array4)
-      CASE (5)
-         Deallocate(Variable%array5)
-      CASE (6)
-         Deallocate(Variable%array6)
-      END SELECT
-C
-      return
-C
-      End Subroutine Agrif_nbdim_deallocation
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_Full_VarEQreal
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_Full_VarEQreal(Variable,Value,nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to get the lower and the upper boundaries of a
-C        table. Output datas are scalar.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_Variable), Pointer :: Variable    
-      REAL                 :: Value       
-      INTEGER              :: nbdim       ! dimension of the table
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-        Variable%array1 = Value      
-      CASE (2)
-        Variable%array2 = Value
-      CASE (3)
-        Call Agrif_set_tozero3D(Variable%array3)
-!        Variable%array3 = Value
-      CASE (4)
-        Variable%array4 = Value
-      CASE (5)
-        Variable%array5 = Value
-      CASE (6)
-        Variable%array6 = Value
-      END SELECT
-C
-      return
-C
-      End Subroutine Agrif_nbdim_Full_VarEQreal   
-      
-      Subroutine Agrif_set_tozero3D(tab3D)
-      real,dimension(:,:,:),target :: tab3D
-      
-      tab3D = 0.
-      
-      end subroutine agrif_set_tozero3D    
-C
-C
-#if !defined key_mpp_mpi
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_VarEQreal
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_VarEQreal(Variable,inf,sup,Value,nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to give the same value to a part of 
-C        the table Variable
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_Variable), Pointer :: Variable    
-      REAL                 :: Value       
-      INTEGER              :: nbdim       ! dimension of the table
-      INTEGER,DIMENSION(nbdim) :: inf,sup
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-         Variable%array1(
-     &             inf(1):sup(1)
-     &             )  = Value
-      CASE (2)
-         Variable%array2(
-     &             inf(1):sup(1),
-     &             inf(2):sup(2)
-     &             )  = Value
-      CASE (3)
-         Variable%array3(
-     &             inf(1):sup(1),
-     &             inf(2):sup(2),
-     &             inf(3):sup(3)
-     &             )  = Value
-      CASE (4)
-         Variable%array4(
-     &             inf(1):sup(1),
-     &             inf(2):sup(2),
-     &             inf(3):sup(3),
-     &             inf(4):sup(4)
-     &             )  = Value
-      CASE (5)
-         Variable%array5(
-     &             inf(1):sup(1),
-     &             inf(2):sup(2),
-     &             inf(3):sup(3),
-     &             inf(4):sup(4),
-     &             inf(5):sup(5)
-     &             )  = Value
-      CASE (6)
-         Variable%array6(
-     &             inf(1):sup(1),
-     &             inf(2):sup(2),
-     &             inf(3):sup(3),
-     &             inf(4):sup(4),
-     &             inf(5):sup(5),
-     &             inf(6):sup(6)
-     &             )  = Value
-      END SELECT
-C
-      return
-C
-      End Subroutine Agrif_nbdim_VarEQreal       
-#endif
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_VarEQvar
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_VarEQvar(Variable,inf,sup,
-     &                                Variable2,inf2,sup2,
-     &                                nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to give the value of a part of the table 
-C        Variable2 to the table Variable
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_Variable), Pointer     :: Variable
-      TYPE(AGRIF_Variable), Pointer     :: Variable2
-      INTEGER                  :: nbdim       ! dimension of the table
-      INTEGER,DIMENSION(nbdim) :: inf,sup
-      INTEGER,DIMENSION(nbdim) :: inf2,sup2
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-         Variable%array1(inf(1):sup(1)) = 
-     &         Variable2%array1(inf2(1):sup2(1))
-      CASE (2)
-     
-      Call Agrif_Copy_2d(Variable%array2,Variable2%array2,
-     &  lbound(Variable%array2),
-     &  lbound(Variable2%array2),
-     &  inf,sup,inf2,sup2)
-          
-      CASE (3)
-
-      Call Agrif_Copy_3d(Variable%array3,Variable2%array3,
-     &  lbound(Variable%array3),
-     &  lbound(Variable2%array3),
-     &  inf,sup,inf2,sup2)
-
-      CASE (4)
-      
-      Call Agrif_Copy_4d(Variable%array4,Variable2%array4,
-     &  lbound(Variable%array4),
-     &  lbound(Variable2%array4),
-     &  inf,sup,inf2,sup2)
-     
-      CASE (5)
-        Variable%array5(inf(1):sup(1),
-     &                         inf(2):sup(2), 
-     &                         inf(3):sup(3),
-     &                         inf(4):sup(4), 
-     &                         inf(5):sup(5)) = 
-     &         Variable2%array5(inf2(1):sup2(1),
-     &                          inf2(2):sup2(2),
-     &                          inf2(3):sup2(3),
-     &                          inf2(4):sup2(4),
-     &                          inf2(5):sup2(5))
-      CASE (6)
-        Variable%array6(inf(1):sup(1),
-     &                         inf(2):sup(2),
-     &                         inf(3):sup(3),
-     &                         inf(4):sup(4),
-     &                         inf(5):sup(5),
-     &                         inf(6):sup(6)) = 
-     &         Variable2%array6(inf2(1):sup2(1),
-     &                          inf2(2):sup2(2),
-     &                          inf2(3):sup2(3),
-     &                          inf2(4):sup2(4),
-     &                          inf2(5):sup2(5),
-     &                          inf2(6):sup2(6))
-      END SELECT
-C
-      return
-C
-      End Subroutine Agrif_nbdim_VarEQvar
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_nbdim_Full_VarEQvar
-C     **************************************************************************
-C
-      Subroutine Agrif_nbdim_Full_VarEQvar(Variable,Variable2,
-     &                                nbdim)
-C
-CCC   Description:
-CCC   This subroutine is used to give the value of the table Variable2 
-C        to the table Variable
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_Variable), Pointer     :: Variable
-      TYPE(AGRIF_Variable), Pointer     :: Variable2
-      INTEGER                  :: nbdim       ! dimension of the table
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-          Variable%array1 = Variable2%array1
-      CASE (2)
-          Variable%array2 = Variable2%array2
-      CASE (3)
-          Variable%array3 = Variable2%array3
-      CASE (4)
-          Variable%array4 = Variable2%array4
-      CASE (5)
-          Variable%array5 = Variable2%array5
-      CASE (6)
-          Variable%array6 = Variable2%array6
-      END SELECT
-C
-      return
-C
-      End Subroutine Agrif_nbdim_Full_VarEQvar
-C
-C
-
-C     **************************************************************************
-CCC   Subroutine GiveAgrif_SpecialValueToTab_mpi
-C     **************************************************************************
-C
-      Subroutine GiveAgrif_SpecialValueToTab_mpi(Variable1,Variable2,
-     &                  bound1,lower,upper,Value,nbdim)
-C
-CCC   Description:
-CCC   
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_VARIABLE), Pointer    :: Variable1
-      TYPE(AGRIF_VARIABLE), Pointer    :: Variable2
-      INTEGER                  :: nbdim
-      INTEGER,DIMENSION(:,:,:) :: bound1
-      INTEGER,DIMENSION(nbdim) :: lower,upper
-      REAL                     :: Value
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-             Where (Variable1 % array1(
-     &           bound1(1,1,2):bound1(1,2,2)) 
-     &            == Value)
-             Variable2 % array1(bound1(1,1,1):bound1(1,2,1))
-     &                        = Value
-C      
-              End Where
-      CASE (2)
-             Where (Variable1 % array2(
-     &           bound1(1,1,2):bound1(1,2,2),
-     &           bound1(2,1,2):bound1(2,2,2)) 
-     &            == Value)
-             Variable2 % array2(bound1(1,1,1):bound1(1,2,1),
-     &                       bound1(2,1,1):bound1(2,2,1))
-     &                        = Value
-C      
-              End Where
-      CASE (3)
-             Where (Variable1 % array3(
-     &           bound1(1,1,2):bound1(1,2,2),
-     &                       bound1(2,1,2):bound1(2,2,2),
-     &                       bound1(3,1,2):bound1(3,2,2)) 
-     &            == Value)
-             Variable2 % array3(bound1(1,1,1):bound1(1,2,1),
-     &                       bound1(2,1,1):bound1(2,2,1),
-     &                       bound1(3,1,1):bound1(3,2,1))
-     &                         = Value
-C      
-              End Where
-      CASE (4)
-             Where (Variable1 % array4(
-     &           bound1(1,1,2):bound1(1,2,2),
-     &                       bound1(2,1,2):bound1(2,2,2),
-     &                       bound1(3,1,2):bound1(3,2,2),
-     &                       bound1(4,1,2):bound1(4,2,2)) 
-     &            == Value)
-             Variable2 % array4(bound1(1,1,1):bound1(1,2,1),
-     &                       bound1(2,1,1):bound1(2,2,1),
-     &                       bound1(3,1,1):bound1(3,2,1),
-     &                       bound1(4,1,1):bound1(4,2,1))
-     &                        = Value
-C      
-              End Where
-      CASE (5)
-             Where (Variable1 % array5(
-     &           bound1(1,1,2):bound1(1,2,2),
-     &                       bound1(2,1,2):bound1(2,2,2),
-     &                       bound1(3,1,2):bound1(3,2,2),
-     &                       bound1(4,1,2):bound1(4,2,2),
-     &                       bound1(5,1,2):bound1(5,2,2)) 
-     &            == Value)
-             Variable2 % array5(bound1(1,1,1):bound1(1,2,1),
-     &                       bound1(2,1,1):bound1(2,2,1),
-     &                       bound1(3,1,1):bound1(3,2,1),
-     &                       bound1(4,1,1):bound1(4,2,1),
-     &                       bound1(5,1,1):bound1(5,2,1))
-     &                        = Value
-C      
-              End Where
-      CASE (6)
-             Where (Variable1 % array6(
-     &           bound1(1,1,2):bound1(1,2,2),
-     &                       bound1(2,1,2):bound1(2,2,2),
-     &                       bound1(3,1,2):bound1(3,2,2),
-     &                       bound1(4,1,2):bound1(4,2,2),
-     &                       bound1(5,1,2):bound1(5,2,2),
-     &                       bound1(6,1,2):bound1(6,2,2)) 
-     &            == Value)
-             Variable2 % array6(bound1(1,1,1):bound1(1,2,1),
-     &                       bound1(2,1,1):bound1(2,2,1),
-     &                       bound1(3,1,1):bound1(3,2,1),
-     &                       bound1(4,1,1):bound1(4,2,1),
-     &                       bound1(5,1,1):bound1(5,2,1),
-     &                       bound1(6,1,1):bound1(6,2,1))
-     &                        = Value
-C      
-              End Where
-      END SELECT
-C
-      return
-C
-      End Subroutine GiveAgrif_SpecialValueToTab_mpi    
-
-C     **************************************************************************
-CCC   Subroutine GiveAgrif_SpecialValueToTab
-C     **************************************************************************
-C
-      Subroutine GiveAgrif_SpecialValueToTab(Variable1,Variable2,
-     &                  lower,upper,Value,nbdim)
-C
-CCC   Description:
-CCC   
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_VARIABLE), Pointer    :: Variable1
-      TYPE(AGRIF_VARIABLE), Pointer    :: Variable2
-      INTEGER                  :: nbdim
-      INTEGER,DIMENSION(nbdim) :: lower,upper
-      REAL                     :: Value
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-             Where (Variable1 % array1(
-     &           lower(1):upper(1))
-     &            == Value)
-             Variable2 % array1(lower(1):upper(1))
-     &                        = Value
-C      
-              End Where
-      CASE (2)
-             Where (Variable1 % array2(
-     &           lower(1):upper(1),
-     &           lower(2):upper(2)) 
-     &            == Value)
-             Variable2 % array2(lower(1):upper(1),
-     &                          lower(2):upper(2))
-     &                        = Value
-C      
-              End Where
-      CASE (3)
-             Where (Variable1 % array3(
-     &           lower(1):upper(1),
-     &           lower(2):upper(2), 
-     &           lower(3):upper(3)) 
-     &            == Value)
-             Variable2 % array3(lower(1):upper(1),
-     &                          lower(2):upper(2),
-     &                          lower(3):upper(3))
-     &                         = Value
-C      
-              End Where
-      CASE (4)
-             Where (Variable1 % array4(
-     &           lower(1):upper(1),
-     &           lower(2):upper(2), 
-     &           lower(3):upper(3),
-     &           lower(4):upper(4)) 
-     &            == Value)
-             Variable2 % array4(lower(1):upper(1),
-     &                          lower(2):upper(2),
-     &                          lower(3):upper(3),
-     &                          lower(4):upper(4))
-     &                        = Value
-C      
-              End Where
-      CASE (5)
-             Where (Variable1 % array5(
-     &           lower(1):upper(1),
-     &           lower(2):upper(2),
-     &           lower(3):upper(3),
-     &           lower(4):upper(4),
-     &           lower(5):upper(5)) 
-     &            == Value)
-             Variable2 % array5(lower(1):upper(1),
-     &                          lower(2):upper(2),
-     &                          lower(3):upper(3),
-     &                          lower(4):upper(4),
-     &                          lower(5):upper(5))
-     &                        = Value
-C      
-              End Where
-      CASE (6)
-             Where (Variable1 % array6(
-     &           lower(1):upper(1),
-     &           lower(2):upper(2),
-     &           lower(2):upper(3),
-     &           lower(4):upper(4),
-     &           lower(5):upper(5),
-     &           lower(6):upper(6)) 
-     &            == Value)
-             Variable2 % array6(lower(1):upper(1),
-     &                          lower(2):upper(2),
-     &                          lower(3):upper(3),
-     &                          lower(4):upper(4),
-     &                          lower(5):upper(5),
-     &                          lower(6):upper(6))
-     &                        = Value
-C      
-              End Where
-      END SELECT
-C
-      return
-C
-      End Subroutine GiveAgrif_SpecialValueToTab   
-
-C
-C
-#ifdef key_mpp_mpi
-C     **************************************************************************
-CCC   Subroutine Where_ValTabToTab_mpi
-C     **************************************************************************
-C
-      Subroutine Where_ValTabToTab_mpi(
-     &                  Variable1,Variable2,
-     &                  lower,upper,Value,nbdim)
-C
-CCC   Description:
-CCC   
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-C
-      TYPE(AGRIF_VARIABLE), Pointer     :: Variable1
-      TYPE(AGRIF_VARIABLE), Pointer     :: Variable2
-      INTEGER                  :: nbdim
-      INTEGER,DIMENSION(nbdim) :: lower,upper
-      REAL                     :: Value
-      INTEGER :: i,j,k,l,m,n
-C
-C     Local variables       
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-            DO i = lower(1),upper(1)
-              IF (variable1%array1(i) == Value) then
-                variable1%array1(i)=Variable2%array1(i)
-              ENDIF
-            ENDDO
-      CASE (2)
-            DO j = lower(2),upper(2)
-            DO i = lower(1),upper(1)
-              IF (variable1%array2(i,j) == Value) then
-                variable1%array2(i,j)=Variable2%array2(i,j)
-              ENDIF
-            ENDDO
-            ENDDO
-      CASE (3)
-            DO k = lower(3),upper(3)
-            DO j = lower(2),upper(2)
-            DO i = lower(1),upper(1)
-              IF (variable1%array3(i,j,k) == Value) then
-                variable1%array3(i,j,k)=Variable2%array3(i,j,k)
-              ENDIF
-            ENDDO
-            ENDDO
-            ENDDO
-      CASE (4)
-            DO l = lower(4),upper(4)
-            DO k = lower(3),upper(3)
-            DO j = lower(2),upper(2)
-            DO i = lower(1),upper(1)
-              IF (variable1%array4(i,j,k,l) == Value) then
-                variable1%array4(i,j,k,l)=Variable2%array4(i,j,k,l)
-              ENDIF
-            ENDDO
-            ENDDO
-            ENDDO
-            ENDDO
-      CASE (5)
-            DO m = lower(5),upper(5)
-            DO l = lower(4),upper(4)
-            DO k = lower(3),upper(3)
-            DO j = lower(2),upper(2)
-            DO i = lower(1),upper(1)
-              IF (variable1%array5(i,j,k,l,m) == Value) then
-              variable1%array5(i,j,k,l,m)=Variable2%array5(i,j,k,l,m)
-              ENDIF
-            ENDDO
-            ENDDO
-            ENDDO
-            ENDDO
-            ENDDO
-      CASE (6)
-            DO n = lower(6),upper(6)
-            DO m = lower(5),upper(5)
-            DO l = lower(4),upper(4)
-            DO k = lower(3),upper(3)
-            DO j = lower(2),upper(2)
-            DO i = lower(1),upper(1)
-              IF (variable1%array6(i,j,k,l,m,n) == Value) then
-            variable1%array6(i,j,k,l,m,n)=Variable2%array6(i,j,k,l,m,n)
-              ENDIF
-            ENDDO
-            ENDDO
-            ENDDO
-            ENDDO
-            ENDDO
-            ENDDO
-      END SELECT
-C
-      return
-C
-      End Subroutine Where_ValTabToTab_mpi    
-#endif
-
-C     **************************************************************************
-CCC   Subroutine PreProcessToInterpOrUpdate
-C     **************************************************************************
-C
-      Subroutine PreProcessToInterpOrUpdate(parent,child,
-     &             petab_Child,
-     &             pttab_Child,pttab_Parent,
-     &             s_Child,s_Parent,
-     &             ds_Child,ds_Parent,
-     &             nbdim)
-C
-CCC   Description:
-CCC   
-C
-C     Declarations:
-C      
-C     arguments                                   
-      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid
-      INTEGER :: nbdim                  
-      INTEGER,DIMENSION(6) :: pttab_child  
-      INTEGER,DIMENSION(6) :: petab_child      
-      INTEGER,DIMENSION(6) :: pttab_parent  
-      TYPE(AGRIF_Variable), Pointer :: root ! Pointer on the variable of the 
-                                            ! root grid
-      TYPE(Agrif_Grid), Pointer :: Agrif_Child_Gr,Agrif_Parent_Gr
-      REAL, DIMENSION(6) :: s_child,s_parent
-      REAL, DIMENSION(6) :: ds_child,ds_parent
-C     locals variables
-      INTEGER :: n
-      
-C
-C     Arguments      
-C
-
-C
-C     Local variables       
-C
-      Agrif_Child_Gr => Agrif_Curgrid
-      Agrif_Parent_Gr => Agrif_Curgrid % parent
-C
-      root => child % var % root_var 
-C
-C     Number of dimensions of the current grid
-      nbdim = root % nbdim
-C      
-      do n=1,nbdim
-C            
-        Select case(root % interptab(n))
-C
-C       Value of interptab(n) can be either x,y,z or N for a no space 
-C       DIMENSION            
-C
-C         The DIMENSION is 'x'
-          case('x')
-C
-            pttab_Child(n) = root % point(1)
-C            
-            pttab_Parent(n) = root % point(1)
-C        
-            s_Child(n) = Agrif_Child_Gr % Agrif_x(1)
-C
-            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(1)
-C        
-            ds_Child(n) = Agrif_Child_Gr % Agrif_d(1)
-C
-            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(1)
-C                      
-            if (root % posvar(n).EQ.1) then
-C          
-              petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(1)
-C        
-              else
-C          
-                petab_Child(n) = pttab_Child(n) + 
-     &                              Agrif_Child_Gr%nb(1) - 1
-C          
-                s_Child(n) = s_Child(n) + ds_Child(n)/2.
-C
-                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
-C        
-            endif                  
-C
-C         The DIMENSION is 'y'
-          case('y')
-C
-            pttab_Child(n) = root % point(2)
-C            
-            pttab_Parent(n) = root % point(2)
-C        
-            s_Child(n) = Agrif_Child_Gr % Agrif_x(2)
-C
-            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(2) 
-C        
-            ds_Child(n) = Agrif_Child_Gr % Agrif_d(2)
-C
-            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(2)
-C                      
-            if (root % posvar(n).EQ.1) then
-C          
-             petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(2)
-C          
-              else
-C          
-                petab_Child(n) = pttab_Child(n) + 
-     &                       Agrif_Child_Gr%nb(2) - 1
-C          
-                s_Child(n) = s_Child(n) + ds_Child(n)/2.
-C
-                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
-C        
-            endif
-            
-C
-C         The DIMENSION is 'z'                            
-          case('z')
-C
-            pttab_Child(n) = root % point(3)
-C            
-            pttab_Parent(n) = root % point(3)
-C        
-            s_Child(n) = Agrif_Child_Gr % Agrif_x(3)
-C
-            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(3)
-C        
-            ds_Child(n) = Agrif_Child_Gr % Agrif_d(3)
-C
-            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(3)
-C                      
-            if (root % posvar(n).EQ.1) then
-C          
-             petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(3)
-C          
-              else
-C          
-                petab_Child(n) = pttab_Child(n) + 
-     &                      Agrif_Child_Gr%nb(3) - 1
-C
-                s_Child(n) = s_Child(n) + ds_Child(n)/2.
-C
-                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
-C        
-            endif       
-C 
-C         The DIMENSION is not space                            
-          case('N')
-C
-C         The next coefficients are calculated in order to do a simple copy of 
-C         values of the grid variable when the procedure of interpolation is 
-C         called for this DIMENSION 
-C      
-            Call Agrif_nbdim_Get_bound(child % var,
-     &                           pttab_Child(n),petab_Child(n),n,nbdim)
-C
-C           No interpolation but only a copy of the values of the grid variable
-C
-            pttab_Parent(n) = pttab_Child(n)
-C              
-            s_Child(n)=0.
-C      
-            s_Parent(n)=0. 
-C      
-            ds_Child(n)=1.
-C      
-            ds_Parent(n)=1.
-C
-        End select
-C            
-      enddo     
-C
-      return
-C
-      End Subroutine PreProcessToInterpOrUpdate     
-
-#ifdef key_mpp_mpi
-C
-C     **************************************************************************
-CCC   Subroutine GetLocalBoundaries
-C     **************************************************************************
-C
-      Subroutine GetLocalBoundaries(tab1,tab2,i,lb,ub,deb,fin)
-C
-CCC   Descritpion:
-C 
-C
-C     Declarations:
-C
-
-C
-C
-C     Scalar arguments
-      INTEGER  ::  tab1,tab2
-      INTEGER  ::  i
-      INTEGER  ::  lb,ub
-      INTEGER  ::  deb,fin
-C
-C     Local scalars
-      INTEGER  ::  imin,imax
-      INTEGER  ::  i1,i2
-C
-C
-      Call AGRIF_InvLoc(lb,AGRIF_ProcRank,i,imin)
-C
-      Call AGRIF_InvLoc(ub,AGRIF_ProcRank,i,imax)
-C
-C
-      if (imin > tab2) then
-C
-          i1 = imax - imin
-C
-        else
-C
-          i1 = max(tab1 - imin,0)
-C
-      endif
-C
-      if (imax < tab1) then
-C
-          i2 = -(imax - imin)
-C
-        else
-C
-          i2 = min(tab2 - imax,0)
-C
-      endif
-C
-      deb = lb + i1
-C
-      fin = ub + i2
-C
-C
-      End Subroutine GetLocalBoundaries
-C
-#endif
-C
-C
-#ifdef key_mpp_mpi
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_GlobtoLocInd2
-C     **************************************************************************
-C
-      Subroutine Agrif_GlobtoLocInd2(tabarray,lboundl,uboundl,tab1,tab2,
-     &                              nbdim,rank,member)
-C
-CCC   Description:
-CCC   For a global index located on the current processor, tabarray gives the 
-CCC   corresponding local index   
-C
-C
-C     Declarations:
-C
-
-C
-C     Arguments
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim) :: tab1,tab2
-      INTEGER,DIMENSION(nbdim,2,2 ) :: tabarray
-      INTEGER,DIMENSION(nbdim) :: lboundl,uboundl
-      INTEGER :: rank
-      LOGICAL :: member
-C    
-C     Local variables
-      INTEGER :: i,i1,k
-      INTEGER :: nbloc(nbdim)
-C
-C
-      tabarray(:,1,:) =  HUGE(1)
-      tabarray(:,2,:) =  -HUGE(1)
-
-      nbloc = 0
-C        
-      do i = 1,nbdim
-C       
-        Call Agrif_Invloc(lboundl(i),rank,i,i1)
-        
-        do k=tab1(i)+lboundl(i)-i1,tab2(i)+lboundl(i)-i1
-          IF ((k .GE. lboundl(i)) .AND. (k.LE.uboundl(i))) THEN
-            nbloc(i) = 1
-            tabarray(i,1,1) = min(tabarray(i,1,1),k-lboundl(i)+i1)
-            tabarray(i,2,1) = max(tabarray(i,2,1),k-lboundl(i)+i1)
-        
-            tabarray(i,1,2) = min(tabarray(i,1,2),k)
-            tabarray(i,2,2) = max(tabarray(i,2,2),k)
-          ENDIF
-        enddo
-C
-      enddo
-
-      member = .FALSE.
-      IF (sum(nbloc) == nbdim) member = .TRUE.
-C
-      Return
-C
-C
-      End Subroutine Agrif_GlobtoLocInd2
-C
-#endif      
-
-      Subroutine Agrif_Copy_2d(tabout,tabin,l,m,inf,sup,inf2,sup2)
-      integer,dimension(2) :: l,m,inf,sup,inf2,sup2
-      real,target,dimension(l(1):,l(2):) :: tabout
-      real,target,dimension(m(1):,m(2):) :: tabin
-          tabout(inf(1):sup(1),
-     &                         inf(2):sup(2)) = 
-     &         tabin(inf2(1):sup2(1),
-     &                          inf2(2):sup2(2))
-      End Subroutine Agrif_Copy_2d
-      
-      Subroutine Agrif_Copy_3d(tabout,tabin,l,m,inf,sup,inf2,sup2)
-      integer,dimension(3) :: l,m,inf,sup,inf2,sup2
-      real,target,dimension(l(1):,l(2):,l(3):) :: tabout
-      real,target,dimension(m(1):,m(2):,m(3):) :: tabin
-          tabout(inf(1):sup(1),
-     &                         inf(2):sup(2), 
-     &                         inf(3):sup(3)) = 
-     &         tabin(inf2(1):sup2(1),
-     &                          inf2(2):sup2(2),
-     &                          inf2(3):sup2(3))
-      End Subroutine Agrif_Copy_3d
-      
-      Subroutine Agrif_Copy_4d(tabout,tabin,l,m,inf,sup,inf2,sup2)
-      integer,dimension(4) :: l,m,inf,sup,inf2,sup2
-      real,target,dimension(l(1):,l(2):,l(3):,l(4):) :: tabout
-      real,target,dimension(m(1):,m(2):,m(3):,m(4):) :: tabin
-          tabout(inf(1):sup(1),
-     &                         inf(2):sup(2), 
-     &                         inf(3):sup(3), 
-     &                         inf(4):sup(4)) = 
-     &         tabin(inf2(1):sup2(1),
-     &                          inf2(2):sup2(2),
-     &                          inf2(3):sup2(3),
-     &                          inf2(4):sup2(4))
-      End Subroutine Agrif_Copy_4d      
-
-      End Module Agrif_Arrays
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90	(revision 5682)
@@ -0,0 +1,826 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Arrays
+!
+module Agrif_Arrays
+!
+    use Agrif_Types
+    use Agrif_Grids
+!
+    implicit none
+!
+#if defined AGRIF_MPI
+    interface
+        subroutine Agrif_InvLoc ( indloc, proc_id, dir, indglob )
+            integer, intent(in)     :: indloc   !< local index
+            integer, intent(in)     :: proc_id  !< rank of the proc calling this function
+            integer, intent(in)     :: dir      !< direction of the index
+            integer, intent(out)    :: indglob  !< global index
+        end subroutine Agrif_InvLoc
+    end interface
+    private :: Agrif_InvLoc
+#endif
+!
+contains
+!
+!===================================================================================================
+! subroutine Agrif_Childbounds
+!
+!> Computes the global indices of the child grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Childbounds ( nbdim,           &
+                               lb_var, ub_var,  &
+                               lb_tab, ub_tab,  &
+                               proc_id,         &
+                               coords,          &
+                               lb_tab_true, ub_tab_true, memberin )
+!---------------------------------------------------------------------------------------------------
+    integer,                   intent(in)  :: nbdim         !< Number of dimensions
+    integer, dimension(nbdim), intent(in)  :: lb_var        !< Local lower boundary on the current processor
+    integer, dimension(nbdim), intent(in)  :: ub_var        !< Local upper boundary on the current processor
+    integer, dimension(nbdim), intent(in)  :: lb_tab        !< Global lower boundary of the variable
+    integer, dimension(nbdim), intent(in)  :: ub_tab        !< Global upper boundary of the variable
+    integer,                   intent(in)  :: proc_id       !< Current processor
+    integer, dimension(nbdim), intent(in)  :: coords
+    integer, dimension(nbdim), intent(out) :: lb_tab_true   !< Global value of lb_var on the current processor
+    integer, dimension(nbdim), intent(out) :: ub_tab_true   !< Global value of ub_var on the current processor
+    logical,                   intent(out) :: memberin
+!
+    integer :: i, coord_i
+    integer :: lb_glob_index, ub_glob_index ! Lower and upper global indices
+!
+    do i = 1, nbdim
+!
+        coord_i = coords(i)
+!
+#if defined AGRIF_MPI
+        call Agrif_InvLoc( lb_var(i), proc_id, coord_i, lb_glob_index )
+        call Agrif_InvLoc( ub_var(i), proc_id, coord_i, ub_glob_index )
+#else
+        lb_glob_index = lb_var(i)
+        ub_glob_index = ub_var(i)
+#endif
+        lb_tab_true(i) = max(lb_tab(i), lb_glob_index)
+        ub_tab_true(i) = min(ub_tab(i), ub_glob_index)
+    enddo
+!
+    memberin = .true.
+    do i = 1,nbdim
+        if (ub_tab_true(i) < lb_tab_true(i)) then
+            memberin = .false.
+            exit
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Childbounds
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_get_var_global_bounds( var, lubglob, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),        intent(in)  :: var
+    integer, dimension(nbdim,2), intent(out) :: lubglob
+    integer,                     intent(in)  :: nbdim
+!
+#if defined AGRIF_MPI
+    include 'mpif.h'
+    integer, dimension(nbdim)   :: lb, ub
+    integer, dimension(nbdim,2) :: iminmaxg
+    integer :: i, code, coord_i
+#endif
+!
+#if !defined AGRIF_MPI
+    call Agrif_get_var_bounds_array(var, lubglob(:,1), lubglob(:,2), nbdim)
+#else
+    call Agrif_get_var_bounds_array(var, lb, ub, nbdim)
+
+    do i = 1,nbdim
+        coord_i = var % root_var % coords(i)
+        call Agrif_InvLoc( lb(i), Agrif_Procrank, coord_i, iminmaxg(i,1) )
+        call Agrif_InvLoc( ub(i), Agrif_Procrank, coord_i, iminmaxg(i,2) )
+    enddo
+!
+    iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
+    call MPI_ALLREDUCE(iminmaxg, lubglob, 2*nbdim, MPI_INTEGER, MPI_MIN, Agrif_mpi_comm, code)
+    lubglob(1:nbdim,2)  = - lubglob(1:nbdim,2)
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_get_var_global_bounds
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_get_var_bounds
+!
+!> Gets the lower and the upper boundaries of a variable, for one particular direction.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_get_var_bounds ( variable, lower, upper, index )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), intent(in)    :: variable   !< Variable for which we want to extract boundaries
+    integer,              intent(out)   :: lower      !< Lower bound
+    integer,              intent(out)   :: upper      !< Upper bound
+    integer,              intent(in)    :: index      !< Direction for wich we want to know the boundaries
+!
+    lower = variable % lb(index)
+    upper = variable % ub(index)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_get_var_bounds
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_get_var_bounds_array
+!
+!> Gets the lower and the upper boundaries of a table.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_get_var_bounds_array ( variable, lower, upper, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(in)   :: variable   !< Variable for which we want to extract boundaries
+    integer, dimension(nbdim), intent(out)  :: lower      !< Lower bounds array
+    integer, dimension(nbdim), intent(out)  :: upper      !< Upper bounds array
+    integer, intent(in)                     :: nbdim      !< Numer of dimensions of the variable
+!
+    lower = variable % lb(1:nbdim)
+    upper = variable % ub(1:nbdim)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_get_var_bounds_array
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_array_allocate
+!
+!> Allocates data array in \b variable, according to the required dimension.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_array_allocate ( variable, lb, ub, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(inout) :: variable    !< Variable struct for allocation
+    integer, dimension(nbdim), intent(in)    :: lb          !< Lower bound
+    integer, dimension(nbdim), intent(in)    :: ub          !< Upper bound
+    integer,                   intent(in)    :: nbdim       !< Dimension of the array
+!
+    select case (nbdim)
+    case (1) ; allocate(variable%array1(lb(1):ub(1)))
+    case (2) ; allocate(variable%array2(lb(1):ub(1),lb(2):ub(2)))
+    case (3) ; allocate(variable%array3(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3)))
+    case (4) ; allocate(variable%array4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4)))
+    case (5) ; allocate(variable%array5(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5)))
+    case (6) ; allocate(variable%array6(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6)))
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_array_allocate
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_array_deallocate
+!
+!> Dellocates data array in \b variable, according to the required dimension.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_array_deallocate ( variable, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), intent(inout) :: variable     !< Variable struct for deallocation
+    integer,              intent(in)    :: nbdim        !< Dimension of the array
+!
+    select case (nbdim)
+    case (1) ; deallocate(variable%array1)
+    case (2) ; deallocate(variable%array2)
+    case (3) ; deallocate(variable%array3)
+    case (4) ; deallocate(variable%array4)
+    case (5) ; deallocate(variable%array5)
+    case (6) ; deallocate(variable%array6)
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_array_deallocate
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_var_set_array_tozero
+!
+!> Reset the value of the data array in \b variable, according to the required dimension.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_var_set_array_tozero ( variable, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), intent(inout) :: variable     !< Variable
+    integer, intent(in)                 :: nbdim        !< Dimension of the array you want to reset
+!
+    select case (nbdim)
+    case (1) ; call Agrif_set_array_tozero_1D(variable%array1)
+    case (2) ; call Agrif_set_array_tozero_2D(variable%array2)
+    case (3) ; call Agrif_set_array_tozero_3D(variable%array3)
+    case (4) ; call Agrif_set_array_tozero_4D(variable%array4)
+    case (5) ; call Agrif_set_array_tozero_5D(variable%array5)
+    case (6) ; call Agrif_set_array_tozero_6D(variable%array6)
+    end select
+!---------------------------------------------------------------------------------------------------
+contains
+!---------------------------------------------------------------------------------------------------
+    subroutine Agrif_set_array_tozero_1D ( array )
+        real, dimension(:),           intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_1D
+!
+    subroutine Agrif_set_array_tozero_2D ( array )
+        real, dimension(:,:),         intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_2D
+!
+    subroutine Agrif_set_array_tozero_3D ( array )
+        real, dimension(:,:,:),       intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_3D
+!
+    subroutine Agrif_set_array_tozero_4D ( array )
+        real, dimension(:,:,:,:),     intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_4D
+!
+    subroutine Agrif_set_array_tozero_5D ( array )
+        real, dimension(:,:,:,:,:),   intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_5D
+!
+    subroutine Agrif_set_array_tozero_6D ( array )
+        real, dimension(:,:,:,:,:,:), intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_6D
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_var_set_array_tozero
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_var_copy_array
+!
+!> Copy a part of data array from var2 to var1
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_var_copy_array ( var1, inf1, sup1, var2, inf2, sup2, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(inout) :: var1    !< Modified variable
+    integer, dimension(nbdim), intent(in)    :: inf1    !< Lower boundary for var1
+    integer, dimension(nbdim), intent(in)    :: sup1    !< Upper boundary for var1
+    type(Agrif_Variable),      intent(in)    :: var2    !< Input variable
+    integer, dimension(nbdim), intent(in)    :: inf2    !< Lower boundary for var2
+    integer, dimension(nbdim), intent(in)    :: sup2    !< Upper boundary for var2
+    integer,                   intent(in)    :: nbdim   !< Dimension of the array
+!
+    select case (nbdim)
+    case (1) ; var1%array1(inf1(1):sup1(1)) = var2%array1(inf2(1):sup2(1))
+    case (2) ; call Agrif_copy_array_2d( var1%array2, var2%array2, &
+                                         lbound(var1%array2), lbound(var2%array2), inf1, sup1, inf2, sup2 )
+    case (3) ; call Agrif_copy_array_3d( var1%array3, var2%array3, &
+                                         lbound(var1%array3), lbound(var2%array3), inf1, sup1, inf2, sup2 )
+    case (4) ; call Agrif_copy_array_4d( var1%array4, var2%array4, &
+                                         lbound(var1%array4), lbound(var2%array4), inf1, sup1, inf2, sup2 )
+    case (5) ; var1%array5(inf1(1):sup1(1),   &
+                           inf1(2):sup1(2),   &
+                           inf1(3):sup1(3),   &
+                           inf1(4):sup1(4),   &
+                           inf1(5):sup1(5)) = var2%array5(inf2(1):sup2(1), &
+                                                          inf2(2):sup2(2), &
+                                                          inf2(3):sup2(3), &
+                                                          inf2(4):sup2(4), &
+                                                          inf2(5):sup2(5))
+    case (6) ; var1%array6(inf1(1):sup1(1),   &
+                           inf1(2):sup1(2),   &
+                           inf1(3):sup1(3),   &
+                           inf1(4):sup1(4),   &
+                           inf1(5):sup1(5),   &
+                           inf1(6):sup1(6)) = var2%array6(inf2(1):sup2(1), &
+                                                          inf2(2):sup2(2), &
+                                                          inf2(3):sup2(3), &
+                                                          inf2(4):sup2(4), &
+                                                          inf2(5):sup2(5), &
+                                                          inf2(6):sup2(6))
+    end select
+!---------------------------------------------------------------------------------------------------
+contains
+!---------------------------------------------------------------------------------------------------
+    subroutine Agrif_copy_array_2d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 )
+        integer, dimension(2), intent(in)   :: l, m
+        integer, dimension(2), intent(in)   :: inf1, sup1
+        integer, dimension(2), intent(in)   :: inf2, sup2
+        real, dimension(l(1):,l(2):), intent(out) :: tabout
+        real, dimension(m(1):,m(2):), intent(in)  :: tabin
+        tabout(inf1(1):sup1(1), &
+               inf1(2):sup1(2)) = tabin(inf2(1):sup2(1), &
+                                        inf2(2):sup2(2))
+    end subroutine Agrif_copy_array_2d
+!
+    subroutine Agrif_copy_array_3d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 )
+        integer, dimension(3), intent(in)   :: l, m
+        integer, dimension(3), intent(in)   :: inf1, sup1
+        integer, dimension(3), intent(in)   :: inf2,sup2
+        real, dimension(l(1):,l(2):,l(3):), intent(out) :: tabout
+        real, dimension(m(1):,m(2):,m(3):), intent(in)  :: tabin
+        tabout(inf1(1):sup1(1), &
+               inf1(2):sup1(2), &
+               inf1(3):sup1(3)) = tabin(inf2(1):sup2(1), &
+                                        inf2(2):sup2(2), &
+                                        inf2(3):sup2(3))
+    end subroutine Agrif_copy_array_3d
+!
+    subroutine Agrif_copy_array_4d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 )
+        integer, dimension(4), intent(in)   :: l, m
+        integer, dimension(4), intent(in)   :: inf1, sup1
+        integer, dimension(4), intent(in)   :: inf2, sup2
+        real, dimension(l(1):,l(2):,l(3):,l(4):), intent(out) :: tabout
+        real, dimension(m(1):,m(2):,m(3):,m(4):), intent(in)  :: tabin
+        tabout(inf1(1):sup1(1), &
+               inf1(2):sup1(2), &
+               inf1(3):sup1(3), &
+               inf1(4):sup1(4)) = tabin(inf2(1):sup2(1), &
+                                        inf2(2):sup2(2), &
+                                        inf2(3):sup2(3), &
+                                        inf2(4):sup2(4))
+    end subroutine Agrif_copy_array_4d
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_var_copy_array
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_var_full_copy_array
+!
+!> Copy the full data array from var2 to var1
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_var_full_copy_array ( var1, var2, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), intent(inout) :: var1    !< Modified variable
+    type(Agrif_Variable), intent(in)    :: var2    !< Input variable
+    integer,              intent(in)    :: nbdim   !< Dimension of the array
+!
+    select case (nbdim)
+    case (1) ; var1 % array1 = var2 % array1
+    case (2) ; var1 % array2 = var2 % array2
+    case (3) ; var1 % array3 = var2 % array3
+    case (4) ; var1 % array4 = var2 % array4
+    case (5) ; var1 % array5 = var2 % array5
+    case (6) ; var1 % array6 = var2 % array6
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_var_full_copy_array
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine GiveAgrif_SpecialValueToTab_mpi
+!
+!> Copy \b value in data array \b var2 where it is present in \b var1.
+!---------------------------------------------------------------------------------------------------
+subroutine GiveAgrif_SpecialValueToTab_mpi ( var1, var2, bounds, value, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(in)    :: var1    !< Modified variable
+    type(Agrif_Variable),      intent(inout) :: var2    !< Input variable
+    integer, dimension(:,:,:), intent(in)    :: bounds  !< Bound for both arrays
+    real,                      intent(in)    :: value   !< Special value
+    integer,                   intent(in)    :: nbdim   !< Dimension of the array
+!
+    select case (nbdim)
+    case (1)
+        where (var1 % array1(bounds(1,1,2):bounds(1,2,2)) == value )
+            var2 % array1(bounds(1,1,1):bounds(1,2,1)) = value
+        end where
+    case (2)
+        where (var1 % array2(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2)) == value)
+            var2 % array2(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1)) = value
+        end where
+    case (3)
+        where (var1 % array3(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2), &
+                             bounds(3,1,2):bounds(3,2,2)) == value)
+            var2 % array3(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1), &
+                          bounds(3,1,1):bounds(3,2,1)) = value
+        end where
+    case (4)
+        where (var1 % array4(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2), &
+                             bounds(3,1,2):bounds(3,2,2), &
+                             bounds(4,1,2):bounds(4,2,2)) == value)
+            var2 % array4(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1), &
+                          bounds(3,1,1):bounds(3,2,1), &
+                          bounds(4,1,1):bounds(4,2,1)) = value
+        end where
+    case (5)
+        where (var1 % array5(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2), &
+                             bounds(3,1,2):bounds(3,2,2), &
+                             bounds(4,1,2):bounds(4,2,2), &
+                             bounds(5,1,2):bounds(5,2,2)) == value)
+            var2 % array5(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1), &
+                          bounds(3,1,1):bounds(3,2,1), &
+                          bounds(4,1,1):bounds(4,2,1), &
+                          bounds(5,1,1):bounds(5,2,1)) = value
+        end where
+    case (6)
+        where (var1 % array6(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2), &
+                             bounds(3,1,2):bounds(3,2,2), &
+                             bounds(4,1,2):bounds(4,2,2), &
+                             bounds(5,1,2):bounds(5,2,2), &
+                             bounds(6,1,2):bounds(6,2,2)) == value)
+            var2 % array6(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1), &
+                          bounds(3,1,1):bounds(3,2,1), &
+                          bounds(4,1,1):bounds(4,2,1), &
+                          bounds(5,1,1):bounds(5,2,1), &
+                          bounds(6,1,1):bounds(6,2,1)) = value
+        end where
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine GiveAgrif_SpecialValueToTab_mpi
+!===================================================================================================
+!
+! no more used ???
+#if 0
+!===================================================================================================
+!  subroutine GiveAgrif_SpecialValueToTab
+!---------------------------------------------------------------------------------------------------
+subroutine GiveAgrif_SpecialValueToTab ( var1, var2, &
+                                         lower, upper, Value, nbdim )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Variable),      pointer      :: var1
+    TYPE(Agrif_Variable),      pointer      :: var2
+    INTEGER,                   intent(in)   :: nbdim
+    INTEGER, DIMENSION(nbdim), intent(in)   :: lower, upper
+    REAL,                      intent(in)   :: Value
+!
+    select case (nbdim)
+    case (1)
+        where (var1 % array1( lower(1):upper(1)) == Value)
+            var2 % array1(lower(1):upper(1)) = Value
+        end where
+    case (2)
+        where (var1 % array2( lower(1):upper(1), &
+                                   lower(2):upper(2)) == Value)
+            var2 % array2(lower(1):upper(1), &
+                               lower(2):upper(2)) = Value
+        end where
+    case (3)
+        where (var1 % array3( lower(1):upper(1), &
+                                   lower(2):upper(2), &
+                                   lower(3):upper(3)) == Value)
+            var2 % array3(lower(1):upper(1), &
+                               lower(2):upper(2), &
+                               lower(3):upper(3)) = Value
+        end where
+    case (4)
+        where (var1 % array4( lower(1):upper(1), &
+                                   lower(2):upper(2), &
+                                   lower(3):upper(3), &
+                                   lower(4):upper(4)) == Value)
+            var2 % array4(lower(1):upper(1), &
+                               lower(2):upper(2), &
+                               lower(3):upper(3), &
+                               lower(4):upper(4)) = Value
+        end where
+    case (5)
+        where (var1 % array5( lower(1):upper(1), &
+                                   lower(2):upper(2), &
+                                   lower(3):upper(3), &
+                                   lower(4):upper(4), &
+                                   lower(5):upper(5)) == Value)
+            var2 % array5(lower(1):upper(1), &
+                               lower(2):upper(2), &
+                               lower(3):upper(3), &
+                               lower(4):upper(4), &
+                               lower(5):upper(5)) = Value
+        end where
+    case (6)
+        where (var1 % array6( lower(1):upper(1), &
+                                   lower(2):upper(2), &
+                                   lower(3):upper(3), &
+                                   lower(4):upper(4), &
+                                   lower(5):upper(5), &
+                                   lower(6):upper(6)) == Value)
+            var2 % array6(lower(1):upper(1), &
+                               lower(2):upper(2), &
+                               lower(3):upper(3), &
+                               lower(4):upper(4), &
+                               lower(5):upper(5), &
+                               lower(6):upper(6)) = Value
+        end where
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine GiveAgrif_SpecialValueToTab
+!===================================================================================================
+#endif
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!  subroutine Agrif_var_replace_value
+!
+!> Replace \b value by \var2 content in \var1 data array.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_var_replace_value ( var1, var2, lower, upper, value, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(inout) :: var1    !< Modified variable
+    type(Agrif_Variable),      intent(in)    :: var2    !< Input variable
+    integer, dimension(nbdim), intent(in)    :: lower   !< Lower bound
+    integer, dimension(nbdim), intent(in)    :: upper   !< Upper bound
+    real,                      intent(in)    :: value   !< Special value
+    integer,                   intent(in)    :: nbdim   !< Dimension of the array
+!
+    integer :: i,j,k,l,m,n
+!
+    select case (nbdim)
+    case (1)
+        do i = lower(1),upper(1)
+            if (var1%array1(i) == value) then
+                var1%array1(i) = var2%array1(i)
+            endif
+        enddo
+    case (2)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array2(i,j) == value) then
+                var1%array2(i,j) = var2%array2(i,j)
+            endif
+        enddo
+        enddo
+    case (3)
+        do k = lower(3),upper(3)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array3(i,j,k) == value) then
+                var1%array3(i,j,k) = var2%array3(i,j,k)
+            endif
+        enddo
+        enddo
+        enddo
+    case (4)
+        do l = lower(4),upper(4)
+        do k = lower(3),upper(3)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array4(i,j,k,l) == value) then
+                var1%array4(i,j,k,l) = var2%array4(i,j,k,l)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+    case (5)
+        do m = lower(5),upper(5)
+        do l = lower(4),upper(4)
+        do k = lower(3),upper(3)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array5(i,j,k,l,m) == value) then
+                var1%array5(i,j,k,l,m) = var2%array5(i,j,k,l,m)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    case (6)
+        do n = lower(6),upper(6)
+        do m = lower(5),upper(5)
+        do l = lower(4),upper(4)
+        do k = lower(3),upper(3)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array6(i,j,k,l,m,n) == value) then
+                var1%array6(i,j,k,l,m,n) = var2%array6(i,j,k,l,m,n)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_var_replace_value
+!===================================================================================================
+#endif
+!
+!===================================================================================================
+!  subroutine PreProcessToInterpOrUpdate
+!---------------------------------------------------------------------------------------------------
+subroutine PreProcessToInterpOrUpdate ( parent, child,              &
+                                        nb_child, ub_child,         &
+                                        lb_child, lb_parent,        &
+                                        s_child,  s_parent,         &
+                                        ds_child, ds_parent, nbdim, interp )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer, intent(in)   :: parent       !< Variable on the parent grid
+    type(Agrif_Variable), pointer, intent(in)   :: child        !< Variable on the child grid
+    integer, dimension(6), intent(out)          :: nb_child     !< Number of cells on the child grid
+    integer, dimension(6), intent(out)          :: ub_child     !< Upper bound on the child grid
+    integer, dimension(6), intent(out)          :: lb_child     !< Lower bound on the child grid
+    integer, dimension(6), intent(out)          :: lb_parent    !< Lower bound on the parent grid
+    real, dimension(6),    intent(out)          :: s_child      !< Child  grid position (s_root = 0)
+    real, dimension(6),    intent(out)          :: s_parent     !< Parent grid position (s_root = 0)
+    real, dimension(6),    intent(out)          :: ds_child     !< Child  grid dx (ds_root = 1)
+    real, dimension(6),    intent(out)          :: ds_parent    !< Parent grid dx (ds_root = 1)
+    integer,               intent(out)          :: nbdim        !< Number of dimensions
+    logical,               intent(in)           :: interp       !< .true. if preprocess for interpolation, \n
+                                                                !! .false. if preprocess for update
+!
+    type(Agrif_Variable), pointer :: root_var
+    type(Agrif_Grid),     pointer :: Agrif_Child_Gr
+    type(Agrif_Grid),     pointer :: Agrif_Parent_Gr
+    integer :: n
+!
+    Agrif_Child_Gr  => Agrif_Curgrid
+    Agrif_Parent_Gr => Agrif_Curgrid % parent
+!
+    root_var => child % root_var
+!
+!   Number of dimensions of the current grid
+    nbdim = root_var % nbdim
+!
+    do n = 1,nbdim
+!
+!       Value of interptab(n) can be either x,y,z or N for a no space dimension
+        select case(root_var % interptab(n))
+!
+        case('x')
+!
+            lb_child(n)  = root_var % point(n)
+            lb_parent(n) = root_var % point(n)
+            nb_child(n)  = Agrif_Child_Gr % nb(1)
+            s_child(n)   = Agrif_Child_Gr  % Agrif_x(1)
+            s_parent(n)  = Agrif_Parent_Gr % Agrif_x(1)
+            ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(1)
+            ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(1)
+!
+            if ( root_var % posvar(n) == 1 ) then
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1)
+            else
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1) - 1
+                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
+                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
+            endif
+!
+        case('y')
+!
+            lb_child(n)  = root_var % point(n)
+            lb_parent(n) = root_var % point(n)
+            nb_child(n)  = Agrif_Child_Gr % nb(2)
+            s_child(n)   = Agrif_Child_Gr  % Agrif_x(2)
+            s_parent(n)  = Agrif_Parent_Gr % Agrif_x(2)
+            ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(2)
+            ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(2)
+!
+            if (root_var % posvar(n)==1) then
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2)
+            else
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2) - 1
+                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
+                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
+            endif
+!
+        case('z')
+!
+            lb_child(n)  = root_var % point(n)
+            lb_parent(n) = root_var % point(n)
+            nb_child(n)  = Agrif_Child_Gr % nb(3)
+            s_child(n)   = Agrif_Child_Gr  % Agrif_x(3)
+            s_parent(n)  = Agrif_Parent_Gr % Agrif_x(3)
+            ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(3)
+            ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(3)
+!
+            if (root_var % posvar(n)==1) then
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(3)
+            else
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(3) - 1
+                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
+                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
+            endif
+!
+        case('N') ! No space dimension
+!
+!       The next coefficients are calculated in order to do a simple copy of
+!       values of the grid variable when the interpolation routine is
+!       called for this dimension.
+!
+            if (interp) then
+                call Agrif_get_var_bounds(parent, lb_child(n), ub_child(n), n)
+                nb_child(n) = parent % ub(n) - parent % lb(n)
+            else
+                call Agrif_get_var_bounds(child,  lb_child(n), ub_child(n), n)
+                nb_child(n) = child % ub(n) - child % lb(n)
+            endif
+!
+!           No interpolation but only a copy of the values of the grid variable
+            lb_parent(n) = lb_child(n)
+            s_child(n)   = 0.
+            s_parent(n)  = 0.
+            ds_child(n)  = 1.
+            ds_parent(n) = 1.
+!
+        end select
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine PreProcessToInterpOrUpdate
+!===================================================================================================
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!   subroutine Agrif_GetLocalBoundaries
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_GetLocalBoundaries ( tab1, tab2, coord, lb, ub, deb, fin )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     ::  tab1
+    integer, intent(in)     ::  tab2
+    integer, intent(in)     ::  coord
+    integer, intent(in)     ::  lb, ub
+    integer, intent(out)    ::  deb, fin
+!
+    integer :: imin, imax
+    integer :: i1, i2
+!
+    call Agrif_InvLoc(lb, AGRIF_ProcRank, coord, imin)
+    call Agrif_InvLoc(ub, AGRIF_ProcRank, coord, imax)
+!
+    if ( imin > tab2 ) then
+        i1 = imax - imin
+    else
+        i1 = max(tab1 - imin,0)
+    endif
+!
+    if (imax < tab1) then
+        i2 = -(imax - imin)
+    else
+        i2 = min(tab2 - imax,0)
+    endif
+!
+    deb = lb + i1
+    fin = ub + i2
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_GetLocalBoundaries
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_GlobalToLocalBounds
+!
+!> For a global index located on the current processor, tabarray gives the corresponding local index
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_GlobalToLocalBounds ( locbounds, lb_var, ub_var, lb_glob, ub_glob,    &
+                                       coords, nbdim, rank, member )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(nbdim,2,2), intent(out)   :: locbounds   !< Local values of \b lb_glob and \b ub_glob
+    integer, dimension(nbdim),     intent(in)    :: lb_var      !< Local lower boundary on the current processor
+    integer, dimension(nbdim),     intent(in)    :: ub_var      !< Local upper boundary on the current processor
+    integer, dimension(nbdim),     intent(in)    :: lb_glob     !< Global lower boundary
+    integer, dimension(nbdim),     intent(in)    :: ub_glob     !< Global upper boundary
+    integer, dimension(nbdim),     intent(in)    :: coords
+    integer,                       intent(in)    :: nbdim       !< Dimension of the array
+    integer,                       intent(in)    :: rank        !< Rank of the processor
+    logical,                       intent(out)   :: member
+!
+    integer     :: i, i1, k
+    integer     :: nbloc(nbdim)
+!
+    locbounds(:,1,:) =  HUGE(1)
+    locbounds(:,2,:) = -HUGE(1)
+!
+    nbloc = 0
+!
+    do i = 1,nbdim
+!
+        call Agrif_InvLoc(lb_var(i), rank, coords(i), i1)
+!
+        do k = lb_glob(i)+lb_var(i)-i1,ub_glob(i)+lb_var(i)-i1
+!
+            if ( (k >= lb_var(i)) .AND. (k <= ub_var(i)) ) then
+                nbloc(i) = 1
+                locbounds(i,1,1) = min(locbounds(i,1,1),k-lb_var(i)+i1)
+                locbounds(i,2,1) = max(locbounds(i,2,1),k-lb_var(i)+i1)
+
+                locbounds(i,1,2) = min(locbounds(i,1,2),k)
+                locbounds(i,2,2) = max(locbounds(i,2,2),k)
+            endif
+        enddo
+    enddo
+
+    member = ( sum(nbloc) == nbdim )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_GlobalToLocalBounds
+!===================================================================================================
+#endif
+!
+end module Agrif_Arrays
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F	(revision 5659)
+++ 	(revision )
@@ -1,1337 +1,0 @@
-!
-! $Id$
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Boundary 
-C 
-      Module Agrif_Boundary  
-C
-CCC   Description:
-CCC   Module to calculate the boundary conditions on the child grids from their
-CCC   parent grids.
-C
-C     Modules used:  
-C   
-      Use Agrif_Interpolation        
-C
-      IMPLICIT NONE
-C        
-      CONTAINS   
-C     Define procedures contained in this module
-C
-C
-      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_bc_1d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_bc_1d(TypeInterp,parent,child,tab,deb,fin,
-     &                              weight,pweight,procname)
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid for a 1D 
-CCC   grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      External :: procname
-      Optional :: procname
-      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
-                                            ! lagrange, spline, ... )
-      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child 
-                                            ! grid
-      INTEGER :: deb,fin                    ! Positions where interpolations are
-                                            ! done on the fine grid 
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1) 
-     &    ), Target :: tab ! Values of the grid variable
-      LOGICAL :: pweight                    ! Indicates if weight is used for  
-                                            ! the temporal interpolation 
-      REAL :: weight                        ! Coefficient for the time 
-                                            ! interpolation
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid
-C     variable.   
-C
-      allocate(childtemp % var)  
-C
-      childtemp % var % root_var => child % var % root_var
-C      
-C     Values of the grid variable
-      childtemp % var % parray1 => tab  
-C
-C     Temporary results for the time interpolation before and after the space 
-C     interpolation 
-      childtemp % var % oldvalues2D => child % var % oldvalues2D
-C 
-C     Index indicating if a space interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &                 child % var % Interpolationshouldbemade   
-      childtemp % var % list_interp => child % var% list_interp 
-      
-      childtemp % var% lb = child % var % lb
-      childtemp % var% ub = child % var % ub         
-C
-C     Call to the procedure for the calculations of the boundary conditions
-      IF (present(procname)) THEN
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
-      ELSE
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
-      ENDIF
-
-C   
-      child % var % oldvalues2D => childtemp % var % oldvalues2D
-      child % var % list_interp => childtemp % var %list_interp
-C         
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_bc_1D
-C
-      
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_bc_2d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_bc_2d(TypeInterp,parent,child,tab,deb,fin,
-     &                              weight,pweight,procname)
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid for a 2D 
-CCC   grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      External :: procname
-      Optional :: procname
-      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
-                                            ! lagrange, spline, ... )
-      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child 
-                                            ! grid
-      INTEGER :: deb,fin                    ! Positions where interpolations are
-                                            ! done on the fine grid 
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2) 
-     &    ), Target :: tab ! Values of the grid variable
-      LOGICAL :: pweight                    ! Indicates if weight is used for  
-                                            ! the temporal interpolation 
-      REAL :: weight                        ! Coefficient for the time 
-                                            ! interpolation
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid
-C     variable.   
-C
-      allocate(childtemp % var)  
-C
-      childtemp % var % root_var => child % var % root_var
-C      
-C     Values of the grid variable
-      childtemp % var % parray2 => tab  
-C
-C     Temporary results for the time interpolation before and after the space 
-C     interpolation 
-      childtemp % var % oldvalues2D => child % var % oldvalues2D
-C 
-C     Index indicating if a space interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &                 child % var % Interpolationshouldbemade   
-      childtemp % var % list_interp => child % var% list_interp 
-      
-      childtemp % var% lb = child % var % lb
-      childtemp % var% ub = child % var % ub         
-C
-C     Call to the procedure for the calculations of the boundary conditions
-      IF (present(procname)) THEN
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
-      ELSE
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
-      ENDIF
-
-C   
-      child % var % oldvalues2D => childtemp % var % oldvalues2D
-      child % var % list_interp => childtemp % var %list_interp
-C         
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_bc_2D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_bc_3d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_bc_3d(TypeInterp,parent,child,tab,deb,fin,
-     &                              weight,pweight,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid for a 3D 
-CCC   variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments 
-      External :: procname
-      Optional :: procname     
-      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
-                                            ! lagrange, spline, ... )
-      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child
-                                            ! grid
-      INTEGER :: deb,fin                    ! Positions where interpolations 
-                                            ! are done on the fine grid 
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3)
-     &         ), Target :: tab ! Values of the grid variable
-      LOGICAL :: pweight                    ! Indicates if weight is used for 
-                                            ! the temporal interpolation 
-      REAL :: weight                        ! Coefficient for the time 
-                                            ! interpolation
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
-C     variable.  
-C
-      allocate(childtemp % var)  
-C
-      childtemp % var % root_var => child % var % root_var       
-C      
-C     Values of the grid variable
-      childtemp % var % parray3 => tab
-C
-C     Temporary results for the time interpolation before and after the space 
-C     interpolation  
-      childtemp % var % oldvalues2D => child % var % oldvalues2D
-C 
-C     Index indicating if a space interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex
-      childtemp % var % Interpolationshouldbemade = 
-     &                 child % var % Interpolationshouldbemade 
-      childtemp % var % list_interp => child % var% list_interp 
-      
-      childtemp % var% lb = child % var % lb
-      childtemp % var% ub = child % var % ub
-C
-C     Call to the procedure for the calculations of the boundary conditions     
-      IF (present(procname)) THEN
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
-      ELSE
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
-      ENDIF
-C
-      child % var % oldvalues2D => childtemp % var % oldvalues2D
-      child % var % list_interp => childtemp % var %list_interp      
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_bc_3D               
-C
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_bc_4d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_bc_4d(TypeInterp,parent,child,tab,deb,fin,
-     &                             weight,pweight,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid for a 4D 
-CCC   grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      External :: procname
-      Optional :: procname     
-      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
-                                              ! lagrange, spline, ... )
-      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
-                                              ! grid
-      INTEGER :: deb,fin                      ! Positions where interpolations 
-                                              ! are done on the fine grid 
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4)
-     &        ), Target :: tab ! Values of the grid variable
-      LOGICAL :: pweight                      ! Indicates if weight is used for 
-                                              ! the temporal interpolation 
-      REAL :: weight                          ! Coefficient for the time 
-                                              ! interpolation
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
-C     variable.  
-C
-      allocate(childtemp % var)  
-C
-      childtemp % var % root_var => child % var % root_var 
-C      
-C     Values of the grid variable
-      childtemp % var % parray4 => tab  
-C
-C     Temporary results for the time interpolation before and after the space 
-C     interpolation       
-      childtemp % var % oldvalues2D => child % var % oldvalues2D
-C 
-C     Index indicating if a space interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &                 child % var % Interpolationshouldbemade  
-      childtemp % var % list_interp => child % var% list_interp 
-      
-      childtemp % var% lb = child % var % lb
-      childtemp % var% ub = child % var % ub               
-C
-C     Call to the procedure for the calculations of the boundary conditions
-      IF (present(procname)) THEN
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
-      ELSE
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
-      ENDIF
-C
-      child % var % oldvalues2D => childtemp % var % oldvalues2D
-      child % var % list_interp => childtemp % var %list_interp      
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_bc_4D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_bc_5d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_bc_5d(TypeInterp,parent,child,tab,deb,fin,
-     &                             weight,pweight,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid for a 5D 
-CCC   grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      External :: procname
-      Optional :: procname     
-      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
-                                              ! lagrange, spline, ... )
-      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
-                                              ! grid
-      INTEGER :: deb,fin                      ! Positions where interpolations 
-                                              ! are done on the fine grid 
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4),
-     &         child%var%lb(5):child%var%ub(5)
-     &         ), Target :: tab ! Values of the grid variable
-      LOGICAL :: pweight                      ! Indicates if weight is used for 
-                                              ! the temporal interpolation 
-      REAL :: weight                          ! Coefficient for the time 
-                                              ! interpolation
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
-C     variable.  
-C
-      allocate(childtemp % var)  
-C
-      childtemp % var % root_var => child % var % root_var 
-C      
-C     Values of the grid variable
-      childtemp % var % parray5 => tab  
-C
-C     Temporary results for the time interpolation before and after the space 
-C     interpolation       
-      childtemp % var % oldvalues2D => child % var % oldvalues2D
-C 
-C     Index indicating if a space interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &                 child % var % Interpolationshouldbemade 
-      childtemp % var % list_interp => child % var% list_interp  
-      
-      childtemp % var% lb = child % var % lb
-      childtemp % var% ub = child % var % ub
-                     
-C
-C     Call to the procedure for the calculations of the boundary conditions  
-      IF (present(procname)) THEN
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
-      ELSE
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
-      ENDIF
-C
-      child % var % oldvalues2D => childtemp % var % oldvalues2D
-      child % var % list_interp => childtemp % var %list_interp      
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_bc_5D
-C
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_bc_6d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_bc_6d(TypeInterp,parent,child,tab,deb,fin,
-     &                             weight,pweight)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid for a 6D 
-CCC   grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
-                                              ! lagrange, spline, ... )
-      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
-                                              ! grid
-      INTEGER :: deb,fin                      ! Positions where interpolations 
-                                              ! are done on the fine grid 
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4),
-     &         child%var%lb(5):child%var%ub(5),
-     &         child%var%lb(6):child%var%ub(6)
-     &         ), Target :: tab ! Values of the grid variable
-      LOGICAL :: pweight                      ! Indicates if weight is used for 
-                                              ! the temporal interpolation 
-      REAL :: weight                          ! Coefficient for the time 
-                                              ! interpolation
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
-C     variable.  
-C
-      allocate(childtemp % var)  
-C
-      childtemp % var % root_var => child % var % root_var 
-C      
-C     Values of the grid variable
-      childtemp % var % parray6 => tab  
-C
-C     Temporary results for the time interpolation before and after the space 
-C     interpolation       
-      childtemp % var % oldvalues2D => child % var % oldvalues2D
-C 
-C     Index indicating if a space interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &                 child % var % Interpolationshouldbemade 
-      childtemp % var % list_interp => child % var% list_interp  
-      
-      childtemp % var% lb = child % var % lb
-      childtemp % var% ub = child % var % ub               
-C
-C     Call to the procedure for the calculations of the boundary conditions
-      Call Agrif_CorrectVariable
-     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
-C
-      child % var % oldvalues2D => childtemp % var % oldvalues2D
-      child % var % list_interp => childtemp % var %list_interp      
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_bc_6D
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_CorrectVariable
-C     **************************************************************************
-C
-      Subroutine AGRIF_CorrectVariable(TypeInterp,parent,child,deb,fin,
-     &                                 pweight,weight,procname)
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions on a fine grid.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments
-      External :: procname
-      Optional :: procname
-      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
-      INTEGER,DIMENSION(6,6)  :: TypeInterp     ! TYPE of interpolation
-                                              !    (linear,lagrange,...)
-      INTEGER               :: deb,fin        ! Positions where boundary
-                                              !    conditions are calculated
-      LOGICAL               :: pweight        ! Indicates if weight is used 
-                                              !    for the time interpolation 
-      REAL                  :: weight         ! Coefficient for the time
-                                              !    interpolation
-C
-C     Local scalars
-      TYPE(Agrif_Grid)    , Pointer :: Agrif_Child_Gr,Agrif_Parent_Gr
-      TYPE(AGRIF_Variable), Pointer :: root   ! Variable on the root grid
-      INTEGER                       :: nbdim  ! Number of dimensions of 
-                                              !    the grid variable 
-      INTEGER                       :: n
-      INTEGER,DIMENSION(6)          :: pttab_child  ! Index of the first point
-                                                    !    inside the domain for
-                                                    !    the child grid variable
-      INTEGER,DIMENSION(6)          :: pttab_parent ! Index of the first point
-                                                    !    inside the domain for
-                                                    !    the parent grid
-                                                    !    variable
-      INTEGER,DIMENSION(6)          :: nbtab_Child  ! Number of the cells
-      INTEGER,DIMENSION(6)          :: posvartab_Child    ! Position of the
-                                                    !    variable on the cell 
-      INTEGER,DIMENSION(6)          :: loctab_Child ! Indicates if the child
-                                                    !    grid has a common
-                                                    !    border with the root
-                                                    !    grid      
-      REAL, DIMENSION(6)            :: s_child,s_parent   ! Positions of the
-                                                    !    parent and child grids
-      REAL, DIMENSION(6)            :: ds_child,ds_parent ! Space steps of the
-                                                    !    parent and child grids 
-C
-C
-      loctab_child(:) = 0
-C
-      Agrif_Child_Gr => Agrif_Curgrid
-      Agrif_Parent_Gr => Agrif_Curgrid % parent
-      root => child % var % root_var 
-      nbdim = root % nbdim
-C
-      do n = 1,nbdim
-        posvartab_child(n) = root % posvar(n)      
-      enddo
-C
-C
-      do n = 1,nbdim
-C
-        Select case(root % interptab(n))
-C
-          case('x') ! x DIMENSION
-C
-            nbtab_Child(n) = Agrif_Child_Gr % nb(1)
-            pttab_Child(n) = root % point(1)
-            pttab_Parent(n) = root % point(1)
-            s_Child(n) = Agrif_Child_Gr % Agrif_x(1)
-            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(1)
-            ds_Child(n) = Agrif_Child_Gr % Agrif_d(1)
-            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(1)
-            if (root % posvar(n) == 2) then
-                s_Child(n) = s_Child(n) + ds_Child(n)/2.
-                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
-            endif
-C
-            if (Agrif_CURGRID % NearRootBorder(1)) 
-     &         loctab_child(n) = -1
-            if (Agrif_CURGRID % DistantRootBorder(1))
-     &         loctab_child(n) = -2
-            if ((Agrif_CURGRID % NearRootBorder(1)) .AND. 
-     &          (Agrif_CURGRID % DistantRootBorder(1))) 
-     &         loctab_child(n) = -3
-C
-          case('y') ! y DIMENSION      
-C
-            nbtab_Child(n) = Agrif_Child_Gr % nb(2)
-            pttab_Child(n) = root % point(2)
-            pttab_Parent(n) = root % point(2)
-            s_Child(n) = Agrif_Child_Gr % Agrif_x(2)
-            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(2) 
-            ds_Child(n) = Agrif_Child_Gr % Agrif_d(2)
-            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(2)
-            if (root % posvar(n) == 2) then        
-                s_Child(n) = s_Child(n) + ds_Child(n)/2.
-                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
-            endif        
-C
-            if (Agrif_CURGRID % NearRootBorder(2)) 
-     &         loctab_child(n) = -1
-            if (Agrif_CURGRID % DistantRootBorder(2)) 
-     &         loctab_child(n) = -2
-            if ((Agrif_CURGRID % NearRootBorder(2)) .AND. 
-     &          (Agrif_CURGRID % DistantRootBorder(2))) 
-     &         loctab_child(n) = -3
-C
-          case('z') ! z DIMENSION
-C
-            nbtab_Child(n) = Agrif_Child_Gr % nb(3)
-            pttab_Child(n) = root % point(3)
-            pttab_Parent(n) = root % point(3)
-            s_Child(n) = Agrif_Child_Gr % Agrif_x(3)
-            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(3)
-            ds_Child(n) = Agrif_Child_Gr % Agrif_d(3)
-            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(3)
-            if (root % posvar(n) == 2) then        
-                s_Child(n) = s_Child(n) + ds_Child(n)/2.
-                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
-            endif        
-C
-            if (Agrif_CURGRID % NearRootBorder(3)) 
-     &         loctab_child(n) = -1
-            if (Agrif_CURGRID % DistantRootBorder(3)) 
-     &         loctab_child(n) = -2
-            if ((Agrif_CURGRID % NearRootBorder(3)) .AND. 
-     &          (Agrif_CURGRID % DistantRootBorder(3))) 
-     &         loctab_child(n) = -3
-C
-          case('N') ! No space DIMENSION      
-C
-            nbtab_Child(n) = child % var % ub(n) - child % var % lb(n)
-            pttab_Child(n) = child % var % lb(n)
-C
-C           No interpolation but only a copy of the values of the grid variable
-C      
-            posvartab_child(n) = 1
-            pttab_Parent(n)= pttab_Child(n)
-            s_Child(n)=0.
-            s_Parent(n)=0. 
-            ds_Child(n)=1.
-            ds_Parent(n)=1.
-            loctab_child(n) = -3
-C
-        End select
-C
-      enddo
-C
-         IF (present(procname)) THEN
-          Call AGRIF_CorrectnD
-     &         (TypeInterp,parent,child,deb,fin,pweight,weight,
-     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
-     &          loctab_Child(1:nbdim),
-     &          s_Child(1:nbdim),s_Parent(1:nbdim),
-     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)
-        ELSE
-          Call AGRIF_CorrectnD
-     &         (TypeInterp,parent,child,deb,fin,pweight,weight,
-     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
-     &          loctab_Child(1:nbdim),
-     &          s_Child(1:nbdim),s_Parent(1:nbdim),
-     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
-         ENDIF
-C
-C
-      End subroutine AGRIF_CorrectVariable
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Correctnd
-C     **************************************************************************
-C
-      Subroutine AGRIF_Correctnd(TypeInterp,parent,child,deb,fin,
-     &                           pweight,weight,
-     &                           pttab_child,pttab_Parent,
-     &                           nbtab_Child,posvartab_Child,
-     &                           loctab_Child,
-     &                           s_Child,s_Parent,
-     &                           ds_Child,ds_Parent,nbdim,procname)
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions for a nD grid variable on 
-CCC   a fine grid by using a space and time interpolations; it is called by the 
-CCC   Agrif_CorrectVariable procedure.
-C
-C
-C     Declarations:
-C
-      
-C
-#ifdef key_mpp_mpi
-C
-      INCLUDE 'mpif.h'
-C
-#endif
-C
-C     Arguments
-      External :: procname
-      Optional :: procname
-      INTEGER,DIMENSION(6,6) :: TypeInterp ! TYPE of interpolation (linear, 
-                                         !   spline,...)  
-      TYPE(AGRIF_PVariable)    :: parent ! Variable on the parent grid
-      TYPE(AGRIF_PVariable)    :: child  ! Variable on the child grid 
-      INTEGER                  :: deb,fin ! Positions where interpolations 
-                                         !    are done
-      LOGICAL                  :: pweight ! Indicates if weight is used for 
-                                         !    the temporal interpolation
-      REAL                     :: weight ! Coefficient for the temporal
-                                         !    interpolation
-      INTEGER                  :: nbdim  ! Number of dimensions of the grid
-                                         !    variable
-      INTEGER,DIMENSION(nbdim) :: pttab_child ! Index of the first point inside
-                                         !    the domain for the parent 
-                                         !    grid variable
-      INTEGER,DIMENSION(nbdim) :: pttab_Parent ! Index of the first point 
-                                         !   inside the domain for the 
-                                         !   child grid variable
-      INTEGER,DIMENSION(nbdim) :: nbtab_Child ! Number of cells of the child
-                                         !    grid
-      INTEGER,DIMENSION(nbdim) :: posvartab_Child ! Position of the grid
-                                         !    variable (1 or 2)
-      INTEGER,DIMENSION(nbdim) :: loctab_Child ! Indicates if the child 
-                                        !    grid has a common border with 
-                                        !    the root grid
-      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent ! Positions of the parent 
-                                        !   and child grids 
-      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the 
-                                        !    parent and child grids
-C
-C     Local variables
-      TYPE(AGRIF_PVariable)        :: restore ! Variable on the parent     
-      INTEGER,DIMENSION(nbdim,2)   :: lubglob
-      INTEGER                      :: i          
-      INTEGER                      :: kindex  ! Index used for safeguard 
-                                       !    and time interpolation
-      INTEGER,DIMENSION(nbdim,2,2) :: indtab ! Arrays indicating the limits 
-                                       !    of the child     
-      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab ! grid variable where 
-                                       !   boundary conditions are 
-      INTEGER,DIMENSION(nbdim,2,2,nbdim)   :: ptres,ptres2 ! calculated
-      INTEGER                      :: nb,ndir,n,sizetab(1)
-      REAL, DIMENSION(:), Allocatable :: tab ! Array used for the interpolation
-      REAL    :: c1t,c2t               ! Coefficients for the time interpolation
-                                       !    (c2t=1-c1t) 
-C
-#ifdef key_mpp_mpi
-C
-      INTEGER,DIMENSION(nbdim)   :: lower,upper
-      INTEGER,DIMENSION(nbdim)   :: ltab,utab
-      INTEGER,DIMENSION(nbdim)   :: lb,ub
-      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
-      INTEGER                    :: code
-C
-#endif            
-C      
-C
-      indtab(1:nbdim,2,1) = pttab_child(1:nbdim) + nbtab_child(1:nbdim)
-     &          + deb
-      indtab(1:nbdim,2,2) = indtab(1:nbdim,2,1) + ( fin - deb )
-       
-      indtab(1:nbdim,1,1) = pttab_child(1:nbdim) - fin
-      indtab(1:nbdim,1,2) = pttab_child(1:nbdim) - deb
-                  
-      WHERE (posvartab_child(1:nbdim) == 2)
-        indtab(1:nbdim,1,1) = indtab(1:nbdim,1,1) - 1
-        indtab(1:nbdim,1,2) = indtab(1:nbdim,1,2) - 1
-      END WHERE
-      
-
-#if !defined key_mpp_mpi
-      Call Agrif_nbdim_Get_bound_dimension(child%var,lubglob(:,1),
-     &              lubglob(:,2),nbdim)
-C
-#else
-C     
-      Call Agrif_nbdim_Get_bound_dimension(child%var,lb,ub,nbdim)
-      
-      DO i = 1,nbdim
-C
-        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
-        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
-C
-      ENDDO
-C
-      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
-      
-      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
-     &                     MPI_COMM_AGRIF,code)  
-     
-      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
-C
-#endif 
-C     
-      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
-     &     lubglob(1:nbdim,1))
-      indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),
-     &     lubglob(1:nbdim,1))
-      indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),
-     &     lubglob(1:nbdim,2))
-      indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),
-     &     lubglob(1:nbdim,2))
-
-                              
-C 
-C
-      do nb = 1,nbdim
-C
-        do ndir = 1,2      
-C
-          if (loctab_child(nb) /= (-ndir) 
-     &        .AND. loctab_child(nb) /= -3) then
-C           
-              do n = 1,2
-C
-                ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)  
-C
-              enddo              
-C
-              do i = 1,nbdim
-C     
-                if (i .NE. nb) then      
-C
-                    if (loctab_child(i) == -1 
-     &                                 .OR. loctab_child(i) == -3) then
-C
-                        ptres(i,1,ndir,nb) = pttab_child(i)
-C
-                      else
-C
-                        ptres(i,1,ndir,nb) = indtruetab(i,1,1)
-C
-                    endif
-C
-                    if (loctab_child(i) == -2 
-     &                                 .OR. loctab_child(i) == -3) then
-C
-                        if (posvartab_child(i) == 1) then
-C
-                            ptres(i,2,ndir,nb) = pttab_child(i)
-     &                                                 + nbtab_child(i)
-C
-                          else
-C
-                            ptres(i,2,ndir,nb) = pttab_child(i)
-     &                                             + nbtab_child(i) - 1
-C
-                        endif                             
-C
-                      else
-C
-                        ptres(i,2,ndir,nb) = indtruetab(i,2,2)
-C
-                    endif                        
-C      
-                endif
-C      
-              enddo
-      
-C
-#if defined key_mpp_mpi
-                 Call Agrif_nbdim_Get_bound_dimension
-     &                    (child%var,lower,upper,nbdim)
-
-              do i = 1,nbdim
-C
-                 Call GetLocalBoundaries(ptres(i,1,ndir,nb),
-     &                                  ptres(i,2,ndir,nb),i,
-     &                                  lower(i),upper(i),
-     &                                  ltab(i),utab(i))
-                 ptres2(i,1,ndir,nb) = max(ltab(i),lower(i)) 
-                 ptres2(i,2,ndir,nb) = min(utab(i),upper(i))
-                 if ((i == nb) .AND. (ndir == 1)) then 
-                     ptres2(i,2,ndir,nb) = max(utab(i),lower(i))
-                 elseif ((i == nb) .AND. (ndir == 2)) then
-                     ptres2(i,1,ndir,nb) = min(ltab(i),upper(i)) 
-                 endif
-C
-              enddo
-#else
-              ptres2(:,:,ndir,nb) = ptres(:,:,ndir,nb)
-#endif      
-            
-        endif
-      
-        enddo
-       enddo
-C
-      if (child % var % interpIndex 
-     &        /= Agrif_Curgrid % parent % ngridstep .OR.
-     &    child%var%Interpolationshouldbemade ) then
-C
-C     Space interpolation 
-C      
-      kindex = 1    
-      
-
-C
-      do nb = 1,nbdim
-C
-        do ndir = 1,2
-C
-          if (loctab_child(nb) /= (-ndir) 
-     &        .AND. loctab_child(nb) /= -3) then  
-C
-              IF (present(procname)) THEN
-              Call Agrif_InterpnD
-     &             (TYPEInterp(nb,:),parent,child,
-     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
-     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
-     &              s_Child(1:nbdim),s_Parent(1:nbdim),
-     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &              restore,.FALSE.,nbdim,procname)
-              ELSE
-              Call Agrif_InterpnD              
-     &             (TYPEInterp(nb,:),parent,child,
-     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
-     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
-     &              s_Child(1:nbdim),s_Parent(1:nbdim),
-     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &              restore,.FALSE.,nbdim)
-              ENDIF
-     
-              IF (.NOT. child%var%interpolationshouldbemade) THEN
-C     
-C             Safeguard of the values of the grid variable (at times n and n+1
-C                on the parent grid)
-C      
-              sizetab(1) = 1
-C
-              do i = 1,nbdim
-C          
-                sizetab(1) = sizetab(1)
-     &              * (ptres2(i,2,ndir,nb)-ptres2(i,1,ndir,nb)+1)
-C      
-              enddo
-
-              Call saveAfterInterp(child,
-     &           ptres2(:,:,ndir,nb),kindex,sizetab(1),nbdim)
-C
-           ENDIF
-C
-          endif
-C
-        enddo       
-C
-      enddo     
-C
-C
-      child % var % interpIndex = Agrif_Curgrid % parent % ngridstep
-C
-C
-      endif  
-      
-              IF (.NOT. child%var%interpolationshouldbemade) THEN
-C
-C
-C     Calculation of the coefficients c1t and c2t for the temporary
-C        interpolation
-      if (pweight) then
-C
-          c1t = weight
-C
-        else
-C
-          c1t = (REAL(AGRIF_Nbstepint()) + 1.) / Agrif_Rhot()
-C
-      endif
-C                                  
-      c2t = 1. - c1t
-C           
-C     Time interpolation
-C
-      kindex = 1
-C
-      do nb = 1,nbdim
-C
-        do ndir = 1,2      
-C
-          if (loctab_child(nb) /= (-ndir) 
-     &        .AND. loctab_child(nb) /= -3) then
-
-              Call timeInterpolation
-     &             (child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim)
-          endif
-C
-        enddo
-C      
-      enddo
-C      
-
-       ENDIF
-C  
-      End Subroutine Agrif_Correctnd
-C
-C
-C     **************************************************************************
-CCC   Subroutine saveAfterInterp
-C     **************************************************************************
-C
-      Subroutine saveAfterInterp(child,bounds,kindex,newsize,nbdim)
-C
-CCC   Descritpion:
-CCC   Subroutine used to save the values of the grid variable on the fine grid 
-CCC   after the space interpolation. 
-C
-C     Declarations:
-C
-      
-C
-C     argument
-      TYPE (AGRIF_PVariable) :: child   ! The fine grid variable
-      INTEGER                :: kindex  ! Index indicating where this safeguard 
-                                        ! is done on the fine grid
-      INTEGER :: nbdim, newsize
-      INTEGER,DIMENSION(nbdim,2) :: bounds
-C
-C     Local scalars
-      INTEGER                      :: ir,jr,kr,lr,mr,nr
-C
-C
-C     Allocation of the array oldvalues2d
-
-C
-      if (newsize .LE. 0) return
-C
-      Call Agrif_Checksize
-     &     (child,kindex+newsize)  
-
-      if (child % var % interpIndex 
-     &        /= Agrif_Curgrid % parent % ngridstep ) then
-       child%var%oldvalues2d(1,kindex:kindex+newsize-1)=
-     &        child%var%oldvalues2d(2,kindex:kindex+newsize-1)
-      endif
-
-      SELECT CASE (nbdim)
-      CASE (1)
-
-!CDIR ALTCODE
-         do ir=bounds(1,1),bounds(1,2)
-            child%var%oldvalues2d(2,kindex) =
-     &           child%var%parray1(ir)
-            kindex = kindex + 1
-         enddo       
-C
-      CASE (2)
-
-        do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-           do ir=bounds(1,1),bounds(1,2)
-            child%var%oldvalues2d(2,kindex) =
-     &           child%var%parray2(ir,jr)
-            kindex = kindex + 1
-           enddo
-         enddo      
-C
-      CASE (3)
-        do kr=bounds(3,1),bounds(3,2)
-          do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-             do ir=bounds(1,1),bounds(1,2)
-            child%var%oldvalues2d(2,kindex) =
-     &           child%var%parray3(ir,jr,kr)
-            kindex = kindex + 1
-             enddo
-           enddo
-         enddo       
-C
-      CASE (4)
-          do lr=bounds(4,1),bounds(4,2)
-           do kr=bounds(3,1),bounds(3,2)
-             do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-               do ir=bounds(1,1),bounds(1,2)
-            child%var%oldvalues2d(2,kindex) =
-     &           child%var%parray4(ir,jr,kr,lr)
-            kindex = kindex + 1
-               enddo
-             enddo
-           enddo
-         enddo         
-C
-      CASE (5)
-         do mr=bounds(5,1),bounds(5,2)
-           do lr=bounds(4,1),bounds(4,2)
-            do kr=bounds(3,1),bounds(3,2) 
-              do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-                 do ir=bounds(1,1),bounds(1,2)
-            child%var%oldvalues2d(2,kindex) =
-     &           child%var%parray5(ir,jr,kr,lr,mr)
-            kindex = kindex + 1
-                 enddo
-               enddo
-             enddo
-           enddo
-         enddo   
-C
-      CASE (6)
-        do nr=bounds(6,1),bounds(6,2)
-           do mr=bounds(5,1),bounds(5,2)
-             do lr=bounds(4,1),bounds(4,2)
-               do kr=bounds(3,1),bounds(3,2)
-                do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-                   do ir=bounds(1,1),bounds(1,2)
-            child%var%oldvalues2d(2,kindex) =
-     &           child%var%parray6(ir,jr,kr,lr,mr,nr)
-            kindex = kindex + 1
-                   enddo
-                 enddo
-               enddo
-             enddo
-           enddo
-         enddo       
-      END SELECT
-C
-C                                                  
-      End subroutine saveAfterInterp
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine timeInterpolation
-C     **************************************************************************
-C
-      Subroutine timeInterpolation(child,bounds,kindex,c1t,c2t,nbdim) 
-C
-CCC   Descritpion:
-CCC   Subroutine for a linear time interpolation on the child grid. 
-C
-C     Declarations:
-C
-      
-C
-C     argument
-      TYPE (AGRIF_PVariable) :: child  ! The fine grid variable
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim,2) :: bounds
-      INTEGER                :: kindex ! Index indicating the values of the fine
-                                       ! grid got before and after the space 
-                                       ! interpolation and used for the time 
-                                       ! interpolation
-      REAL                   :: c1t,c2t! coefficients for the time interpolation
-                                       ! (c2t=1-c1t)  
-C
-C     Local aruments      
-      INTEGER :: i
-C     Local scalars
-      INTEGER                      :: ir,jr,kr,lr,mr,nr      
-C
-C
-      
-      SELECT CASE (nbdim)
-      CASE (1)
-
-!CDIR ALTCODE
-         do ir=bounds(1,1),bounds(1,2)
-                child%var%parray1(ir) =
-     &           c2t*child % var % oldvalues2d(1,kindex)   
-     &         + c1t*child % var % oldvalues2d(2,kindex)    
-            kindex = kindex + 1
-         enddo       
-C
-      CASE (2)
-
-        do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-           do ir=bounds(1,1),bounds(1,2)
-                child%var%parray2(ir,jr) =
-     &           c2t*child % var % oldvalues2d(1,kindex)   
-     &         + c1t*child % var % oldvalues2d(2,kindex) 
-            kindex = kindex + 1
-           enddo
-         enddo      
-C
-      CASE (3)
-        do kr=bounds(3,1),bounds(3,2)
-          do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-             do ir=bounds(1,1),bounds(1,2)
-                child%var%parray3(ir,jr,kr) =
-     &           c2t*child % var % oldvalues2d(1,kindex)   
-     &         + c1t*child % var % oldvalues2d(2,kindex) 
-            kindex = kindex + 1
-             enddo
-           enddo
-         enddo       
-C
-      CASE (4)
-          do lr=bounds(4,1),bounds(4,2)
-           do kr=bounds(3,1),bounds(3,2)
-             do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-               do ir=bounds(1,1),bounds(1,2)
-                child%var%parray4(ir,jr,kr,lr) =
-     &           c2t*child % var % oldvalues2d(1,kindex)   
-     &         + c1t*child % var % oldvalues2d(2,kindex) 
-            kindex = kindex + 1
-               enddo
-             enddo
-           enddo
-         enddo         
-C
-      CASE (5)
-         do mr=bounds(5,1),bounds(5,2)
-           do lr=bounds(4,1),bounds(4,2)
-            do kr=bounds(3,1),bounds(3,2) 
-              do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-                 do ir=bounds(1,1),bounds(1,2)
-                child%var%parray5(ir,jr,kr,lr,mr) =
-     &           c2t*child % var % oldvalues2d(1,kindex)   
-     &         + c1t*child % var % oldvalues2d(2,kindex) 
-            kindex = kindex + 1
-                 enddo
-               enddo
-             enddo
-           enddo
-         enddo   
-C
-      CASE (6)
-        do nr=bounds(6,1),bounds(6,2)
-           do mr=bounds(5,1),bounds(5,2)
-             do lr=bounds(4,1),bounds(4,2)
-               do kr=bounds(3,1),bounds(3,2)
-                do jr=bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-                   do ir=bounds(1,1),bounds(1,2)
-                child%var%parray6(ir,jr,kr,lr,mr,nr) =
-     &           c2t*child % var % oldvalues2d(1,kindex)   
-     &         + c1t*child % var % oldvalues2d(2,kindex) 
-            kindex = kindex + 1
-                   enddo
-                 enddo
-               enddo
-             enddo
-           enddo
-         enddo       
-      END SELECT
-                                                   
-C
-C
-      End subroutine timeInterpolation      
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Checksize
-C     **************************************************************************
-C
-      Subroutine Agrif_Checksize(child,newsize)
-C
-CCC   Descritpion:
-CCC   Subroutine used in the saveAfterInterp procedure to allocate the 
-CCC   oldvalues2d array. 
-C
-C     Declarations:
-C
-      
-C      
-C     TYPE argument
-      TYPE (AGRIF_PVariable) :: child  ! The fine grid variable
-C 
-C     Scalar arguments
-      INTEGER :: newsize               ! Size of the domains where the boundary 
-                                       ! conditions are calculated  
-C
-C     Local arrays
-      REAL, DIMENSION(:,:), Allocatable :: tempoldvalues ! Temporary array
-C                
-C
-      if (.NOT. associated(child % var % oldvalues2d)) then
-C
-          allocate(child % var % oldvalues2d(2,newsize))
-C  
-          child % var % oldvalues2d=0.
-C
-        else
-C
-          if (SIZE(child % var % oldvalues2d,2) < newsize) then   
-C
-              allocate(tempoldvalues(2,SIZE(child % var %
-     &                                    oldvalues2d,2)))
-C
-              tempoldvalues = child % var % oldvalues2d
-C
-              deallocate(child % var % oldvalues2d)
-C
-              allocate(child % var % oldvalues2d(2,newsize))
-C            
-              child%var%oldvalues2d=0.
-C
-              child % var % oldvalues2d(:,1:SIZE(tempoldvalues,2)) = 
-     &        tempoldvalues(:,:)
-C
-              deallocate(tempoldvalues)
-C
-          endif 
-C
-      endif                                                    
-C
-C
-      End  Subroutine Agrif_Checksize
-C
-C
-C
-C      
-      End Module AGRIF_boundary
-
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90	(revision 5682)
@@ -0,0 +1,649 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Boundary.
+!>
+!> Contains subroutines to calculate the boundary conditions on the child grids from their
+!> parent grids.
+!
+module Agrif_Boundary
+!
+    use Agrif_Interpolation
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_CorrectVariable
+!
+!> subroutine to calculate the boundary conditions on a fine grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CorrectVariable ( parent, child, pweight, weight, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer       :: parent       !< Variable on the parent grid
+    type(Agrif_Variable), pointer       :: child        !< Variable on the child grid
+    logical                             :: pweight      !< Indicates if weight is used for the time interpolation
+    real                                :: weight       !< Coefficient for the time interpolation
+    procedure()                         :: procname     !< Data recovery procedure
+!
+    type(Agrif_Grid)    , pointer :: Agrif_Child_Gr, Agrif_Parent_Gr
+    type(Agrif_Variable), pointer :: root_var   ! Variable on the root grid
+    integer                :: nbdim  ! Number of dimensions of the grid variable
+    integer                :: n
+    integer, dimension(6)  :: lb_child       ! Index of the first point inside the domain for
+                                                !    the child grid variable
+    integer, dimension(6)  :: lb_parent      ! Index of the first point inside the domain for
+                                                !    the parent grid variable
+    integer, dimension(6)  :: ub_child     !  Upper bound on the child grid
+    integer, dimension(6)  :: nb_child       ! Number of cells for child
+    integer, dimension(6)  :: posvartab_child   ! Position of the variable on the cell
+    integer, dimension(6)  :: loctab_child      ! Indicates if the child grid has a common border
+                                                !    with the root grid
+    real, dimension(6)     :: s_child, s_parent   ! Positions of the parent and child grids
+    real, dimension(6)     :: ds_child, ds_parent ! Space steps of the parent and child grids
+!
+    call PreProcessToInterpOrUpdate( parent,   child,       &
+                                     nb_child, ub_child,    &
+                                     lb_child, lb_parent,   &
+                                      s_child,  s_parent,   &
+                                     ds_child, ds_parent, nbdim, interp=.true.)
+    root_var => child % root_var
+    Agrif_Child_Gr => Agrif_Curgrid
+    Agrif_Parent_Gr => Agrif_Curgrid % parent
+!
+    loctab_child(:) = 0
+    posvartab_child(1:nbdim) = root_var % posvar(1:nbdim)
+!
+    do n = 1,nbdim
+!
+        select case(root_var % interptab(n))
+!
+        case('x') ! x DIMENSION
+!
+            if (Agrif_Curgrid % NearRootBorder(1))      loctab_child(n) = -1
+            if (Agrif_Curgrid % DistantRootBorder(1))   loctab_child(n) = -2
+            if ((Agrif_Curgrid % NearRootBorder(1)) .AND. &
+                (Agrif_Curgrid % DistantRootBorder(1))) loctab_child(n) = -3
+!
+        case('y') ! y DIMENSION
+!
+            if (Agrif_Curgrid % NearRootBorder(2))      loctab_child(n) = -1
+            if (Agrif_Curgrid % DistantRootBorder(2))   loctab_child(n) = -2
+            if ((Agrif_Curgrid % NearRootBorder(2)) .AND. &
+                (Agrif_Curgrid % DistantRootBorder(2))) loctab_child(n) = -3
+!
+        case('z') ! z DIMENSION
+!
+            if (Agrif_Curgrid % NearRootBorder(3))      loctab_child(n) = -1
+            if (Agrif_Curgrid % DistantRootBorder(3))   loctab_child(n) = -2
+            if ((Agrif_Curgrid % NearRootBorder(3)) .AND. &
+                (Agrif_Curgrid % DistantRootBorder(3))) loctab_child(n) = -3
+!
+        case('N') ! No space DIMENSION
+!
+            posvartab_child(n) = 1
+            loctab_child(n) = -3
+!
+        end select
+!
+    enddo
+!
+    call Agrif_Correctnd(parent, child, pweight, weight,                    &
+                         lb_child(1:nbdim), lb_parent(1:nbdim),             &
+                         nb_child(1:nbdim), posvartab_child(1:nbdim),       &
+                         loctab_child(1:nbdim),                             &
+                         s_child(1:nbdim), s_parent(1:nbdim),               &
+                         ds_child(1:nbdim),ds_parent(1:nbdim), nbdim, procname )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CorrectVariable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Correctnd
+!
+!> calculates the boundary conditions for a nD grid variable on a fine grid by using
+!> a space and time interpolations; it is called by the #Agrif_CorrectVariable procedure
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Correctnd ( parent, child, pweight, weight,                        &
+                             pttab_child, pttab_Parent,                             &
+                             nbtab_Child, posvartab_Child, loctab_Child,            &
+                             s_Child, s_Parent, ds_Child, ds_Parent,                &
+                             nbdim, procname )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    TYPE(Agrif_Variable), pointer       :: parent       !< Variable on the parent grid
+    TYPE(Agrif_Variable), pointer       :: child        !< Variable on the child grid
+    LOGICAL                             :: pweight      !< Indicates if weight is used for the temporal interpolation
+    REAL                                :: weight       !< Coefficient for the temporal interpolation
+    INTEGER, DIMENSION(nbdim)   :: pttab_child          !< Index of the first point inside the domain for the parent grid variable
+    INTEGER, DIMENSION(nbdim)   :: pttab_Parent         !< Index of the first point inside the domain for the child  grid variable
+    INTEGER, DIMENSION(nbdim)   :: nbtab_Child          !< Number of cells of the child grid
+    INTEGER, DIMENSION(nbdim)   :: posvartab_Child      !< Position of the grid variable (1 or 2)
+    INTEGER, DIMENSION(nbdim)   :: loctab_Child         !< Indicates if the child grid has a common border with the root grid
+    REAL   , DIMENSION(nbdim)   :: s_Child,  s_Parent   !< Positions of the parent and child grids
+    REAL   , DIMENSION(nbdim)   :: ds_Child, ds_Parent  !< Space steps of the parent and child grids
+    INTEGER                             :: nbdim        !< Number of dimensions of the grid variable
+    procedure()                         :: procname     !< Data recovery procedure
+!
+    INTEGER,DIMENSION(6)                :: type_interp     ! Type of interpolation (linear, spline,...)
+    INTEGER,DIMENSION(6,6)              :: type_interp_bc  ! Type of interpolation (linear, spline,...)
+    INTEGER,DIMENSION(nbdim,2,2)        :: childarray
+    INTEGER,DIMENSION(nbdim,2)          :: lubglob
+    INTEGER                             :: kindex       ! Index used for safeguard and time interpolation
+    INTEGER,DIMENSION(nbdim,2,2)        :: indtab       ! Arrays indicating the limits of the child
+    INTEGER,DIMENSION(nbdim,2,2)        :: indtruetab   ! grid variable where boundary conditions are
+    INTEGER,DIMENSION(nbdim,2,2,nbdim)  :: ptres,ptres2 ! calculated
+    INTEGER,DIMENSION(nbdim)            :: coords
+    INTEGER                             :: i, nb, ndir
+    INTEGER                             :: n, sizetab
+    INTEGER                             :: ibeg, iend
+    INTEGER                             :: i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2
+    REAL                                :: c1t,c2t      ! Coefficients for the time interpolation (c2t=1-c1t)
+#if defined AGRIF_MPI
+!
+    INTEGER, DIMENSION(nbdim)   :: lower, upper
+    INTEGER, DIMENSION(nbdim)   :: ltab, utab
+!
+#endif
+!
+    type_interp_bc = child % root_var % type_interp_bc
+    coords         = child % root_var % coords
+!
+    ibeg = child % bcinf
+    iend = child % bcsup
+!
+    indtab(1:nbdim,2,1) = pttab_child(1:nbdim) + nbtab_child(1:nbdim) + ibeg
+    indtab(1:nbdim,2,2) = indtab(1:nbdim,2,1) + ( iend - ibeg )
+
+    indtab(1:nbdim,1,1) = pttab_child(1:nbdim) - iend
+    indtab(1:nbdim,1,2) = pttab_child(1:nbdim) - ibeg
+
+    WHERE (posvartab_child(1:nbdim) == 2)
+        indtab(1:nbdim,1,1) = indtab(1:nbdim,1,1) - 1
+        indtab(1:nbdim,1,2) = indtab(1:nbdim,1,2) - 1
+    END WHERE
+!
+    call Agrif_get_var_global_bounds(child,lubglob,nbdim)
+!
+    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2), lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1), lubglob(1:nbdim,2))
+    indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2), lubglob(1:nbdim,2))
+!
+    do nb = 1,nbdim
+        do ndir = 1,2
+!
+            if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
+!
+                do n = 1,2
+                    ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)
+                enddo
+!
+                do i = 1,nbdim
+!
+                    if (i /= nb) then
+!
+                        if (loctab_child(i) == -1 .OR. loctab_child(i) == -3) then
+                            ptres(i,1,ndir,nb) = pttab_child(i)
+                        else
+                            ptres(i,1,ndir,nb) = indtruetab(i,1,1)
+                        endif
+                        if (loctab_child(i) == -2 .OR. loctab_child(i) == -3) then
+                            if (posvartab_child(i) == 1) then
+                                ptres(i,2,ndir,nb) = pttab_child(i) + nbtab_child(i)
+                            else
+                                ptres(i,2,ndir,nb) = pttab_child(i) + nbtab_child(i) - 1
+                            endif
+                        else
+                            ptres(i,2,ndir,nb) = indtruetab(i,2,2)
+                        endif
+!
+                    endif
+!
+                enddo
+
+!
+#if defined AGRIF_MPI
+                call Agrif_get_var_bounds_array(child,lower,upper,nbdim)
+
+                do i = 1,nbdim
+!
+                    Call Agrif_GetLocalBoundaries(ptres(i,1,ndir,nb), ptres(i,2,ndir,nb),  &
+                                                  coords(i), lower(i), upper(i), ltab(i), utab(i) )
+                    ptres2(i,1,ndir,nb) = max(ltab(i),lower(i))
+                    ptres2(i,2,ndir,nb) = min(utab(i),upper(i))
+                    if ((i == nb) .AND. (ndir == 1)) then
+                        ptres2(i,2,ndir,nb) = max(utab(i),lower(i))
+                    elseif ((i == nb) .AND. (ndir == 2)) then
+                        ptres2(i,1,ndir,nb) = min(ltab(i),upper(i))
+                    endif
+!
+                enddo
+#else
+                ptres2(:,:,ndir,nb) = ptres(:,:,ndir,nb)
+#endif
+            endif
+!
+        enddo   ! ndir = 1,2
+    enddo       ! nb = 1,nbdim
+!
+    if ( child % interpIndex /= Agrif_Curgrid % parent % ngridstep .OR. &
+         child % Interpolationshouldbemade ) then
+!
+!     Space interpolation
+!
+        kindex = 1
+!
+        do nb = 1,nbdim
+
+            type_interp = type_interp_bc(nb,:)
+
+            do ndir = 1,2
+!
+                if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
+!
+                    call Agrif_InterpnD(type_interp, parent, child,             &
+                                        ptres(1:nbdim,1,ndir,nb),               &
+                                        ptres(1:nbdim,2,ndir,nb),               &
+                                        pttab_child(1:nbdim),                   &
+                                        pttab_Parent(1:nbdim),                  &
+                                        s_Child(1:nbdim), s_Parent(1:nbdim),    &
+                                        ds_Child(1:nbdim),ds_Parent(1:nbdim),   &
+                                        NULL(), .FALSE., nbdim,                 &
+                                        childarray,                             &
+                                        child%memberin(nb,ndir), .TRUE., procname, coords(nb), ndir)
+
+                    child % childarray(1:nbdim,:,:,nb,ndir) = childarray
+
+                    if (.not. child%interpolationshouldbemade) then
+!
+!                       Safeguard of the values of the grid variable (at times n and n+1 on the parent grid)
+!
+                        sizetab = 1
+                        do i = 1,nbdim
+                            sizetab = sizetab * (ptres2(i,2,ndir,nb)-ptres2(i,1,ndir,nb)+1)
+                        enddo
+
+                        call saveAfterInterp(child,ptres2(:,:,ndir,nb),kindex,sizetab,nbdim)
+!
+                    endif
+!
+                endif
+!
+            enddo   ! ndir = 1,2
+        enddo       ! nb = 1,nbdim
+!
+        child % interpIndex = Agrif_Curgrid % parent % ngridstep
+!
+    endif
+!
+    if (.not. child%interpolationshouldbemade) then
+!
+!       Calculation of the coefficients c1t and c2t for the temporary interpolation
+!
+        if (pweight) then
+            c1t = weight
+        else
+            c1t = (REAL(Agrif_Nbstepint()) + 1.) / Agrif_Rhot()
+        endif
+        c2t = 1. - c1t
+!
+!       Time interpolation
+!
+        kindex = 1
+!
+        do nb = 1,nbdim
+            do ndir = 1,2
+                if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
+                    Call timeInterpolation(child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim)
+                endif
+            enddo
+        enddo
+!
+    endif
+!
+    do nb = 1,nbdim
+    do ndir = 1,2
+        if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then
+            select case(nbdim)
+            case(1)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+
+                call procname(parray1(i1:i2),                               &
+                              i1,i2, .FALSE.,coords(nb),ndir)
+            case(2)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+
+                call procname(parray2(i1:i2,j1:j2),                         &
+                              i1,i2,j1,j2, .FALSE.,coords(nb),ndir)
+            case(3)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+
+                call procname(parray3(i1:i2,j1:j2,k1:k2),                   &
+                              i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir)
+            case(4)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+                l1 = child % childarray(4,1,2,nb,ndir)
+                l2 = child % childarray(4,2,2,nb,ndir)
+
+                call procname(parray4(i1:i2,j1:j2,k1:k2,l1:l2),             &
+                              i1,i2,j1,j2,k1,k2,l1,l2, .FALSE.,coords(nb),ndir)
+            case(5)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+                l1 = child % childarray(4,1,2,nb,ndir)
+                l2 = child % childarray(4,2,2,nb,ndir)
+                m1 = child % childarray(5,1,2,nb,ndir)
+                m2 = child % childarray(5,2,2,nb,ndir)
+
+                call procname(parray5(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2),       &
+                              i1,i2,j1,j2,k1,k2,l1,l2,m1,m2, .FALSE.,coords(nb),ndir)
+            case(6)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+                l1 = child % childarray(4,1,2,nb,ndir)
+                l2 = child % childarray(4,2,2,nb,ndir)
+                m1 = child % childarray(5,1,2,nb,ndir)
+                m2 = child % childarray(5,2,2,nb,ndir)
+                n1 = child % childarray(6,1,2,nb,ndir)
+                n2 = child % childarray(6,2,2,nb,ndir)
+
+                call procname(parray6(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2,n1:n2), &
+                              i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2, .FALSE.,coords(nb),ndir)
+            end select
+        endif
+    enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Correctnd
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine saveAfterInterp
+!
+!> saves the values of the grid variable on the fine grid after the space interpolation
+!---------------------------------------------------------------------------------------------------
+subroutine saveAfterInterp ( child_var, bounds, kindex, newsize, nbdim )
+!---------------------------------------------------------------------------------------------------
+    TYPE (Agrif_Variable),       INTENT(inout)  :: child_var !< The fine grid variable
+    INTEGER, DIMENSION(nbdim,2), INTENT(in)     :: bounds
+    INTEGER,                     INTENT(inout)  :: kindex    !< Index indicating where this safeguard
+                                                             !<     is done on the fine grid
+    INTEGER,                     INTENT(in)     :: newsize
+    INTEGER,                     INTENT(in)     :: nbdim
+!
+    INTEGER     :: ir,jr,kr,lr,mr,nr
+!
+!    Allocation of the array oldvalues2d
+!
+    if (newsize .LE. 0) return
+!
+    Call Agrif_Checksize(child_var,kindex+newsize)
+
+    if (child_var % interpIndex /= Agrif_Curgrid % parent % ngridstep ) then
+        child_var % oldvalues2d(1,kindex:kindex+newsize-1) = &
+        child_var % oldvalues2d(2,kindex:kindex+newsize-1)
+    endif
+
+    SELECT CASE (nbdim)
+    CASE (1)
+!CDIR ALTCODE
+        do ir = bounds(1,1), bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray1(ir)
+            kindex = kindex + 1
+        enddo
+!
+    CASE (2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray2(ir,jr)
+            kindex = kindex + 1
+        enddo
+        enddo
+!
+    CASE (3)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray3(ir,jr,kr)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+!
+      CASE (4)
+        do lr = bounds(4,1),bounds(4,2)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray4(ir,jr,kr,lr)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+!
+    CASE (5)
+        do mr = bounds(5,1),bounds(5,2)
+        do lr = bounds(4,1),bounds(4,2)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray5(ir,jr,kr,lr,mr)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+!
+    CASE (6)
+        do nr = bounds(6,1),bounds(6,2)
+        do mr = bounds(5,1),bounds(5,2)
+        do lr = bounds(4,1),bounds(4,2)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray6(ir,jr,kr,lr,mr,nr)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    END SELECT
+!---------------------------------------------------------------------------------------------------
+end subroutine saveAfterInterp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine timeInterpolation
+!
+!> subroutine for a linear time interpolation on the child grid
+!---------------------------------------------------------------------------------------------------
+subroutine timeInterpolation ( child_var, bounds, kindex, c1t, c2t, nbdim )
+!---------------------------------------------------------------------------------------------------
+    TYPE (Agrif_Variable)       :: child_var !< The fine grid variable
+    INTEGER, DIMENSION(nbdim,2) :: bounds
+    INTEGER                     :: kindex    !< Index indicating the values of the fine grid got
+                                             !<    before and after the space interpolation and
+                                             !<    used for the time interpolation
+    REAL                        :: c1t, c2t  !< Coefficients for the time interpolation (c2t=1-c1t)
+    INTEGER                     :: nbdim
+!
+    INTEGER :: ir,jr,kr,lr,mr,nr
+!
+    SELECT CASE (nbdim)
+    CASE (1)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            parray1(ir) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                      c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+!
+    CASE (2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            parray2(ir,jr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                         c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+!
+    CASE (3)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            parray3(ir,jr,kr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                            c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+!
+    CASE (4)
+        do lr = bounds(4,1),bounds(4,2)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            parray4(ir,jr,kr,lr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                               c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+!
+    CASE (5)
+        do mr=bounds(5,1),bounds(5,2)
+        do lr=bounds(4,1),bounds(4,2)
+        do kr=bounds(3,1),bounds(3,2)
+        do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir=bounds(1,1),bounds(1,2)
+            parray5(ir,jr,kr,lr,mr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                                  c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+!
+    CASE (6)
+        do nr=bounds(6,1),bounds(6,2)
+        do mr=bounds(5,1),bounds(5,2)
+        do lr=bounds(4,1),bounds(4,2)
+        do kr=bounds(3,1),bounds(3,2)
+        do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir=bounds(1,1),bounds(1,2)
+            parray6(ir,jr,kr,lr,mr,nr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                                     c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    END SELECT
+!---------------------------------------------------------------------------------------------------
+end subroutine timeInterpolation
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Checksize
+!
+!> subroutine used in the saveAfterInterp procedure to allocate the oldvalues2d array
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Checksize ( child_var, newsize )
+!---------------------------------------------------------------------------------------------------
+    TYPE (Agrif_Variable), INTENT(inout)  :: child_var !< The fine grid variable
+    INTEGER              , INTENT(in)     :: newsize   !< Size of the domains where the boundary
+                                                       !<    conditions are calculated
+!
+    REAL, DIMENSION(:,:), Allocatable :: tempoldvalues ! Temporary array
+!
+    if (.NOT. associated(child_var % oldvalues2d)) then
+!
+        allocate(child_var % oldvalues2d(2,newsize))
+        child_var % oldvalues2d = 0.
+!
+    else
+!
+        if (SIZE(child_var % oldvalues2d,2) < newsize) then
+!
+            allocate(tempoldvalues(2,SIZE(child_var % oldvalues2d,2)))
+            tempoldvalues = child_var % oldvalues2d
+            deallocate(child_var % oldvalues2d)
+            allocate(  child_var % oldvalues2d(2,newsize))
+            child_var % oldvalues2d = 0.
+            child_var % oldvalues2d(:,1:SIZE(tempoldvalues,2)) = tempoldvalues(:,:)
+            deallocate(tempoldvalues)
+!
+        endif
+!
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Checksize
+!===================================================================================================
+!
+end module Agrif_Boundary
+
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F	(revision 5659)
+++ 	(revision )
@@ -1,2448 +1,0 @@
-!
-! $Id$
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module AGRIF_bcfunction
-C
-C 
-      Module  Agrif_bcfunction
-CCC   Description:
-CCC   
-C
-C     Modules used:
-C  
-      Use Agrif_Boundary
-      Use Agrif_Update
-      Use Agrif_fluxmod
-      Use Agrif_Save
-C             
-      IMPLICIT NONE
-C
-      interface Agrif_Bc_variable
-          module procedure Agrif_Bc_variable0d,
-     &                     Agrif_Bc_variable1d,
-     &                     Agrif_Bc_variable2d,
-     &                     Agrif_Bc_variable3d,
-     &                     Agrif_Bc_variable4d,
-     &                     Agrif_Bc_variable5d
-      end interface       
-C
-      interface Agrif_Set_Parent
-          module procedure Agrif_Set_Parent_int,
-     &                     Agrif_Set_Parent_real
-      end interface       
-C
-      interface Agrif_Interp_variable
-          module procedure Agrif_Interp_var0d,
-     &                     Agrif_Interp_var1d,
-     &                     Agrif_Interp_var2d,
-     &                     Agrif_Interp_var3d,
-     &                     Agrif_Interp_var4d,
-     &                     Agrif_Interp_var5d
-      end interface       
-C
-      interface Agrif_Init_variable
-          module procedure Agrif_Init_variable0d,
-     &                     Agrif_Init_variable1d,
-     &                     Agrif_Init_variable2d,
-     &                     Agrif_Init_variable3d,
-     &                     Agrif_Init_variable4d
-      end interface       
-C
-      interface Agrif_update_variable
-          module procedure Agrif_update_var0d,
-     &                     Agrif_update_var1d,
-     &                     Agrif_update_var2d,
-     &                     Agrif_update_var3d,
-     &                     Agrif_update_var4d,
-     &                     Agrif_update_var5d
-      end interface       
-      
-      interface Agrif_Save_Forrestore
-         module procedure Agrif_Save_Forrestore0d,    
-     &                    Agrif_Save_Forrestore2d,    
-     &                    Agrif_Save_Forrestore3d,    
-     &                    Agrif_Save_Forrestore4d
-      end interface
-C
-      Contains 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_type
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_type(tabvarsindic,posvar,point)
-C
-CCC   Description:
-CCC   To set the TYPE of the variable.
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C
-C
-C     Arguments      
-C
-      INTEGER, DIMENSION(:) :: posvar
-      INTEGER, DIMENSION(:) :: point
-C
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-      INTEGER :: dimensio ! DIMENSION of the variable
-      INTEGER :: i
-C
-C
-C     Begin 
-C
-      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
-C
-      if (.not.associated(Agrif_Mygrid % tabvars(tabvarsindic)
-     &                                 %var % posvar)) then
-      Allocate( 
-     & Agrif_Mygrid % tabvars(tabvarsindic)%var % posvar(dimensio))
-      endif 
-            
-      do i = 1 , dimensio
-         Agrif_Mygrid % tabvars(tabvarsindic) %var % posvar(i)
-     &                       = posvar(i)
-         Agrif_Mygrid % tabvars(tabvarsindic) %var % point(i) 
-     &                       = point(i)
-      enddo
-C
-C
-      End Subroutine Agrif_Set_type
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_parent_int
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_parent_int(tabvarsindic,value)
-C
-CCC   Description:
-CCC   To set the TYPE of the variable.
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C
-C
-C     Arguments      
-C
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-      INTEGER :: Value
-C
-C     Begin 
-C
-      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
-     &         var % iarray0 = value
-C
-C
-      End Subroutine Agrif_Set_parent_int
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_parent_real
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_parent_real(tabvarsindic,value)
-C
-CCC   Description:
-CCC   To set the TYPE of the variable.
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C
-C
-C     Arguments      
-C
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-      REAL :: Value
-C
-C     Begin 
-C
-      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
-     &          var % array0 = value
-C
-C
-      End Subroutine Agrif_Set_parent_real
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_raf
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_raf(tabvarsindic,tabraf)
-C
-CCC   Description:
-CCC   Attention tabraf est de taille trois si on ne raffine pas suivant z la
-CCC             troisieme entree du tableau tabraf est 'N'
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      CHARACTER(*) ,DIMENSION(:) :: tabraf
-C
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-      INTEGER :: dimensio ! DIMENSION of the variable
-      INTEGER :: i
-C
-C
-C     Begin 
-C
-      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
-C        
-      if (.not.associated(Agrif_Mygrid % tabvars(tabvarsindic)
-     &                                 %var % interptab)) then 
-      Allocate(
-     & Agrif_Mygrid % tabvars(tabvarsindic)%var% interptab(dimensio))
-      endif
-
-      do i = 1 , dimensio
-         Agrif_Mygrid % tabvars(tabvarsindic) %var % interptab(i) 
-     &                 = TRIM(tabraf(i))
-      enddo
-C
-      End Subroutine Agrif_Set_raf
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_bc
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_bc(tabvarsindic,point,
-     &          Interpolationshouldbemade)
-C
-CCC   Description:
-CCC
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      INTEGER, DIMENSION(2) :: point
-      LOGICAL, OPTIONAL :: Interpolationshouldbemade
-C
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars
-      
-    
-C
-C
-C     Begin 
-C
-C     
-
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      endif  
-      
-      if (Agrif_Curgrid % fixedrank .NE. 0) then  
-       IF (.Not.Associated(tabvars%var% interpIndex)) THEN
-        Allocate(tabvars%var % interpIndex)
-          tabvars%var % interpIndex = -1
-
-        Allocate(tabvars%var % oldvalues2D(2,1))
-          tabvars%var % oldvalues2D = 0. 
-       ENDIF      
-       if ( PRESENT(Interpolationshouldbemade) ) then
-         tabvars%var %
-     &     Interpolationshouldbemade = Interpolationshouldbemade
-       endif
-
-      endif
-C
-      tabvars%var % bcinf = point(1)
-      tabvars%var % bcsup = point(2)
-C
-      End Subroutine Agrif_Set_bc
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_interp
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_interp(tabvarsindic,interp,interp1,interp2,
-     &                interp3)
-C
-CCC   Description:
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
-C
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars
-      
-    
-C
-C
-C     Begin 
-C
-C     
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Mygrid % tabvars(indic)
-      endif      
-C
-C     Begin 
-C
-      tabvars % var % Typeinterp = 
-     &    Agrif_Constant
-      IF (present(interp)) THEN
-      tabvars % var % Typeinterp = 
-     &           interp
-      ENDIF
-      IF (present(interp1)) THEN
-      tabvars % var % Typeinterp(1) = 
-     &           interp1
-      ENDIF
-      IF (present(interp2)) THEN
-      tabvars % var % Typeinterp(2) = 
-     &           interp2
-      ENDIF
-      IF (present(interp3)) THEN
-      tabvars % var % Typeinterp(3) = 
-     &           interp3
-      ENDIF
-C
-      End Subroutine Agrif_Set_interp
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_bcinterp
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_bcinterp(tabvarsindic,interp,interp1,
-     &      interp2,interp3,interp11,interp12,interp21,interp22)
-C
-CCC   Description:
-
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
-      INTEGER, OPTIONAL      :: interp11,interp12,interp21,interp22
-C
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars
-      
-    
-C
-C
-C     Begin 
-C
-C     
-
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Mygrid % tabvars(indic)
-      endif 
-C
-      tabvars% var % bctypeinterp = 
-     &           Agrif_Constant   
-      IF (present(interp)) THEN
-      tabvars% var % bctypeinterp = 
-     &           interp
-      ENDIF       
-      IF (present(interp1)) THEN
-      tabvars% var % bctypeinterp(1:2,1) = 
-     &           interp1
-      ENDIF       
-      IF (present(interp11)) THEN
-      tabvars% var % bctypeinterp(1,1) = 
-     &           interp11
-      ENDIF
-      IF (present(interp12)) THEN
-      tabvars% var % bctypeinterp(1,2) = 
-     &           interp12
-      ENDIF          
-      IF (present(interp2)) THEN
-      tabvars% var % bctypeinterp(1:2,2) = 
-     &           interp2
-      ENDIF
-      IF (present(interp21)) THEN
-      tabvars% var % bctypeinterp(2,1) = 
-     &           interp21
-      ENDIF      
-      IF (present(interp22)) THEN
-      tabvars% var % bctypeinterp(2,2) = 
-     &           interp22
-      ENDIF            
-      IF (present(interp3)) THEN
-      tabvars% var % bctypeinterp(1:2,3) =
-     &           interp3
-      ENDIF
-C
-      End Subroutine Agrif_Set_bcinterp
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_Update
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_Update(tabvarsindic,point)
-C
-CCC   Description:
-CCC
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      INTEGER, DIMENSION(2) :: point
-C
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-C
-C
-C     Begin 
-C
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = point(1)
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = point(2)
-C
-      End Subroutine Agrif_Set_Update
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_UpdateType
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_UpdateType(tabvarsindic,
-     &                                  update,update1,update2,
-     &                                  update3,update4,update5)
-C
-CCC   Description:
-
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      INTEGER, OPTIONAL           :: update, update1,
-     &       update2, update3,update4,update5
-C
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer :: roottabvars      
-C
-C
-C     Begin 
-
-      indic = tabvarsindic
-
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
-      else
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-      
-C
-      roottabvars% var % typeupdate = 
-     &                   Agrif_Update_Copy
-      
-      IF (present(update)) THEN
-        roottabvars% var % typeupdate = 
-     &           update
-      ENDIF
-      IF (present(update1)) THEN
-        roottabvars% var % typeupdate(1) = 
-     &           update1
-      ENDIF  
-      IF (present(update2)) THEN
-        roottabvars% var % typeupdate(2) = 
-     &           update2
-      ENDIF  
-      IF (present(update3)) THEN
-        roottabvars% var % typeupdate(3) = 
-     &           update3
-      ENDIF 
-      IF (present(update4)) THEN
-        roottabvars% var % typeupdate(4) = 
-     &           update4
-      ENDIF       
-      IF (present(update5)) THEN
-        roottabvars% var % typeupdate(5) = 
-     &           update5
-      ENDIF                  
-C
-      End Subroutine Agrif_Set_UpdateType           
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Set_restore
-C     **************************************************************************
-C 
-      Subroutine Agrif_Set_restore(tabvarsindic)
-C
-CCC   Description:
-CCC   
-C
-C     Modules used:
-C      
-
-C
-C     Declarations:
-C      
-C     Arguments      
-C
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-C
-C     Begin 
-C
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif  
-C
-      Agrif_Mygrid%tabvars(indic)%var % restaure = .TRUE.
-C
-      End Subroutine Agrif_Set_restore
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_variable0d
-C     **************************************************************************
-      Subroutine Agrif_Init_variable0d(tabvarsindic0,tabvarsindic,
-     &        procname)
-
-      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-C
-      if (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (present(procname)) then
-      CALL Agrif_Interp_variable(tabvarsindic0,indic,procname)
-      CALL Agrif_Bc_variable(tabvarsindic0,indic,1.,procname)
-      else
-      CALL Agrif_Interp_variable(tabvarsindic0,indic)
-      CALL Agrif_Bc_variable(tabvarsindic0,indic,1.)
-      endif
-
-      End Subroutine Agrif_Init_variable0d
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_variable1d
-C     **************************************************************************
-      Subroutine Agrif_Init_variable1d(q,tabvarsindic,procname)
-
-      REAL, DIMENSION(:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-
-C
-      if (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif      
-C
-      if (present(procname)) then
-      CALL Agrif_Interp_variable(q,indic,procname)
-      CALL Agrif_Bc_variable(q,indic,1.,procname)
-      else
-      CALL Agrif_Interp_variable(q,indic)
-      CALL Agrif_Bc_variable(q,indic,1.)
-      endif
-
-      End Subroutine Agrif_Init_variable1d
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_variable2d
-C     **************************************************************************
-      Subroutine Agrif_Init_variable2d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:) :: q
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-      integer :: indic
-
-C
-      if (Agrif_Root()) Return
-C
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (present(procname)) then
-      CALL Agrif_Interp_variable(q,indic,procname)
-      CALL Agrif_Bc_variable(q,indic,1.,procname)
-      else
-      CALL Agrif_Interp_variable(q,indic)
-      CALL Agrif_Bc_variable(q,indic,1.)
-      endif
-
-
-      End Subroutine Agrif_Init_variable2d
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_variable3d
-C     **************************************************************************
-      Subroutine Agrif_Init_variable3d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:,:) :: q
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-C
-      if (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif      
-C
-      if (present(procname)) then
-      CALL Agrif_Interp_variable(q,indic,procname)
-      CALL Agrif_Bc_variable(q,indic,1.,procname)
-      else
-      CALL Agrif_Interp_variable(q,indic)
-      CALL Agrif_Bc_variable(q,indic,1.)
-      endif
-
-C
-      End Subroutine Agrif_Init_variable3d
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_variable4d
-C     **************************************************************************
-      Subroutine Agrif_Init_variable4d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:,:,:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-C
-      if (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif       
-C
-      if (present(procname)) then
-      CALL Agrif_Interp_variable(q,indic,procname)
-      CALL Agrif_Bc_variable(q,indic,1.,procname)
-      else
-      CALL Agrif_Interp_variable(q,indic)
-      CALL Agrif_Bc_variable(q,indic,1.)
-      endif
-
-C
-      End Subroutine Agrif_Init_variable4d      
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Bc_variable0d
-C     **************************************************************************
-      Subroutine Agrif_Bc_variable0d(tabvarsindic0,tabvarsindic,
-     &                               calledweight,procname)
-
-      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-C        
-      External :: procname
-      Optional ::  procname
-      REAL, OPTIONAL :: calledweight
-      REAL    :: weight
-      LOGICAL :: pweight
-C
-      INTEGER :: dimensio      
-
-      if (Agrif_Root()) Return
-C
-      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim    
-C
-      if ( PRESENT(calledweight) ) then
-        weight=calledweight      
-        pweight = .TRUE.
-      else
-        weight = 0.
-        pweight = .FALSE.
-      endif
-C      
-C
-
-      
-      if ( dimensio .EQ. 1 ) Call Agrif_Interp_Bc_1D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array1,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,
-     & pweight)
-C
-      if ( dimensio .EQ. 2 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_2D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight,procname)
-      ELSE
-          
-      Call Agrif_Interp_Bc_2D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      endif
-C
-      if ( dimensio .EQ. 3 ) then
-      IF (present(procname)) THEN
-
-      Call Agrif_Interp_Bc_3D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_3D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      endif
-C
-      if ( dimensio .EQ. 4 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_4D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_4D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      endif
-C
-      if ( dimensio .EQ. 5 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_5D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_5D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      endif
-C
-      if ( dimensio .EQ. 6 ) Call Agrif_Interp_Bc_6D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array6,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
-     & weight,
-     & pweight)
-C
-C
-      End Subroutine Agrif_Bc_variable0d
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Bc_variable1d
-C     **************************************************************************
-      Subroutine Agrif_Bc_variable1d(q,tabvarsindic,calledweight,
-     &                               procname)
-
-      REAL   , Dimension(:)          :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-C        
-      REAL, OPTIONAL :: calledweight
-      REAL    :: weight
-      LOGICAL :: pweight
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
-C
-C      
-C      
-      If (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif         
-      
-      if ( PRESENT(calledweight) ) then
-        weight=calledweight      
-        pweight = .TRUE.
-      else
-        weight = 0.
-        pweight = .FALSE.
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-            
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_1D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_1D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      End Subroutine Agrif_Bc_variable1d 
-      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Bc_variable2d
-C     **************************************************************************
-      Subroutine Agrif_Bc_variable2d(q,tabvarsindic,calledweight,
-     &                               procname)
-
-      REAL   , Dimension(:,:)          :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-C        
-      REAL, OPTIONAL :: calledweight
-      REAL    :: weight
-      LOGICAL :: pweight
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
-C
-C      
-C      
-      If (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif       
-      
-      if ( PRESENT(calledweight) ) then
-        weight=calledweight      
-        pweight = .TRUE.
-      else
-        weight = 0.
-        pweight = .FALSE.
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-            
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_2D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_2D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      End Subroutine Agrif_Bc_variable2d
-            
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Bc_variable3d
-C     **************************************************************************
-      Subroutine Agrif_Bc_variable3d(q,tabvarsindic,calledweight,
-     &                               procname)
-
-      REAL   , Dimension(:,:,:)          :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-C        
-      REAL, OPTIONAL :: calledweight
-      REAL    :: weight
-      LOGICAL :: pweight
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
-C
-C      
-C      
-      If (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif       
-      
-      if ( PRESENT(calledweight) ) then
-        weight=calledweight      
-        pweight = .TRUE.
-      else
-        weight = 0.
-        pweight = .FALSE.
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-            
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_3D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_3D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      End Subroutine Agrif_Bc_variable3d
-      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Bc_variable4d
-C     **************************************************************************
-      Subroutine Agrif_Bc_variable4d(q,tabvarsindic,calledweight,
-     &                               procname)
-
-      REAL   , Dimension(:,:,:,:)          :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-C        
-      REAL, OPTIONAL :: calledweight
-      REAL    :: weight
-      LOGICAL :: pweight
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
-C
-C      
-C      
-      If (Agrif_Root()) Return
-      
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif      
-      
-      if ( PRESENT(calledweight) ) then
-        weight=calledweight      
-        pweight = .TRUE.
-      else
-        weight = 0.
-        pweight = .FALSE.
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-            
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_4D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_4D(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      End Subroutine Agrif_Bc_variable4d
-            
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Bc_variable5d
-C     **************************************************************************
-      Subroutine Agrif_Bc_variable5d(q,tabvarsindic,calledweight,
-     &                               procname)
-
-      REAL   , Dimension(:,:,:,:,:)          :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-C        
-      REAL, OPTIONAL :: calledweight
-      REAL    :: weight
-      LOGICAL :: pweight
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
-C
-C      
-C      
-      If (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif      
-      
-      if ( PRESENT(calledweight) ) then
-        weight=calledweight      
-        pweight = .TRUE.
-      else
-        weight = 0.
-        pweight = .FALSE.
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-            
-      IF (present(procname)) THEN
-      Call Agrif_Interp_Bc_5d(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight,procname)      
-      ELSE
-      Call Agrif_Interp_Bc_5d(
-     & roottabvars % var % bctypeinterp,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % bcinf,
-     & tabvars % var % bcsup,
-     & weight,pweight)
-      ENDIF
-      End Subroutine Agrif_Bc_variable5d
-      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_var0D
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_var0d(tabvarsindic0,tabvarsindic,procname)
-
-      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
-      INTEGER :: tabvarsindic, indic  ! indice of the variable in tabvars
-      INTEGER :: dimensio  ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-C      
-      if (Agrif_Root()) Return
-C     
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif       
-C     
-      dimensio = Agrif_Mygrid % tabvars(indic) % var % nbdim 
-C
-      if ( dimensio .EQ. 1 ) then
-       if (present(procname)) then
-       Call Agrif_Interp_1D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
-       else
-       Call Agrif_Interp_1D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
-       endif
-       endif
-C
-      if ( dimensio .EQ. 2 ) then
-      if (present(procname)) then
-       Call Agrif_Interp_2D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
-      else
-       Call Agrif_Interp_2D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
-      endif
-      endif
-C
-      if ( dimensio .EQ. 3 ) then
-      if (present(procname)) then
-       Call Agrif_Interp_3D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
-      else
-       Call Agrif_Interp_3D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
-      endif
-      endif
-C
-      if ( dimensio .EQ. 4 ) then
-      if (present(procname)) then
-       Call Agrif_Interp_4D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
-      else
-       Call Agrif_Interp_4D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
-      endif
-      endif
-C
-      if ( dimensio .EQ. 5 ) then
-      if (present(procname)) then
-       Call Agrif_Interp_5D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
-      else
-       Call Agrif_Interp_5D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
-       endif
-       endif
-C
-      if ( dimensio .EQ. 6 ) then
-      if (present(procname)) then
-       Call Agrif_Interp_6D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
-      else
-       Call Agrif_Interp_6D(
-     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
-     & Agrif_Curgrid % parent % tabvars(indic),
-     & Agrif_Curgrid % tabvars(indic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
-     & Agrif_Mygrid % tabvars(indic) % var % restaure,
-     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
-      endif
-      endif
-C
-      Return
-      End Subroutine Agrif_Interp_var0d
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_var1d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_var1d(q,tabvarsindic,procname)
-
-      REAL, DIMENSION(:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
-C
-      if (Agrif_Root()) Return
-C      
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-      
-      if (present(procname)) then
-      Call Agrif_Interp_1D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim,procname)
-      else
-      Call Agrif_Interp_1D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim)
-     
-      endif
-      Return
-      End Subroutine Agrif_Interp_var1d
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_var2d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_var2d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
-C
-       if (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      if (tabvars%var%restaure) then
-        if (agrif_curgrid%ngridstep == 0) then
-          call AGRIF_CopyFromold_AllOneVar
-     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
-        endif
-      endif
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-
-            
-       if (present(procname)) then
-       Call Agrif_Interp_2D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim,procname)
-       else
-       Call Agrif_Interp_2D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim)
-     
-      endif 
-      Return
-      End Subroutine Agrif_Interp_var2d
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_var3d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_var3d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:,:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
-C
-      if (Agrif_Root()) Return
-C      
-
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      if (tabvars%var%restaure) then
-        if (agrif_curgrid%ngridstep == 0) then
-          call AGRIF_CopyFromold_AllOneVar
-     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
-        endif
-      endif      
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-
-      if (present(procname)) then
-      Call Agrif_Interp_3D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim,procname)
-      else
-      Call Agrif_Interp_3D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim)
-     
-      endif   
-      Return
-      End Subroutine Agrif_Interp_var3d
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_var4d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_var4d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:,:,:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars  
-C
-      if (Agrif_Root()) Return
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      if (tabvars%var%restaure) then
-        if (agrif_curgrid%ngridstep == 0) then
-          call AGRIF_CopyFromold_AllOneVar
-     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
-        endif
-      endif      
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-            
-      if (present(procname)) then
-      Call Agrif_Interp_4D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim,procname)
-      else
-      Call Agrif_Interp_4D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim)
-     
-      endif      
-
-      Return
-      End Subroutine Agrif_Interp_var4d     
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_var5d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_var5d(q,tabvarsindic,procname)
-
-      REAL,  DIMENSION(:,:,:,:,:) :: q
-      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
-C
-      if (Agrif_Root()) Return
-C      
-
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-      
-      if (present(procname)) then
-      Call Agrif_Interp_5D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim,procname)
-      else
-      Call Agrif_Interp_5D(
-     & roottabvars % var %  TypeInterp,
-     & parenttabvars,
-     & tabvars,q,
-     & roottabvars % var % restaure,
-     & roottabvars %var % nbdim)
-     
-      endif
-      Return
-      End Subroutine Agrif_Interp_var5d       
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_update_var0d
-C     **************************************************************************
-C 
-      Subroutine Agrif_update_var0d(tabvarsindic0,tabvarsindic,
-     &                              locupdate,locupdate1,
-     &                  locupdate2,procname)
-
-      INTEGER :: tabvarsindic ! indice of the variable in tabvars
-      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname      
-      INTEGER :: dimensio
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2            
-C
-      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 
-C      
-      if (Agrif_Root()) Return
-      
-C     
-      IF (present(locupdate)) THEN
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio)
-     &      = locupdate(1)
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio) 
-     &      = locupdate(2)
-      ELSE
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio) 
-     &      = -99
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio) 
-     &      = -99
-      ENDIF
-      
-      IF (present(locupdate1)) THEN
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1) 
-     &      = locupdate1(1)
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1) 
-     &      = locupdate1(2)
-      ENDIF  
-      
-      IF (present(locupdate2)) THEN
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2) 
-     &      = locupdate2(1)
-      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2) 
-     &      = locupdate2(2)
-      ENDIF             
- 
-      if ( dimensio .EQ. 1 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Update_1D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
-     & procname)
-      ELSE
-      Call Agrif_Update_1D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
-      ENDIF
-      endif
-      if ( dimensio .EQ. 2 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Update_2D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
-     & procname)
-      ELSE
-      Call Agrif_Update_2D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
-      ENDIF
-      endif
-      if ( dimensio .EQ. 3 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Update_3D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
-     & procname)
-      ELSE
-      Call Agrif_Update_3D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
-      ENDIF
-      endif
-      if ( dimensio .EQ. 4 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Update_4D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
-     & procname)
-      ELSE
-      Call Agrif_Update_4D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
-      ENDIF
-      endif
-      if ( dimensio .EQ. 5 ) then
-      IF (present(procname)) THEN
-      Call Agrif_Update_5D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
-     & procname)
-      ELSE
-      Call Agrif_Update_5D(
-     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
-     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic),
-     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
-     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
-      ENDIF
-      endif
-
-      Return
-      End Subroutine Agrif_update_var0d
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_update_var1d
-C     **************************************************************************
-C 
-      Subroutine Agrif_update_var1d(q,tabvarsindic,locupdate,
-     &  locupdate1,locupdate2,procname)
-
-      REAL,  DIMENSION(:) :: q
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      External :: procname
-      Optional ::  procname      
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars   
-C      
-      if (Agrif_Root()) Return
-C     
-
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-      
-      IF (present(locupdate)) THEN
-      tabvars%var % updateinf(1:1) 
-     &      = locupdate(1)
-      tabvars%var % updatesup(1:1) 
-     &      = locupdate(2)
-      ELSE
-      tabvars%var % updateinf(1:1) 
-     &      = -99
-      tabvars%var % updatesup(1:1) 
-     &      = -99
-      ENDIF
-      
-      IF (present(locupdate1)) THEN
-      tabvars%var % updateinf(1) 
-     &      = locupdate1(1)
-      tabvars%var % updatesup(1) 
-     &      = locupdate1(2)
-      ENDIF  
-      
-      IF (present(locupdate2)) THEN
-      tabvars%var % updateinf(2) 
-     &      = locupdate2(1)
-      tabvars%var % updatesup(2) 
-     &      = locupdate2(2)
-      ENDIF       
- 
-      IF (present(procname)) THEN
-      Call Agrif_Update_1D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup,
-     & procname)
-      ELSE 
-      Call Agrif_Update_1D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup)       
-      ENDIF
-
-      Return
-      End Subroutine Agrif_update_var1d
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_update_var2d
-C     **************************************************************************
-C 
-      Subroutine Agrif_update_var2d(q,tabvarsindic,locupdate,
-     &  locupdate1,locupdate2,procname)
-
-      REAL,  DIMENSION(:,:) :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate 
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
-C      
-      IF (Agrif_Root()) RETURN
-      
-C 
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-      
-      IF (present(locupdate)) THEN
-      tabvars%var % updateinf(1:2) 
-     &      = locupdate(1)
-      tabvars%var % updatesup(1:2) 
-     &      = locupdate(2)
-      ELSE
-      tabvars%var % updateinf(1:2) 
-     &      = -99
-      tabvars%var % updatesup(1:2) 
-     &      = -99
-      ENDIF
-      
-      IF (present(locupdate1)) THEN
-      tabvars%var % updateinf(1) 
-     &      = locupdate1(1)
-      tabvars%var % updatesup(1) 
-     &      = locupdate1(2)
-      ENDIF  
-      
-      IF (present(locupdate2)) THEN
-      tabvars%var % updateinf(2) 
-     &      = locupdate2(1)
-      tabvars%var % updatesup(2) 
-     &      = locupdate2(2)
-      ENDIF
- 
-      IF (present(procname)) THEN
-      Call Agrif_Update_2D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup,
-     & procname)
-      ELSE 
-      Call Agrif_Update_2D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup)       
-      ENDIF
-
-      Return
-      End Subroutine Agrif_update_var2d
-C 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_update_var3d
-C     **************************************************************************
-C 
-      Subroutine Agrif_update_var3d(q,tabvarsindic,locupdate,
-     &  locupdate1,locupdate2,procname)
-
-      REAL,  DIMENSION(:,:,:) :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
-C      
-      IF (Agrif_Root()) RETURN 
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-      
-      IF (present(locupdate)) THEN
-      tabvars%var % updateinf(1:3) 
-     &      = locupdate(1)
-      tabvars%var % updatesup(1:3) 
-     &      = locupdate(2)
-      ELSE
-      tabvars%var % updateinf(1:3) 
-     &      = -99
-      tabvars%var % updatesup(1:3) 
-     &      = -99
-      ENDIF      
-      
-      IF (present(locupdate1)) THEN
-      tabvars%var % updateinf(1) 
-     &      = locupdate1(1)
-      tabvars%var % updatesup(1) 
-     &      = locupdate1(2)
-      ENDIF  
-      
-      IF (present(locupdate2)) THEN
-      tabvars%var % updateinf(2) 
-     &      = locupdate2(1)
-      tabvars%var % updatesup(2) 
-     &      = locupdate2(2)
-      ENDIF
-
-      IF (present(procname)) THEN
-      Call Agrif_Update_3D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup,
-     & procname)
-      ELSE 
-      Call Agrif_Update_3D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup)       
-      ENDIF
-
-      Return
-      End Subroutine Agrif_update_var3d
-C 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_update_var4d
-C     **************************************************************************
-C 
-      Subroutine Agrif_update_var4d(q,tabvarsindic,locupdate,
-     &  locupdate1,locupdate2,procname)
-
-      REAL,  DIMENSION(:,:,:,:) :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
-C      
-      IF (Agrif_Root()) RETURN
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)     
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif      
-C      
-      IF (present(locupdate)) THEN
-      tabvars%var % updateinf(1:4) 
-     &      = locupdate(1)
-      tabvars%var % updatesup(1:4) 
-     &      = locupdate(2)
-      ELSE
-      tabvars%var % updateinf(1:4) 
-     &      = -99
-      tabvars%var % updatesup(1:4) 
-     &      = -99
-      ENDIF
-      
-      IF (present(locupdate1)) THEN
-      tabvars%var % updateinf(1) 
-     &      = locupdate1(1)
-      tabvars%var % updatesup(1) 
-     &      = locupdate1(2)
-      ENDIF  
-      
-      IF (present(locupdate2)) THEN
-      tabvars%var % updateinf(2) 
-     &      = locupdate2(1)
-      tabvars%var % updatesup(2) 
-     &      = locupdate2(2)
-      ENDIF
-
-      IF (present(procname)) THEN
-      Call Agrif_Update_4D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup,
-     & procname)
-      ELSE 
-      Call Agrif_Update_4D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup)       
-      ENDIF
-
-      Return
-      End Subroutine Agrif_update_var4d  
-C 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_update_var5d
-C     **************************************************************************
-C 
-      Subroutine Agrif_update_var5d(q,tabvarsindic,locupdate,
-     &  locupdate1,locupdate2,procname)
-
-      REAL,  DIMENSION(:,:,:,:,:) :: q
-      External :: procname
-      Optional ::  procname
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
-      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
-      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
-      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
-C
-      IF (Agrif_Root()) RETURN
-C      
-      indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif 
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      parenttabvars => tabvars%parent_var
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-       
-      IF (present(locupdate)) THEN
-      tabvars%var % updateinf(1:5) 
-     &      = locupdate(1)
-      tabvars%var % updatesup(1:5) 
-     &      = locupdate(2)
-      ELSE
-      tabvars%var % updateinf(1:5) 
-     &      = -99
-      tabvars%var % updatesup(1:5) 
-     &      = -99
-      ENDIF
-      
-      IF (present(locupdate1)) THEN
-      tabvars%var % updateinf(1) 
-     &      = locupdate1(1)
-      tabvars%var % updatesup(1) 
-     &      = locupdate1(2)
-      ENDIF  
-      
-      IF (present(locupdate2)) THEN
-      tabvars%var % updateinf(2) 
-     &      = locupdate2(1)
-      tabvars%var % updatesup(2) 
-     &      = locupdate2(2)
-      ENDIF
-
-      IF (present(procname)) THEN
-      Call Agrif_Update_5D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup,
-     & procname)
-      ELSE 
-      Call Agrif_Update_5D(
-     & roottabvars % var % typeupdate,
-     & parenttabvars,
-     & tabvars,q,
-     & tabvars % var % updateinf,
-     & tabvars % var % updatesup)       
-      ENDIF
-
-      Return
-      End Subroutine Agrif_update_var5d  
-          
-      Subroutine Agrif_Declare_Flux(fluxname,profilename) 
-      character*(*) :: fluxname, profilename
-      Type(Agrif_Flux), pointer :: newflux
-      Type(Agrif_Profile), pointer  :: parcours
-      logical :: foundprofile
-      integer :: i,j,n
-            
-      foundprofile = .FALSE.
-      parcours => Agrif_Myprofiles
-      
-      Do While (Associated(parcours))
-         IF (parcours % profilename == profilename) THEN
-           foundprofile = .TRUE.
-           EXIT
-         ENDIF
-         parcours => parcours%nextprofile
-      End Do      
-      
-      IF (.NOT.foundprofile) THEN
-      write(*,*) 'The profile '''
-     &           //TRIM(profilename)//''' has not been declared'  
-      stop    
-      ENDIF
-      
-      Allocate(Newflux)
-      
-      Newflux % fluxname = fluxname
-      
-      Newflux % profile => parcours
-      
-      Newflux % nextflux => Agrif_Curgrid % fluxes
-      
-      Agrif_Curgrid % fluxes => Newflux
-      
-      End Subroutine Agrif_Declare_Flux  
-       
-      Subroutine Agrif_Save_Flux(fluxname, fluxtab)
-      character*(*) :: fluxname
-      REAL, DIMENSION(:,:) :: fluxtab
-      
-      
-      Type(Agrif_Flux), pointer :: Flux
-      
-      Type(Agrif_pgrid), pointer :: parcours_child
-      
-      Type(Agrif_grid), Pointer :: currentgrid,oldcurgrid
-      
-      IF (.Not.Agrif_Root()) THEN
-      Flux => Agrif_Search_Flux(fluxname)
-
-      IF (.NOT.Flux%fluxallocated) THEN
-        CALL Agrif_AllocateFlux(Flux,fluxtab)
-      ENDIF
-      
-      Call Agrif_Save_Fluxtab(Flux,fluxtab)
-      
-      ENDIF
-      
-      oldcurgrid=> Agrif_Curgrid
-      
-      parcours_child => Agrif_Curgrid%child_grids
-      
-      Do While (Associated(parcours_child))
-        currentgrid => parcours_child%gr
-        Agrif_Curgrid => parcours_child%gr
-        Flux => Agrif_Search_Flux(fluxname)
-        IF (.NOT.Flux%fluxallocated) THEN
-          CALL Agrif_AllocateFlux(Flux,fluxtab)
-        ENDIF        
-        Call Agrif_Save_Fluxtab_child(Flux,fluxtab)
-        parcours_child=> parcours_child%next
-      End Do
-      
-      Agrif_Curgrid=>oldcurgrid
-      
-      End Subroutine Agrif_Save_Flux
-
-      Subroutine Agrif_Cancel_Flux(fluxname)
-      character*(*) :: fluxname
-      
-      Type(Agrif_Flux), pointer :: Flux
-      
-      Flux => Agrif_Search_Flux(fluxname)
-
-      IF (Flux%FluxAllocated) Call Agrif_Cancel_Fluxarray(Flux)
-      
-      End Subroutine Agrif_Cancel_Flux
- 
-      Subroutine Agrif_Flux_Correction(fluxname, procname)
-      character*(*) :: fluxname
-      external :: procname
-      
-      Type(Agrif_Flux), pointer :: Flux
-      
-      Flux => Agrif_Search_Flux(fluxname)
-      
-      Call Agrif_FluxCorrect(Flux, procname)
-
-      
-      End Subroutine Agrif_Flux_Correction
-
-
-      
-      Subroutine Agrif_Declare_Profile_flux(profilename,posvar,
-     &    firstpoint,raf)
-      character*(*) :: profilename
-      Type(Agrif_Profile), Pointer :: newprofile
-      INTEGER, DIMENSION(:) :: posvar
-      INTEGER, DIMENSION(:) :: firstpoint
-      CHARACTER(*) ,DIMENSION(:) :: raf      
-      INTEGER :: dimensio
-            
-      dimensio = SIZE(posvar)
-C
-C    
-      Allocate(newprofile)
-      Allocate(newprofile%posvar(dimensio))
-      Allocate(newprofile%interptab(dimensio))
-      newprofile%profilename = profilename
-      newprofile%interptab = raf
-      newprofile%nbdim = dimensio
-      newprofile%posvar = posvar
-      newprofile%point(1:dimensio) = firstpoint
-      
-      newprofile % nextprofile => Agrif_myprofiles
-      
-      Agrif_myprofiles => newprofile
-      
-      End Subroutine Agrif_Declare_Profile_flux
-
-      Subroutine Agrif_Save_ForRestore0D(tabvarsindic0,tabvarsindic)
-      integer :: tabvarsindic0, tabvarsindic
-      integer :: dimensio
-              
-      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic0) % var % nbdim
-      
-      select case(dimensio)
-      case(2)
-          call Agrif_Save_ForRestore2D(
-     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2,
-     &      tabvarsindic)
-      case(3)
-          call Agrif_Save_ForRestore3D(
-     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3,
-     &      tabvarsindic)
-      case(4)
-          call Agrif_Save_ForRestore4D(
-     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4,
-     &      tabvarsindic)     
-      end select
-
-      Return
-      End Subroutine Agrif_Save_ForRestore0D 
-      
-    
-      
-      Subroutine Agrif_Save_ForRestore2D(q,tabvarsindic)
-      real,dimension(:,:) :: q
-      integer :: tabvarsindic, indic
-      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
- 
-       indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif      
-      if (.not.allocated(tabvars%var%array2)) then      
-      allocate(tabvars%var%array2(tabvars%var%lb(1):tabvars%var%ub(1),
-     &                            tabvars%var%lb(2):tabvars%var%ub(2)))
-      endif
-      tabvars%var%array2 = q
-      roottabvars%var%restaure = .true.
-      
-      Return
-      End Subroutine Agrif_Save_ForRestore2D  
-      
-      Subroutine Agrif_Save_ForRestore3D(q,tabvarsindic)
-      real,dimension(:,:,:) :: q
-      integer :: tabvarsindic, indic
-      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
- 
-       indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif      
-
-      if (.not.allocated(tabvars%var%array3)) then
-      allocate(tabvars%var%array3(tabvars%var%lb(1):tabvars%var%ub(1),
-     &                            tabvars%var%lb(2):tabvars%var%ub(2),
-     &                            tabvars%var%lb(3):tabvars%var%ub(3)))
-      endif
-      tabvars%var%array3 = q
-      roottabvars%var%restaure = .true.
-      
-      Return
-      End Subroutine Agrif_Save_ForRestore3D
-      
-      Subroutine Agrif_Save_ForRestore4D(q,tabvarsindic)
-      real,dimension(:,:,:,:) :: q
-      integer :: tabvarsindic, indic
-      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
- 
-       indic = tabvarsindic
-      if (tabvarsindic >=0) then
-        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
-          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
-        endif
-      endif
-      
-      if (indic <=0) then
-      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-      else
-      tabvars=>Agrif_Curgrid % tabvars(indic)
-      roottabvars => Agrif_Mygrid % tabvars(indic)
-      endif
-
-      if (.not.allocated(tabvars%var%array4)) then         
-      allocate(tabvars%var%array4(tabvars%var%lb(1):tabvars%var%ub(1),
-     &                            tabvars%var%lb(2):tabvars%var%ub(2),
-     &                            tabvars%var%lb(3):tabvars%var%ub(3),
-     &                            tabvars%var%lb(4):tabvars%var%ub(4)))
-      endif
-      tabvars%var%array4 = q
-      roottabvars%var%restaure = .true.
-      
-      Return
-      End Subroutine Agrif_Save_ForRestore4D                   
-C
-      End module Agrif_bcfunction
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90	(revision 5682)
@@ -0,0 +1,680 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+!
+!> Module Agrif_BcFunction.
+!
+module Agrif_BcFunction
+!
+!     Modules used:
+!
+    use Agrif_Boundary
+    use Agrif_Update
+    use Agrif_Save
+!
+    implicit none
+!
+    interface Agrif_Set_Parent
+        module procedure Agrif_Set_Parent_int,      &
+                         Agrif_Set_Parent_real4,    &
+                         Agrif_Set_Parent_real8
+    end interface
+!
+    interface Agrif_Save_Forrestore
+        module procedure Agrif_Save_Forrestore0d,   &
+                         Agrif_Save_Forrestore2d,   &
+                         Agrif_Save_Forrestore3d,   &
+                         Agrif_Save_Forrestore4d
+    end interface
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Set_parent_int
+!
+!> To set the TYPE of the variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_parent_int(tabvarsindic,value)
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
+    integer, intent(in)     :: value        !< input value
+!
+    Agrif_Curgrid % parent % tabvars_i(tabvarsindic) % iarray0 = value
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_parent_int
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_parent_real4
+!---------------------------------------------------------------------------------------------------
+!> To set the TYPE of the variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_parent_real4 ( tabvarsindic, value )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
+    real(kind=4),intent(in) :: value        !< input value
+!
+    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % array0 = value
+    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % sarray0 = value
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_parent_real4
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_parent_real8
+!---------------------------------------------------------------------------------------------------
+!> To set the TYPE of the variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_parent_real8 ( tabvarsindic, value )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
+    real(kind=8),intent(in) :: value        !< input value
+!
+    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % darray0 = value
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_parent_real8
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_bc
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_bc ( tabvarsindic, bcinfsup, Interpolationshouldbemade )
+!---------------------------------------------------------------------------------------------------
+    integer,               intent(in)   :: tabvarsindic !< indice of the variable in tabvars
+    integer, dimension(2), intent(in)   :: bcinfsup     !< bcinfsup
+    logical, optional,     intent(in)   :: Interpolationshouldbemade !< interpolation should be made
+!
+    integer                         :: indic ! indice of the variable in tabvars
+    type(Agrif_Variable),  pointer  :: var
+!
+    indic = Agrif_Curgrid % tabvars_i(tabvarsindic) % iarray0
+!
+    if (indic <= 0) then
+        var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+    else
+        print*,"Agrif_Set_bc : warning indic >= 0 !!!"
+        var => Agrif_Curgrid % tabvars(indic)
+    endif
+
+    if (.not.associated(var)) return ! Grand mother grid case
+!
+    if ( Agrif_Curgrid % fixedrank /= 0 ) then
+        if ( .not.associated(var % oldvalues2D) ) then
+            allocate(var % oldvalues2D(2,1))
+            var % interpIndex = -1
+            var % oldvalues2D = 0.
+        endif
+        if ( present(Interpolationshouldbemade) ) then
+            var % Interpolationshouldbemade = Interpolationshouldbemade
+        endif
+    endif
+!
+    var % bcinf = bcinfsup(1)
+    var % bcsup = bcinfsup(2)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_bc
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_interp
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_interp ( tabvarsindic, interp, interp1, interp2, interp3 , interp4)
+!---------------------------------------------------------------------------------------------------
+    integer,           intent(in)   :: tabvarsindic !< indice of the variable in tabvars
+    integer, optional, intent(in)   :: interp, interp1, interp2, interp3, interp4
+!
+    integer                         :: indic ! indice of the variable in tabvars
+    type(Agrif_Variable), pointer   :: var
+!
+    indic = Agrif_Curgrid % tabvars_i(tabvarsindic) % iarray0
+!
+    if (indic <= 0) then
+        var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        print*,"Agrif_Set_interp : warning indic >= 0 !!!"
+        var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    var % type_interp = Agrif_Constant
+!
+    if (present(interp))    var % type_interp    = interp
+    if (present(interp1))   var % type_interp(1) = interp1
+    if (present(interp2))   var % type_interp(2) = interp2
+    if (present(interp3))   var % type_interp(3) = interp3
+    if (present(interp4))   var % type_interp(4) = interp4
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_interp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_bcinterp
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_bcinterp ( tabvarsindic, interp,   interp1,  interp2,  interp3, interp4, &
+                                              interp11, interp12, interp21, interp22 )
+!---------------------------------------------------------------------------------------------------
+    INTEGER,           intent(in)   :: tabvarsindic !< indice of the variable in tabvars
+    INTEGER, OPTIONAL, intent(in)   :: interp,   interp1,  interp2,  interp3, interp4
+    INTEGER, OPTIONAL, intent(in)   :: interp11, interp12, interp21, interp22
+!
+    INTEGER                         :: indic ! indice of the variable in tabvars
+    TYPE(Agrif_Variable), pointer   :: var
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if (indic <= 0) then
+        var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        print*,"Agrif_Set_bcinterp : warning indic >= 0 !!!"
+        var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    var % type_interp_bc = Agrif_Constant
+!
+    if (present(interp))    var % type_interp_bc      = interp
+    if (present(interp1))   var % type_interp_bc(:,1) = interp1
+    if (present(interp11))  var % type_interp_bc(1,1) = interp11
+    if (present(interp12))  var % type_interp_bc(1,2) = interp12
+    if (present(interp2))   var % type_interp_bc(:,2) = interp2
+    if (present(interp21))  var % type_interp_bc(2,1) = interp21
+    if (present(interp22))  var % type_interp_bc(2,2) = interp22
+    if (present(interp3))   var % type_interp_bc(:,3) = interp3
+    if (present(interp4))   var % type_interp_bc(:,4) = interp4
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_bcinterp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_UpdateType
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_UpdateType ( tabvarsindic, update,  update1, update2, &
+                                                update3, update4, update5 )
+!---------------------------------------------------------------------------------------------------
+    INTEGER,           intent(in) :: tabvarsindic     !< indice of the variable in tabvars
+    INTEGER, OPTIONAL, intent(in) :: update, update1, update2, update3, update4, update5
+!
+    INTEGER                         :: indic ! indice of the variable in tabvars
+    type(Agrif_Variable),  pointer  :: root_var
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if (indic <= 0) then
+        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        print*,"Agrif_Set_UpdateType : warning indic >= 0 !!!"
+        root_var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    root_var % type_update = Agrif_Update_Copy
+    if (present(update))    root_var % type_update    = update
+    if (present(update1))   root_var % type_update(1) = update1
+    if (present(update2))   root_var % type_update(2) = update2
+    if (present(update3))   root_var % type_update(3) = update3
+    if (present(update4))   root_var % type_update(4) = update4
+    if (present(update5))   root_var % type_update(5) = update5
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_UpdateType
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_restore
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_restore ( tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, intent(in) :: tabvarsindic     !< indice of the variable in tabvars
+!
+    INTEGER :: indic  !  indice of the variable in tabvars
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    Agrif_Mygrid%tabvars(indic) % restore = .TRUE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_restore
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Init_variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Init_variable ( tabvarsindic, procname )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, intent(in)  :: tabvarsindic     !< indice of the variable in tabvars
+    procedure()          :: procname         !< Data recovery procedure
+!
+    if ( Agrif_Curgrid%level <= 0 ) return
+!
+    call Agrif_Interp_variable(tabvarsindic, procname)
+    call Agrif_Bc_variable(tabvarsindic, procname, 1.)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_variable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Bc_variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Bc_variable ( tabvarsindic, procname, calledweight )
+!---------------------------------------------------------------------------------------------------
+    integer,        intent(in) :: tabvarsindic     !< indice of the variable in tabvars
+    procedure()                :: procname
+    real, optional, intent(in) :: calledweight
+!
+    real    :: weight
+    logical :: pweight
+    integer :: indic
+    integer :: nbdim
+    type(Agrif_Variable), pointer :: root_var
+    type(Agrif_Variable), pointer :: parent_var
+    type(Agrif_Variable), pointer :: child_var
+    type(Agrif_Variable), pointer :: child_tmp      ! Temporary variable on the child grid
+!
+    if ( Agrif_Curgrid%level <= 0 ) return
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if ( present(calledweight) ) then
+        weight  = calledweight
+        pweight = .true.
+    else
+        weight  = 0.
+        pweight = .false.
+    endif
+!
+    if (indic <= 0) then
+        child_var  => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        parent_var => child_var % parent_var
+        root_var   => child_var % root_var
+    else
+        print*,"Agrif_Bc_variable : warning indic >= 0 !!!"
+        child_var  => Agrif_Curgrid % tabvars(indic)
+        parent_var => Agrif_Curgrid % parent % tabvars(indic)
+        root_var   => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    nbdim = root_var % nbdim
+!
+    select case( nbdim )
+    case(1)
+        allocate(parray1(child_var%lb(1):child_var%ub(1)))
+    case(2)
+        allocate(parray2(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2) ))
+    case(3)
+        allocate(parray3(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2), &
+                         child_var%lb(3):child_var%ub(3) ))
+    case(4)
+        allocate(parray4(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2), &
+                         child_var%lb(3):child_var%ub(3), &
+                         child_var%lb(4):child_var%ub(4) ))
+    case(5)
+        allocate(parray5(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2), &
+                         child_var%lb(3):child_var%ub(3), &
+                         child_var%lb(4):child_var%ub(4), &
+                         child_var%lb(5):child_var%ub(5) ))
+    case(6)
+        allocate(parray6(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2), &
+                         child_var%lb(3):child_var%ub(3), &
+                         child_var%lb(4):child_var%ub(4), &
+                         child_var%lb(5):child_var%ub(5), &
+                         child_var%lb(6):child_var%ub(6) ))
+    end select
+!
+!   Create temporary child variable
+    allocate(child_tmp)
+!
+    child_tmp % root_var => root_var
+    child_tmp % oldvalues2D => child_var % oldvalues2D
+!
+!   Index indicating if a space interpolation is necessary
+    child_tmp % interpIndex =  child_var % interpIndex
+    child_tmp % list_interp => child_var % list_interp
+    child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade
+!
+    child_tmp % point = child_var % point
+    child_tmp % lb = child_var % lb
+    child_tmp % ub = child_var % ub
+!
+    child_tmp % bcinf = child_var % bcinf
+    child_tmp % bcsup = child_var % bcsup
+!
+    child_tmp % childarray = child_var % childarray
+    child_tmp % memberin   = child_var % memberin
+!
+    call Agrif_CorrectVariable(parent_var, child_tmp, pweight, weight, procname)
+!
+    child_var % childarray = child_tmp % childarray
+    child_var % memberin   = child_tmp % memberin
+!
+    child_var % oldvalues2D => child_tmp % oldvalues2D
+    child_var % list_interp => child_tmp % list_interp
+!
+    child_var % interpIndex = child_tmp % interpIndex
+!
+    deallocate(child_tmp)
+!
+    select case( nbdim )
+        case(1); deallocate(parray1)
+        case(2); deallocate(parray2)
+        case(3); deallocate(parray3)
+        case(4); deallocate(parray4)
+        case(5); deallocate(parray5)
+        case(6); deallocate(parray6)
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Bc_variable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_variable ( tabvarsindic, procname )
+!---------------------------------------------------------------------------------------------------
+    integer,     intent(in)     :: tabvarsindic     !< indice of the variable in tabvars
+    procedure()                 :: procname         !< Data recovery procedure
+!
+    integer :: nbdim
+    integer :: indic  ! indice of the variable in tabvars
+    logical :: torestore
+    type(Agrif_Variable), pointer   :: root_var
+    type(Agrif_Variable), pointer   :: parent_var       ! Variable on the parent grid
+    type(Agrif_Variable), pointer   :: child_var        ! Variable on the parent grid
+    type(Agrif_Variable), pointer   :: child_tmp        ! Temporary variable on the child grid
+!
+    if ( Agrif_Curgrid%level <= 0 ) return
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if (indic <= 0) then
+        child_var  => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        parent_var => child_var % parent_var
+        root_var   => child_var % root_var
+    else
+        print*,"Agrif_Interp_variable : warning indic >= 0 !!!"
+        child_var  => Agrif_Curgrid % tabvars(indic)
+        parent_var => Agrif_Curgrid % parent % tabvars(indic)
+        root_var   => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    nbdim     = root_var % nbdim
+    torestore = root_var % restore
+!
+    allocate(child_tmp)
+!
+    child_tmp % root_var => root_var
+    child_tmp % nbdim = root_var % nbdim
+    child_tmp % point = child_var % point
+    child_tmp % lb = child_var % lb
+    child_tmp % ub = child_var % ub
+    child_tmp % interpIndex =  child_var % interpIndex
+    child_tmp % list_interp => child_var % list_interp
+    child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade
+!
+    if ( torestore ) then
+        select case( nbdim )
+        case(1)
+            parray1 = child_var % array1
+            child_tmp % restore1D => child_var % restore1D
+        case(2)
+            parray2 = child_var % array2
+            child_tmp % restore2D => child_var % restore2D
+        case(3)
+            parray3 = child_var % array3
+            child_tmp % restore3D => child_var % restore3D
+        case(4)
+            parray4 = child_var % array4
+            child_tmp % restore4D => child_var % restore4D
+        case(5)
+            parray5 = child_var % array5
+            child_tmp % restore5D => child_var % restore5D
+        case(6)
+            parray6 = child_var % array6
+            child_tmp % restore6D => child_var % restore6D
+        end select
+    endif
+!
+    call Agrif_InterpVariable(parent_var, child_tmp, torestore, procname)
+!
+    child_var % list_interp => child_tmp % list_interp
+!
+    deallocate(child_tmp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_variable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_Variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_Variable ( tabvarsindic, procname, &
+                                   locupdate, locupdate1, locupdate2, locupdate3, locupdate4 )
+!---------------------------------------------------------------------------------------------------
+    integer,               intent(in)           :: tabvarsindic     !< Indice of the variable in tabvars
+    procedure()                                 :: procname         !< Data recovery procedure
+    integer, dimension(2), intent(in), optional :: locupdate
+    integer, dimension(2), intent(in), optional :: locupdate1
+    integer, dimension(2), intent(in), optional :: locupdate2
+    integer, dimension(2), intent(in), optional :: locupdate3
+    integer, dimension(2), intent(in), optional :: locupdate4
+!---------------------------------------------------------------------------------------------------
+    integer :: indic
+    integer :: nbdim
+    integer, dimension(6)           :: updateinf    ! First positions where interpolations are calculated
+    integer, dimension(6)           :: updatesup    ! Last  positions where interpolations are calculated
+    type(Agrif_Variable), pointer   :: root_var
+    type(Agrif_Variable), pointer   :: parent_var
+    type(Agrif_Variable), pointer   :: child_var
+!
+    if ( Agrif_Root() .AND. (.not.agrif_coarse) ) return
+    if (agrif_curgrid%grand_mother_grid) return
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if (indic <= 0) then
+        child_var  => Agrif_Search_Variable(Agrif_Curgrid, -indic)
+        parent_var => child_var % parent_var
+
+        if (.not.associated(parent_var)) then
+          ! can occur during the first update of Agrif_Coarsegrid (if any)
+          parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, -indic)
+          child_var % parent_var => parent_var
+        endif
+
+        root_var   => child_var % root_var
+    else
+        print*,"Agrif_Update_Variable : warning indic >= 0 !!!"
+        root_var   => Agrif_Mygrid  % tabvars(indic)
+        child_var  => Agrif_Curgrid % tabvars(indic)
+        parent_var => Agrif_Curgrid % parent % tabvars(indic)
+    endif
+!
+    nbdim = root_var % nbdim
+!
+    updateinf = -99
+    updatesup = -99
+!
+    if ( present(locupdate) ) then
+        updateinf(1:nbdim) = locupdate(1)
+        updatesup(1:nbdim) = locupdate(2)
+    endif
+!
+    if ( present(locupdate1) ) then
+        updateinf(1) = locupdate1(1)
+        updatesup(1) = locupdate1(2)
+    endif
+!
+    if ( present(locupdate2) ) then
+        updateinf(2) = locupdate2(1)
+        updatesup(2) = locupdate2(2)
+    endif
+
+    if ( present(locupdate3) ) then
+        updateinf(3) = locupdate3(1)
+        updatesup(3) = locupdate3(2)
+    endif
+
+    if ( present(locupdate4) ) then
+        updateinf(4) = locupdate4(1)
+        updatesup(4) = locupdate4(2)
+    endif
+!
+    call Agrif_UpdateVariable( parent_var, child_var, updateinf, updatesup, procname )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_Variable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_ForRestore0D
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Save_ForRestore0D ( tabvarsindic0, tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: tabvarsindic0, tabvarsindic
+!
+    type(Agrif_Variable), pointer   :: root_var, save_var
+    integer :: nbdim
+!
+    root_var => Agrif_Mygrid % tabvars(tabvarsindic0)
+    save_var => Agrif_Curgrid % tabvars(tabvarsindic0)
+    nbdim =  root_var % nbdim
+!
+    select case(nbdim)
+        case(2); call Agrif_Save_ForRestore2D(save_var % array2, tabvarsindic)
+        case(3); call Agrif_Save_ForRestore3D(save_var % array3, tabvarsindic)
+        case(4); call Agrif_Save_ForRestore4D(save_var % array4, tabvarsindic)
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_ForRestore0D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_ForRestore2D
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Save_ForRestore2D ( q, tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:), intent(in)        :: q
+    integer,              intent(in)        :: tabvarsindic
+!
+    type(Agrif_Variable),  pointer  :: root_var, save_var
+    integer                         :: indic
+!
+    indic = tabvarsindic
+    if (tabvarsindic >= 0) then
+        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
+            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+        endif
+    endif
+!
+    if (indic <= 0) then
+        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        save_var => Agrif_Curgrid % tabvars(indic)
+        root_var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    if ( .not.allocated(save_var%array2) ) then
+        allocate(save_var%array2(save_var%lb(1):save_var%ub(1),  &
+                                 save_var%lb(2):save_var%ub(2)))
+    endif
+!
+    save_var % array2  = q
+    root_var % restore = .true.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_ForRestore2D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_ForRestore3D
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Save_ForRestore3D ( q, tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:), intent(in)      :: q
+    integer,                intent(in)      :: tabvarsindic
+!
+    type(Agrif_Variable),  pointer  :: root_var, save_var
+    integer                         :: indic
+!
+    indic = tabvarsindic
+    if (tabvarsindic >= 0) then
+        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
+            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+        endif
+    endif
+!
+    if (indic <= 0) then
+        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        save_var => Agrif_Curgrid % tabvars(indic)
+        root_var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    if ( .not.allocated(save_var%array3) ) then
+        allocate(save_var%array3(save_var%lb(1):save_var%ub(1), &
+                                 save_var%lb(2):save_var%ub(2), &
+                                 save_var%lb(3):save_var%ub(3)))
+    endif
+!
+    save_var % array3  = q
+    root_var % restore = .true.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_ForRestore3D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_ForRestore4D
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Save_ForRestore4D ( q, tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:,:), intent(in)    :: q
+    integer,                  intent(in)    :: tabvarsindic
+!
+    type(Agrif_Variable),  pointer  :: root_var, save_var
+    integer                         :: indic
+!
+    indic = tabvarsindic
+    if (tabvarsindic >= 0) then
+        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
+            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+        endif
+    endif
+!
+    if (indic <= 0) then
+        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        save_var => Agrif_Curgrid % tabvars(indic)
+        root_var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    if (.not.allocated(save_var%array4)) then
+        allocate(save_var%array4(save_var%lb(1):save_var%ub(1),&
+                                 save_var%lb(2):save_var%ub(2),&
+                                 save_var%lb(3):save_var%ub(3),&
+                                 save_var%lb(4):save_var%ub(4)))
+    endif
+!
+    save_var % array4  = q
+    root_var % restore = .true.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_ForRestore4D
+!===================================================================================================
+!
+end module Agrif_BcFunction
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F	(revision 5659)
+++ 	(revision )
@@ -1,1452 +1,0 @@
-!
-! $Id$
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module AGRIF_Clustering  
-C
-C
-      Module Agrif_Clustering 
-C
-CCC   Description:
-CCC   Module to create and initialize the grid hierarchy from the 
-CCC   AGRIF_FixedGrids.in file.
-C
-C     Modules used:
-C  
-      Use Agrif_Curgridfunctions 
-      Use Agrif_Init_Vars
-      Use Agrif_Save
-C             
-      IMPLICIT NONE
-C        
-      Contains 
-C     Define procedures contained in this module
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Cluster_All  
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Cluster_All(g,coarsegrid)
-C
-CCC   Description:
-CCC   Subroutine for the clustering. A temporary grid hierarchy, pointed by 
-CCC   coarsegrid, is created.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C     Pointer arguments    
-      TYPE(AGRIF_grid)     ,pointer   :: g        ! Pointer on the current grid
-      TYPE(AGRIF_rectangle),pointer   :: coarsegrid
-C      
-C     Local pointer         
-      TYPE(AGRIF_lrectangle),pointer  :: parcours 
-      TYPE(AGRIF_grid)      ,pointer  :: newgrid 
-      REAL                            :: g_eps
-      INTEGER                         :: iii
-C      
-      g_eps = huge(1.)
-      do iii = 1 , Agrif_Probdim
-         g_eps = min(g_eps,g%Agrif_d(iii))
-      enddo
-C
-      g_eps = g_eps/100.                  
-C
-C     Necessary condition for clustering 
-      do iii = 1 , Agrif_Probdim
-         if (g%Agrif_d(iii)/Agrif_coeffref(iii).LT.
-     &                   (Agrif_mind(iii)-g_eps)) Return
-      enddo
-C
-      Nullify(coarsegrid%childgrids)
-C
-      Call Agrif_ClusterGridnD(g,coarsegrid) 
-C
-      parcours => coarsegrid % childgrids                   
-C      
-      do while (associated(parcours))
-C      
-C       Newgrid is created. It is a copy of a fine grid created previously by
-C          clustering.      
-        Allocate(newgrid)
-C      
-        Nullify(newgrid%child_grids)
-C
-        do iii = 1 , Agrif_Probdim
-           newgrid % nb(iii) = (parcours % r % imax(iii) - 
-     &                          parcours % r % imin(iii)) *
-     &                          Agrif_Coeffref(iii)
-C        
-           newgrid % Agrif_x(iii) = g%Agrif_x(iii) + 
-     &                         (parcours %r % imin(iii) -1) 
-     &                         *g%Agrif_d(iii)
-C 
-           newgrid % Agrif_d(iii) = g%Agrif_d(iii) / Agrif_Coeffref(iii)
-C
-        enddo
-C
-        if ( Agrif_Probdim .EQ. 1 ) then
-           allocate(newgrid%tabpoint1D(newgrid%nb(1)+1))
-           newgrid%tabpoint1D = 0
-        endif
-C
-        if ( Agrif_Probdim .EQ. 2 ) then
-           allocate(newgrid%tabpoint2D(newgrid%nb(1)+1,
-     &                                 newgrid%nb(2)+1))
-           newgrid%tabpoint2D = 0      
-        endif
-C
-        if ( Agrif_Probdim .EQ. 3 ) then
-           allocate(newgrid%tabpoint3D(newgrid%nb(1)+1,
-     &                                 newgrid%nb(2)+1,
-     &                                 newgrid%nb(3)+1))
-           newgrid%tabpoint3D = 0
-        endif
-C       Points detection on newgrid
-        Call Agrif_TabpointsnD(Agrif_mygrid,newgrid) 
-C
-C       Recursive call to Agrif_Cluster_All            
-        Call Agrif_Cluster_All (newgrid, parcours % r)     
-C
-        parcours => parcours % next 
-C      
-        if ( Agrif_Probdim .EQ. 1 ) Deallocate(newgrid%tabpoint1D)
-        if ( Agrif_Probdim .EQ. 2 ) Deallocate(newgrid%tabpoint2D)
-        if ( Agrif_Probdim .EQ. 3 ) Deallocate(newgrid%tabpoint3D)
-C
-        Deallocate(newgrid)   
-C
-      enddo
-C
-C      
-      End Subroutine Agrif_Cluster_All
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_TabpointsnD
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_TabpointsnD(g,newgrid)
-C
-CCC   Description:
-CCC   Copy on newgrid of points detected on the grid hierarchy pointed by g.   
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C     Arguments
-      TYPE(Agrif_Grid),pointer   :: g,newgrid
-C
-C     Local variables      
-      TYPE(Agrif_Pgrid),pointer  :: parcours
-C
-      REAL                  :: g_eps,newgrid_eps,eps
-      REAL   , DIMENSION(3) :: newmin,newmax
-      REAL   , DIMENSION(3) :: gmin,gmax
-      REAL   , DIMENSION(3) :: xmin
-      INTEGER, DIMENSION(3) :: igmin,inewmin
-      INTEGER, DIMENSION(3) :: inewmax
-      INTEGER               :: iii
-      INTEGER               :: i,j,k
-      INTEGER               :: i0,j0,k0
-C
-C     
-      parcours => g % child_grids
-C
-      do While(associated(parcours))
-        Call Agrif_TabpointsnD(parcours%gr,newgrid)
-        parcours => parcours % next
-      enddo      
-C
-      g_eps = 10.
-      newgrid_eps = 10.
-C      
-      do iii = 1 , Agrif_probdim
-         g_eps = min( g_eps , g % Agrif_d(iii) )
-         newgrid_eps = min(newgrid_eps,newgrid%Agrif_d(iii))
-      enddo
-C
-      eps = min(g_eps,newgrid_eps)/100.                  
-C                   
-      do iii = 1 , Agrif_probdim
-         if (newgrid%Agrif_d(iii) .LT. (g%Agrif_d(iii)-eps)) Return
-C                   
-         gmin(iii) = g%Agrif_x(iii)
-         gmax(iii) = g%Agrif_x(iii) + g%nb(iii) * g%Agrif_d(iii)
-C 
-         newmin(iii) = newgrid%Agrif_x(iii)
-         newmax(iii) = newgrid%Agrif_x(iii) + newgrid%nb(iii) *
-     &                 newgrid%Agrif_d(iii)
-C      
-         if (gmax(iii) .LT. newmin(iii)) Return
-C
-         if (gmin(iii) .GT. newmax(iii)) Return
-C           
-         inewmin(iii) = 1 - floor(-(max(gmin(iii),newmin(iii))-
-     &                    newmin(iii))
-     &                   /newgrid%Agrif_d(iii)) 
-C          
-         xmin(iii) = newgrid%Agrif_x(iii) + (inewmin(iii)-1)*
-     &              newgrid%Agrif_d(iii)          
-C        
-         igmin(iii) = 1 + nint((xmin(iii)-gmin(iii))/g%Agrif_d(iii))
-C
-         inewmax(iii) = 1 + int((min(gmax(iii),newmax(iii))-
-     &                  newmin(iii))/newgrid%Agrif_d(iii))
-      enddo
-C                
-      if ( Agrif_probdim .EQ. 1 ) then
-         i0 = igmin(1)
-         do i = inewmin(1),inewmax(1)
-            newgrid%tabpoint1D(i) = max(
-     &                           newgrid%tabpoint1D(i),
-     &                           g%tabpoint1D(i0))
-         enddo
-         i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
-      endif
-C
-      if ( Agrif_probdim .EQ. 2 ) then
-         i0 = igmin(1)
-         do i = inewmin(1),inewmax(1)
-            j0 = igmin(2)
-            do j = inewmin(2),inewmax(2)
-               newgrid%tabpoint2D(i,j) = max(
-     &                           newgrid%tabpoint2D(i,j),
-     &                           g%tabpoint2D(i0,j0))
-               j0 = j0 + int(newgrid%Agrif_d(2)/g%Agrif_d(2))
-            enddo
-            i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
-         enddo
-      endif
-C
-      if ( Agrif_probdim .EQ. 3 ) then
-         i0 = igmin(1)
-         do i = inewmin(1),inewmax(1)
-            j0 = igmin(2)
-            do j = inewmin(2),inewmax(2)
-               k0 = igmin(3)
-               do k = inewmin(3),inewmax(3)
-                  newgrid%tabpoint3D(i,j,k) = max(
-     &                           newgrid%tabpoint3D(i,j,k),
-     &                           g%tabpoint3D(i0,j0,k0))
-                  k0 = k0 + int(newgrid%Agrif_d(3)/g%Agrif_d(3))
-               enddo                                        
-               j0 = j0 + int(newgrid%Agrif_d(2)/g%Agrif_d(2))
-            enddo
-            i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
-         enddo
-      endif
-C
-      Return
-C
-C
-      End Subroutine Agrif_TabpointsnD
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_ClusterGridnD
-C     **************************************************************************
-C      
-      Subroutine Agrif_ClusterGridnD(g,coarsegrid)
-C
-CCC   Description:
-CCC   Clustering on the grid pointed by g.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C     Pointer arguments
-      TYPE(AGRIF_grid)     ,pointer  :: g          ! Pointer on the current grid
-      TYPE(AGRIF_rectangle),pointer  :: coarsegrid
-C
-C     Local variables      
-      TYPE(Agrif_rectangle) :: newrect
-      TYPE(Agrif_Variable)  :: newflag
-C
-      INTEGER               :: i,j,k
-      INTEGER ,DIMENSION(3) :: sx
-      INTEGER               :: bufferwidth,flagpoints
-      INTEGER               :: n1,n2,m1,m2,o1,o2
-      INTEGER               :: iii
-C
-C      
-      bufferwidth = int(Agrif_Minwidth/5.)
-C      
-      do iii = 1 , Agrif_probdim
-         sx(iii) = g % nb(iii) + 1
-      enddo
-C                  
-      if ( Agrif_probdim .EQ. 1 ) then
-         allocate(newflag%iarray1(sx(1)))
-         newflag%iarray1 = 0      
-      endif
-      if ( Agrif_probdim .EQ. 2 ) then
-         allocate(newflag%iarray2(sx(1),sx(2)))
-         newflag%iarray2 = 0      
-      endif
-      if ( Agrif_probdim .EQ. 3 ) then
-         allocate(newflag%iarray3(sx(1),sx(2),sx(3)))
-         newflag%iarray3 = 0      
-      endif
-C
-      flagpoints = 0 
-C      
-      if (bufferwidth>0) then 
-C      
-         if ( Agrif_probdim .EQ. 1 ) then
-            do i = bufferwidth,sx(1)-bufferwidth+1      
-               if (g % tabpoint1D(i) .EQ. 1) then
-                  m1 = i - bufferwidth + 1
-                  m2 = i + bufferwidth - 1                  
-                  flagpoints = flagpoints + 1
-                  newflag%iarray1(m1:m2)=1 
-               endif 
-            enddo    
-         endif
-C
-        if ( Agrif_probdim .EQ. 2 ) then
-           do i = bufferwidth,sx(1)-bufferwidth+1      
-               do j = bufferwidth,sx(2)-bufferwidth+1
-                  if (g % tabpoint2D(i,j) .EQ. 1) then
-                     n1 = j - bufferwidth + 1
-                     n2 = j + bufferwidth - 1
-                     m1 = i - bufferwidth + 1
-                     m2 = i + bufferwidth - 1                  
-                     flagpoints = flagpoints + 1
-                     newflag%iarray2(m1:m2,n1:n2)=1 
-                  endif  
-               enddo    
-            enddo
-         endif
-C
-        if ( Agrif_probdim .EQ. 3 ) then
-            do i = bufferwidth,sx(1)-bufferwidth+1      
-               do j = bufferwidth,sx(2)-bufferwidth+1
-                  do k = bufferwidth,sx(3)-bufferwidth+1
-                     if (g % tabpoint3D(i,j,k) .EQ. 1) then
-                        o1 = k - bufferwidth + 1
-                        o2 = k + bufferwidth - 1
-                        n1 = j - bufferwidth + 1
-                        n2 = j + bufferwidth - 1
-                        m1 = i - bufferwidth + 1
-                        m2 = i + bufferwidth - 1                  
-                        flagpoints = flagpoints + 1
-                        newflag%iarray3(m1:m2,n1:n2,o1:o2)=1 
-                     endif 
-                  enddo  
-               enddo    
-            enddo
-        endif
-      else
-          flagpoints = 1       
-C
-          if ( Agrif_probdim .EQ. 1 ) then
-          newflag%iarray1 = g % tabpoint1D
-          endif
-          if ( Agrif_probdim .EQ. 2 ) then
-          newflag%iarray2 = g % tabpoint2D
-          endif
-          if ( Agrif_probdim .EQ. 3 ) then
-          newflag%iarray3 = g % tabpoint3D
-          endif
-      endif
-C       
-      if (flagpoints .EQ. 0) then       
-          if ( Agrif_probdim .EQ. 1 ) deallocate(newflag%iarray1) 
-          if ( Agrif_probdim .EQ. 2 ) deallocate(newflag%iarray2) 
-          if ( Agrif_probdim .EQ. 3 ) deallocate(newflag%iarray3) 
-          Return 
-      endif       
-C      
-      do iii = 1 , Agrif_probdim
-         newrect % imin(iii) = 1
-         newrect % imax(iii) = sx(iii)
-      enddo
-C      
-      Call Agrif_Clusternd(newflag,
-     &                     coarsegrid%childgrids,newrect) 
-C      
-      if ( Agrif_probdim .EQ. 1 ) deallocate(newflag%iarray1)
-      if ( Agrif_probdim .EQ. 2 ) deallocate(newflag%iarray2)
-      if ( Agrif_probdim .EQ. 3 ) deallocate(newflag%iarray3)
-C  
-C    
-      End Subroutine Agrif_ClusterGridnD
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_ClusternD
-C     **************************************************************************
-C
-      Recursive subroutine Agrif_Clusternd(flag,boxlib,oldB) 
-C
-CCC   Description:
-CCC   Clustering on the grid pointed by oldB.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C     Arguments  
-      TYPE(Agrif_rectangle) ::  oldB    
-      TYPE(Agrif_Variable)  :: flag
-c      INTEGER,DIMENSION(oldB%imin(1):oldB%imax(1),
-c     &                  oldB%imin(2):oldB%imax(2)) :: flag
-      TYPE(Agrif_lrectangle),pointer :: boxlib      
-C
-C     Local variables      
-      TYPE(Agrif_lrectangle),pointer :: tempbox,parcbox,parcbox2       
-      TYPE(Agrif_rectangle) :: newB,newB2
-      INTEGER :: i,j,k,iii
-      INTEGER,DIMENSION(:),allocatable :: i_sig 
-      INTEGER,DIMENSION(:),allocatable :: j_sig       
-      INTEGER,DIMENSION(:),allocatable :: k_sig       
-      INTEGER,DIMENSION(3) :: ipu,ipl
-      INTEGER,DIMENSION(3) :: istr,islice
-      REAL :: cureff
-      REAL :: neweff
-      INTEGER :: ValMax,ValSum,TailleTab
-      INTEGER :: nbpoints,nbpointsflag  
-      LOGICAL :: test
-C          
-      allocate(i_sig(oldB%imin(1):oldB%imax(1)))
-      if ( Agrif_probdim .GE. 2 ) 
-     & allocate(j_sig(oldB%imin(2):oldB%imax(2)))
-      if ( Agrif_probdim .EQ. 3 ) 
-     & allocate(k_sig(oldB%imin(3):oldB%imax(3)))
-C
-      test = .FALSE.
-      do iii = 1 , Agrif_probdim
-         test = test .OR. ( (oldB%imax(iii)-oldB%imin(iii)+1) 
-     &                    .LT. Agrif_Minwidth)
-      enddo
-      if ( test ) Return
-C     
-      if ( Agrif_probdim .EQ. 1 ) i_sig = flag%iarray1
-      if ( Agrif_probdim .EQ. 2 ) then
-         do i = oldB%imin(1),oldB%imax(1)
-           i_sig(i) = SUM(flag%iarray2(i,
-     &                            oldB%imin(2):oldB%imax(2)))
-         enddo
-         do j = oldB%imin(2),oldB%imax(2)
-           j_sig(j) = SUM(flag%iarray2(
-     &                            oldB%imin(1):oldB%imax(1),j))
-         enddo      
-      endif
-      if ( Agrif_probdim .EQ. 3 ) then
-         do i = oldB%imin(1),oldB%imax(1)
-            i_sig(i) = SUM(flag%iarray3(i,
-     &                            oldB%imin(2):oldB%imax(2),
-     &                            oldB%imin(3):oldB%imax(3)))
-         enddo
-         do j = oldB%imin(2),oldB%imax(2)
-            j_sig(j) = SUM(flag%iarray3(
-     &                          oldB%imin(1):oldB%imax(1),j,
-     &                          oldB%imin(3):oldB%imax(3)))
-         enddo
-         do k = oldB%imin(3),oldB%imax(3)
-            k_sig(k) = SUM(flag%iarray3(
-     &                          oldB%imin(1):oldB%imax(1),
-     &                          oldB%imin(2):oldB%imax(2),k))
-         enddo      
-      endif
-C                    
-      do iii = 1 , Agrif_probdim
-         ipl(iii) = oldB%imin(iii)
-         ipu(iii) = oldB%imax(iii)
-      enddo
-C           
-      Call Agrif_Clusterprune(i_sig,ipl(1),ipu(1)) 
-      if ( Agrif_probdim .GE. 2 ) 
-     &   Call Agrif_Clusterprune(j_sig,ipl(2),ipu(2))      
-      if ( Agrif_probdim .EQ. 3 ) 
-     &   Call Agrif_Clusterprune(k_sig,ipl(3),ipu(3))      
-C     
-      test = .TRUE.
-      do iii = 1 , Agrif_probdim
-         test = test .AND. (ipl(iii).EQ.oldB%imin(iii))
-         test = test .AND. (ipu(iii).EQ.oldB%imax(iii))
-      enddo
-      
-      if (.NOT. test) then 
-          do iii = 1 , Agrif_probdim
-             newB%imin(iii) = ipl(iii)
-             newB%imax(iii) = ipu(iii)
-          enddo
-C        
-          if ( Agrif_probdim .EQ. 1 ) 
-     &       nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))   
-          if ( Agrif_probdim .EQ. 2 ) 
-     &       nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1),
-     &                           newB%imin(2):newB%imax(2)))   
-          if ( Agrif_probdim .EQ. 3 ) 
-     &       nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1),
-     &                           newB%imin(2):newB%imax(2),   
-     &                           newB%imin(3):newB%imax(3)))
-C   
-          if ( Agrif_probdim .EQ. 1 ) 
-     &       TailleTab = newB%imax(1)-newB%imin(1)+1
-          if ( Agrif_probdim .EQ. 2 ) 
-     &       TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                   (newB%imax(2)-newB%imin(2)+1)
-          if ( Agrif_probdim .EQ. 3 ) 
-     &       TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                   (newB%imax(2)-newB%imin(2)+1)*
-     &                   (newB%imax(3)-newB%imin(3)+1)
-C
-          neweff = REAL(nbpoints)/TailleTab
-C     
-          if (nbpoints.GT.0) then
-C        
-              if ((neweff .GT .Agrif_efficiency)) then
-                  Call Agrif_Add_Rectangle(newB,boxlib)
-                  Return
-              else
-C            
-                  tempbox => boxlib
-                  newB2 = newB
-                  Call Agrif_Clusternd(flag,
-     &                      boxlib,newB)
-C     
-C                 Compute new efficiency
-C
-                  cureff = neweff
-                  parcbox2 => boxlib
-                  nbpoints = 0
-                  nbpointsflag = 0
-C
-                  do While (associated(parcbox2))
-                    if (associated(parcbox2,tempbox)) Exit
-                    newB = parcbox2%r
-C
-                    if ( Agrif_probdim .EQ. 1 ) Valsum = 
-     &                                 SUM(flag%iarray1(
-     &                                 newB%imin(1):newB%imax(1)))
-                    if ( Agrif_probdim .EQ. 2 ) Valsum = 
-     &                                 SUM(flag%iarray2(
-     &                                 newB%imin(1):newB%imax(1),
-     &                                 newB%imin(2):newB%imax(2)))
-                    if ( Agrif_probdim .EQ. 3 ) Valsum = 
-     &                                 SUM(flag%iarray3(
-     &                                 newB%imin(1):newB%imax(1),
-     &                                 newB%imin(2):newB%imax(2),
-     &                                 newB%imin(3):newB%imax(3)))
-C
-                    nbpointsflag = nbpointsflag + ValSum
-                    if ( Agrif_probdim .EQ. 1 ) 
-     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
-                    if ( Agrif_probdim .EQ. 2 ) 
-     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                             (newB%imax(2)-newB%imin(2)+1)
-                    if ( Agrif_probdim .EQ. 3 ) 
-     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                             (newB%imax(2)-newB%imin(2)+1)*
-     &                             (newB%imax(3)-newB%imin(3)+1)
-                    nbpoints = nbpoints + TailleTab
-                    parcbox2 => parcbox2%next  
-                  enddo  
-C coefficient 1.05 avant 1.15 possibilité de laisser choix à l utilisateur
-                  if  (REAL(nbpointsflag)/REAL(nbpoints)
-     &                 .LT.(1.0001*cureff)) then
-                      parcbox2 => boxlib            
-                      do While (associated(parcbox2))
-                        if (associated(parcbox2,tempbox)) Exit
-                        deallocate(parcbox2%r)
-                        parcbox2 => parcbox2%next             
-                      enddo      
-                      boxlib => tempbox
-                      Call Agrif_Add_Rectangle(newB2,boxlib)
-                      Return
-                  endif
-              endif         
-          endif
-          Return
-      endif 
-C       
-      do iii = 1 , Agrif_Probdim
-         istr(iii) = oldB%imax(iii)
-         islice(iii) = oldB%imin(iii)
-      enddo     
-C      
-      Call Agrif_Clusterslice(i_sig,islice(1),istr(1)) 
-      if ( Agrif_probdim .GE. 2 ) 
-     & Call Agrif_Clusterslice(j_sig,islice(2),istr(2)) 
-      if ( Agrif_probdim .EQ. 3 ) 
-     & Call Agrif_Clusterslice(k_sig,islice(3),istr(3)) 
-C      
-      ValSum = 0
-      do iii = 1 , Agrif_Probdim
-         Valsum = valSum + islice(iii)
-      enddo
-C      
-      if ( Valsum .EQ. -Agrif_Probdim ) then 
-          Call Agrif_Add_Rectangle(oldB,boxlib) 
-          Return 
-      endif 
-C       
-      nullify(tempbox)
-      tempbox => boxlib
-      if ( Agrif_probdim .EQ. 1 ) 
-     &      cureff  = oldB%imax(1)-oldB%imin(1)+1
-      if ( Agrif_probdim .EQ. 2 ) 
-     &      cureff  = (oldB%imax(1)-oldB%imin(1)+1)*
-     &                (oldB%imax(2)-oldB%imin(2)+1)
-      if ( Agrif_probdim .EQ. 3 ) 
-     &       cureff = (oldB%imax(1)-oldB%imin(1)+1)*
-     &                (oldB%imax(2)-oldB%imin(2)+1)*
-     &                (oldB%imax(3)-oldB%imin(3)+1)
-      Nullify(parcbox)
-C 
-      do iii = 1 , Agrif_Probdim
-          newB%imax(iii) = oldB%imax(iii)            
-          newB%imin(iii) = oldB%imin(iii)
-      enddo     
-C
-      ValMax = 0
-      do iii = 1 , Agrif_Probdim
-         ValMax = Max(ValMax,istr(iii))
-      enddo
-C
-      if (istr(1) .EQ. ValMax ) then
-          newB%imax(1) = islice(1)
-          Call Agrif_Add_Rectangle(newB,parcbox)                   
-          newB%imin(1) = islice(1)+1
-          newB%imax(1) = oldB%imax(1)
-          Call Agrif_Add_Rectangle(newB,parcbox)
-      elseif ( Agrif_probdim .GE. 2 ) then
-         if (istr(2) .EQ. ValMax ) then
-            newB%imax(2) = islice(2)
-            Call Agrif_Add_Rectangle(newB,parcbox)
-            newB%imin(2) = islice(2)+1
-            newB%imax(2) = oldB%imax(2)
-            Call Agrif_Add_Rectangle(newB,parcbox)
-         elseif ( Agrif_probdim .EQ. 3 ) then
-            newB%imax(3) = islice(3)
-            Call Agrif_Add_Rectangle(newB,parcbox)
-            newB%imin(3) = islice(3)+1
-            newB%imax(3) = oldB%imax(3)
-            Call Agrif_Add_Rectangle(newB,parcbox)
-         endif
-      endif
-C      
-      do While (associated(parcbox))
-        newB = parcbox%r            
-C
-        if ( Agrif_probdim .EQ. 1 ) nbpoints = 
-     &                                 SUM(flag%iarray1(
-     &                                 newB%imin(1):newB%imax(1)))
-        if ( Agrif_probdim .EQ. 2 ) nbpoints = 
-     &                                 SUM(flag%iarray2(
-     &                                 newB%imin(1):newB%imax(1),
-     &                                 newB%imin(2):newB%imax(2)))
-        if ( Agrif_probdim .EQ. 3 ) nbpoints = 
-     &                                 SUM(flag%iarray3(
-     &                                 newB%imin(1):newB%imax(1),
-     &                                 newB%imin(2):newB%imax(2),
-     &                                 newB%imin(3):newB%imax(3)))
-C      
-       if ( Agrif_probdim .EQ. 1 ) 
-     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
-       if ( Agrif_probdim .EQ. 2 ) 
-     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                             (newB%imax(2)-newB%imin(2)+1)
-       if ( Agrif_probdim .EQ. 3 ) 
-     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                             (newB%imax(2)-newB%imin(2)+1)*
-     &                             (newB%imax(3)-newB%imin(3)+1)
-
-        neweff = REAL(nbpoints) / TailleTab
-C     
-        if (nbpoints .GT. 0) then
-C      
-            if ((neweff .GT .Agrif_efficiency)) then
-                Call Agrif_Add_Rectangle(newB,boxlib)
-            else
-                tempbox => boxlib
-                newB2 = newB
-                Call Agrif_Clusternd(flag,
-     &                      boxlib,newB)
-C
-C               Compute new efficiency
-C
-                cureff = neweff
-                parcbox2 => boxlib
-                nbpoints = 0
-                nbpointsflag = 0
-C
-                do While (associated(parcbox2))
-                  if (associated(parcbox2,tempbox)) Exit
-                  newB = parcbox2%r
-C
-                  if ( Agrif_probdim .EQ. 1 ) ValSum = 
-     &                                 SUM(flag%iarray1(
-     &                                 newB%imin(1):newB%imax(1)))
-                  if ( Agrif_probdim .EQ. 2 ) ValSum = 
-     &                                 SUM(flag%iarray2(
-     &                                 newB%imin(1):newB%imax(1),
-     &                                 newB%imin(2):newB%imax(2)))
-                  if ( Agrif_probdim .EQ. 3 ) ValSum = 
-     &                                 SUM(flag%iarray3(
-     &                                 newB%imin(1):newB%imax(1),
-     &                                 newB%imin(2):newB%imax(2),
-     &                                 newB%imin(3):newB%imax(3)))
-C
-                  nbpointsflag = nbpointsflag + ValSum
-C
-                    if ( Agrif_probdim .EQ. 1 ) 
-     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
-                    if ( Agrif_probdim .EQ. 2 ) 
-     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                             (newB%imax(2)-newB%imin(2)+1)
-                    if ( Agrif_probdim .EQ. 3 ) 
-     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
-     &                             (newB%imax(2)-newB%imin(2)+1)*
-     &                             (newB%imax(3)-newB%imin(3)+1)
-
-                  nbpoints = nbpoints + TailleTab
-C              
-                  parcbox2 => parcbox2%next  
-                enddo   
-C            
-                if  (REAL(nbpointsflag)/REAL(nbpoints)
-     &               .LT.(1.15*cureff)) then
-                    parcbox2 => boxlib            
-                    do While (associated(parcbox2))
-                      if (associated(parcbox2,tempbox)) Exit
-                      deallocate(parcbox2%r)
-                      parcbox2 => parcbox2%next             
-                    enddo
-                    boxlib => tempbox
-                    Call Agrif_Add_Rectangle(newB2,boxlib)
-                endif
-            endif
-        endif
-        parcbox => parcbox%next
-      enddo
-C      
-C      
-      Return
-C      
-      End Subroutine Agrif_Clusternd 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Clusterslice
-C     **************************************************************************
-C                           
-      Subroutine Agrif_Clusterslice(sig,slice,str) 
-C
-C
-CCC   Description:
-CCC   
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C     Arguments 
-      INTEGER                      :: slice,str
-      INTEGER,DIMENSION(slice:str) :: sig 
-C
-C     Local variables      
-      INTEGER                      :: ideb,ifin
-      INTEGER                      :: i,t,a,di,ts 
-      INTEGER,DIMENSION(slice:str) :: lap 
-C
-C    
-      ideb = slice
-      ifin = str
-C    
-      if (SIZE(sig) <= 2*Agrif_Minwidth) then
-          str = -1 
-          slice = -1 
-          Return
-      endif
-C      
-      t = -1 
-      a = -1 
-C
-      do i = ideb+Agrif_Minwidth-1,ifin-Agrif_Minwidth
-          if (sig(i) .EQ. 0) then
-              if ((i-ideb) < (ifin-i)) then
-                  di = i - ideb
-                else 
-                  di = ifin - i 
-              endif
-C
-              if (di > t) then
-                a = i 
-                t = di 
-              endif
-         endif
-      enddo
-C      
-      if (a .NE. (-1)) then
-          slice = a 
-          str = t 
-          Return
-      endif
-C      
-      t = -1 
-      a = -1 
-C      
-      do i = ideb+1,ifin-1 
-        lap(i) = sig(i+1) + sig(i-1) - 2*sig(i) 
-      enddo
-C      
-      do i = ideb + Agrif_Minwidth-1,ifin-Agrif_Minwidth
-        if ((lap(i+1)*lap(i)) .LE. 0) then
-            ts = ABS(lap(i+1) - lap(i)) 
-            if (ts > t) then
-                t = ts 
-                a = i
-            endif
-       endif
-      enddo
-C      
-      if (a .EQ. (ideb + Agrif_Minwidth - 1)) then
-          a = -1
-          t = -1
-      endif
-C      
-      slice = a 
-      str = t 
-C
-C      
-      End Subroutine Agrif_Clusterslice       
-C
-C
-C    
-C     **************************************************************************
-CCC   Subroutine Agrif_Clusterprune
-C     **************************************************************************
-C      
-      Subroutine Agrif_Clusterprune(sig,pl,pu) 
-C
-C
-CCC   Description:
-CCC   
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C     Arguments
-      INTEGER                  :: pl,pu 
-      INTEGER,DIMENSION(pl:pu) :: sig
-C
-C     Local variables      
-      INTEGER :: ideb,ifin       
-      INTEGER :: diff,addl,addu,udist,ldist  
-C
-C      
-      ideb = pl
-      ifin = pu
-C      
-      if (SIZE(sig) <= Agrif_Minwidth) then
-          return 
-      endif 
-C       
-      do While ((sig(pl) .EQ. 0) .AND. (pl < ifin)) 
-        pl = pl + 1 
-      enddo 
-C       
-      do While ((sig(pu) .EQ. 0) .AND. (pu > ideb)) 
-        pu = pu - 1 
-      enddo 
-C       
-      if ((pu-pl) < Agrif_Minwidth) then
-          diff = Agrif_Minwidth - (pu - pl + 1) 
-          udist = ifin - pu 
-          ldist = pl - ideb
-          addl = diff / 2 
-          addu = diff - addl 
-          if (addu > udist) then
-              addu = udist 
-              addl = diff - addu 
-          endif
-C         
-          if (addl > ldist) then
-              addl = ldist 
-              addu = diff - addl
-          endif
-C         
-          pu = pu + addu 
-          pl = pl - addl         
-C      
-      endif 
-C       
-C
-      End Subroutine Agrif_Clusterprune
-C
-C
-C              
-C     **************************************************************************
-CCC   Subroutine Agrif_Add_Rectangle 
-C     **************************************************************************
-C        
-      Subroutine Agrif_Add_Rectangle(R,LR)
-C
-CCC   Description:
-CCC   Subroutine to add the Agrif_Rectangle R in a list managed by LR.
-C
-C     Declarations:
-C
-C     Arguments               
-      TYPE(AGRIF_rectangle)           :: R  
-      TYPE(AGRIF_lrectangle), Pointer :: LR
-C
-C     Local variable        
-      TYPE(AGRIF_lrectangle), Pointer :: newrect  
-C
-      INTEGER                         :: iii 
-C
-C        
-      allocate(newrect)
-      allocate(newrect % r)
-C
-      newrect % r = R
-C      
-      do iii = 1 , Agrif_Probdim
-         newrect % r % spaceref(iii) = Agrif_Coeffref(iii)
-         newrect % r % timeref(iii) = Agrif_Coeffreft(iii)
-      enddo
-C              
-      newrect % r % number = -1            
-      Nullify(newrect % r % childgrids)
-      newrect % next => LR  
-      LR => newrect  
-C
-C      
-      End Subroutine Agrif_Add_Rectangle   
-C  
-C
-C  
-C     **************************************************************************
-CCC   Subroutine Agrif_Read_Fix_Grd  
-C     **************************************************************************
-C      
-      Recursive Subroutine Agrif_Read_Fix_Grd(coarsegrid,j,nunit)
-C
-CCC   Description:
-CCC   Subroutine to create the grid hierarchy from the reading of the 
-CCC   AGRIF_FixedGrids.in file.
-C
-CC    Method:
-CC    Recursive subroutine and creation of a first grid hierarchy from the
-CC    reading of the AGRIF_FixedGrids.in file.        
-C
-C     Declarations:
-C
-C     Pointer argument      
-      TYPE(AGRIF_rectangle), Pointer   :: coarsegrid ! Pointer on the first grid
-                                                     ! of the grid hierarchy
-C                                    
-C     Scalar arguments                                    
-      INTEGER                          :: j          ! Number of the new grid
-      INTEGER                          :: nunit      ! unit associated with file
-C      
-C     Local variables      
-      TYPE(AGRIF_rectangle)            :: newrect    ! Pointer on a new grid   
-      TYPE(AGRIF_lrectangle), Pointer  :: parcours   ! Pointer for the recursive
-                                                     !    procedure
-      TYPE(AGRIF_lrectangle), Pointer  :: newlrect
-      TYPE(AGRIF_lrectangle), Pointer  :: end_list       
-      INTEGER                          :: i          ! for each child grid
-      INTEGER                          :: nb_grids   ! Number of child grids
-      INTEGER                          :: iii
-C          
-C
-      Nullify(newrect%childgrids)
-C      
-C     Reading of the number of child grids        
-      read(nunit,*) nb_grids
-C      
-C     coarsegrid%nbgridchild = nb_grids
-C      
-      allocate(end_list)
-C
-      nullify(end_list % r)
-      nullify(end_list % next)
-C      
-      coarsegrid % childgrids => end_list
-C
-C     Reading of imin(1),imax(1),imin(2),imax(2),imin(3),imax(3), and space and
-C        time refinement factors for each child grid.
-C     Creation and addition of the new grid to the grid hierarchy. 
-C
-      do i = 1,nb_grids
-        allocate(newlrect)      
-        newrect % number = j   ! Number of the grid
-C
-        if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
-           if (Agrif_Probdim == 3) then  
-            read(nunit,*) newrect % imin(1), newrect % imax(1),
-     &                    newrect % imin(2), newrect % imax(2),
-     &                    newrect % imin(3), newrect % imax(3),
-     &                    newrect % spaceref(1),newrect % spaceref(2),
-     &                    newrect % spaceref(3),
-     &                    newrect % timeref(1),newrect % timeref(2),
-     &                    newrect % timeref(3)
-           elseif (Agrif_Probdim == 2) then            
-            read(nunit,*) newrect % imin(1),newrect % imax(1),
-     &                  newrect % imin(2),newrect % imax(2),
-     &                    newrect % spaceref(1),newrect % spaceref(2),
-     &                    newrect % timeref(1),newrect % timeref(2)
-           elseif (Agrif_Probdim == 1) then
-            read(nunit,*) newrect % imin(1), newrect % imax(1),
-     &                    newrect % spaceref(1),
-     &                    newrect % timeref(1)
-           endif
-        else
-           if (Agrif_Probdim == 3) then  
-            read(nunit,*) newrect % imin(1), newrect % imax(1),
-     &                    newrect % imin(2), newrect % imax(2),
-     &                    newrect % imin(3), newrect % imax(3),
-     &                    newrect % spaceref(1),newrect % spaceref(2),
-     &                    newrect % spaceref(3),
-     &                    newrect % timeref(1)
-           elseif (Agrif_Probdim == 2) then            
-            read(nunit,*) newrect % imin(1),newrect % imax(1),
-     &                  newrect % imin(2),newrect % imax(2),
-     &                    newrect % spaceref(1),newrect % spaceref(2),
-     &                    newrect % timeref(1)
-           elseif (Agrif_Probdim == 1) then
-            read(nunit,*) newrect % imin(1), newrect % imax(1),
-     &                    newrect % spaceref(1),
-     &                    newrect % timeref(1)
-           endif
-C
-           if ( Agrif_probdim .GE. 2 ) then
-              do iii = 2 , Agrif_probdim
-                 newrect % timeref(iii) = newrect % timeref(1) 
-              enddo
-           endif
-C
-        endif
-C
-C       Addition to the grid hierarchy
-C
-        nullify(newrect % childgrids)
-        j = j + 1
-        Allocate(newlrect%r)
-        newlrect % r = newrect 
-        nullify(newlrect % next)
-        end_list % next => newlrect
-        end_list => end_list % next
-      enddo
-C      
-      coarsegrid % childgrids => coarsegrid % childgrids % next
-      parcours => coarsegrid % childgrids
-C
-C     Recursive operation to create the grid hierarchy branch by branch
-C
-      do while (associated(parcours))
-        call Agrif_Read_Fix_Grd (parcours % r,j,nunit)
-        parcours => parcours % next
-      enddo
-C      
-C
-      End Subroutine Agrif_Read_Fix_Grd        
-C        
-C 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Create_Grids  
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Create_Grids(g,coarsegrid)
-C
-CCC   Description:
-CCC   Subroutine to create the grid hierarchy (g) from the one created with the
-CCC   Agrif_Read_Fix_Grd or Agrif_Cluster_All procedures (coarsegrid).
-C
-CC    Method:
-CC    Recursive subroutine.        
-C
-C     Declarations:
-C
-C     Pointer arguments        
-      TYPE(AGRIF_grid)     , Pointer  :: g          ! Pointer on the root coarse
-                                                    ! grid
-      TYPE(AGRIF_rectangle), Pointer  :: coarsegrid ! Pointer on the root coarse
-                                                    ! grid of the grid hierarchy
-                                                    ! created with the
-                                                    ! Agrif_Read_Fix_Grd
-                                                    ! subroutine
-C
-C     Local pointers
-      TYPE(Agrif_grid)      , Pointer :: newgrid    ! New grid
-      TYPE(Agrif_pgrid)     , Pointer :: newpgrid
-      TYPE(Agrif_pgrid)     , Pointer :: parcours2
-      TYPE(Agrif_lrectangle), Pointer :: parcours
-      TYPE(Agrif_pgrid)     , Pointer :: end_list
-      TYPE(Agrif_pgrid)     , Pointer :: parcours3
-C
-C     Local scalars      
-      LOGICAL                         :: nullliste
-      INTEGER                         :: iii
-      INTEGER                         :: moving_grid_id = 0      
-
-C
-      parcours3 => g % child_grids
-C     
-      if (associated(parcours3)) then
-          do While (associated(parcours3 % next))
-            parcours3 => parcours3 % next
-          enddo
-          end_list => parcours3
-          nullliste=.FALSE.
-        else
-          allocate(end_list)
-          nullify(end_list % gr)
-          nullify(end_list % next)      
-          g % child_grids => end_list 
-          parcours3 => end_list      
-          nullliste=.TRUE.
-      endif
-C      
-      parcours => coarsegrid % childgrids
-C      
-C     Creation of the grid hierarchy from the one created by using the 
-C     Agrif_Read_Fix_Grd subroutine 
-C
-      do while (associated(parcours))
-        allocate(newgrid)        
-        moving_grid_id=moving_grid_id+1
-        newgrid % grid_id = moving_grid_id
-        do iii = 1 , Agrif_Probdim
-           newgrid % spaceref(iii) = parcours % r % spaceref(iii)
-           newgrid % timeref(iii) = parcours % r % timeref(iii)
-        enddo
-C
-        do iii = 1 , Agrif_Probdim
-          newgrid % nb(iii) = (parcours % r % imax(iii) 
-     &                       - parcours % r % imin(iii)) 
-     &                       * parcours % r % spaceref(iii)
-C     
-          newgrid % ix(iii) =  parcours % r % imin(iii)
-C
-          newgrid % Agrif_d(iii) = g % Agrif_d(iii) 
-     &                  / REAL(newgrid % spaceref(iii))
-C
-          newgrid % Agrif_x(iii) = g % Agrif_x(iii) +
-     &      (parcours % r % imin(iii) - 1)* g % Agrif_d(iii)
-C      
-        enddo
-C
-C       Pointer on the parent grid                        
-C
-        newgrid % parent => g      
-
-C       Level of the current grid
-        newgrid % level = newgrid % parent % level + 1
-        if (newgrid % level > Agrif_MaxLevelLoc) then
-          Agrif_MaxLevelLoc = newgrid%level
-        endif
-
-C      
-C       Grid pointed by newgrid is a fixed grid      
-C
-        if (parcours % r % number .GT. 0) then      
-            newgrid % fixed = .true.  
-          else
-            newgrid % fixed = .false.
-        endif
-C
-C       Number of the grid pointed by newgrid
-        newgrid % fixedrank = parcours % r % number
-C           
-C       No time calculation on this grid         
-        newgrid % ngridstep = 0      
-C
-C       Test indicating if the current grid has a common border with the root 
-C       coarse grid in the x direction
-        do iii = 1 , Agrif_Probdim
-           newgrid % NearRootBorder(iii) = .FALSE.
-C        
-           if ((newgrid % parent % NearRootBorder(iii)) .AND. 
-     &         (newgrid % ix(iii) == 1)) then
-               newgrid % NearRootBorder(iii) = .TRUE.
-           endif
-C
-           newgrid % DistantRootBorder(iii) = .FALSE.
-C 
-           if ((newgrid % parent % DistantRootBorder(iii)) .AND. 
-     &         (newgrid % ix(iii) + 
-     &         (newgrid % nb(iii)/newgrid % spaceref(iii))  
-     &          - 1  == newgrid % parent % nb(iii))) then
-               newgrid % DistantRootBorder(iii) = .TRUE.
-           endif
-        enddo
-C
-C       Writing in output files
-C
-        newgrid % oldgrid = .FALSE.      
-C
-C     
-C       Definition of the CHARACTERistics of the variable of the grid pointed by
-C       newgrid 
-        Call Agrif_Create_Var (newgrid)
-C      
-C       Instanciation of the grid pointed by newgrid and its variables
-        Call Agrif_Instance (newgrid)
-C       
-C       Nullify the variable of the grid pointed by newgrid
-C
-C
-C       Addition of this grid to the grid hierarchy 
-C      
-        nullify(newgrid % child_grids)
-        allocate(newpgrid)  
-        newpgrid % gr => newgrid
-        nullify(newpgrid % next)
-        end_list % next => newpgrid
-        end_list => end_list % next               
-        parcours => parcours % next
-C
-C       Updating the total number of fixed grids
-        if (newgrid % fixed) then
-            AGRIF_nbfixedgrids = AGRIF_nbfixedgrids + 1
-        endif
-C                  
-      enddo
-C
-C
-      if (nullliste) then
-          g % child_grids => g % child_grids % next
-          parcours2 => g % child_grids
-          deallocate(parcours3)
-        else
-          parcours2 => parcours3 % next
-      endif
-C      
-      parcours => coarsegrid % childgrids
-C
-C     Recursive call to the subroutine Agrif_Create_Fixed_Grids to create the
-C     grid hierarchy
-C      
-      do while (associated(parcours))
-        Call Agrif_Create_Grids (parcours2 % gr,parcours % r)
-        parcours => parcours % next
-        parcours2 => parcours2 % next
-      enddo 
-C      
-      Return      
-C                  
-      End Subroutine Agrif_Create_Grids
-C
-C      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_Hierarchy  
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Init_Hierarchy(g) 
-C
-CCC   Description:
-CCC   Subroutine to initialize all the grids except the root coarse grid (this 
-CCC   one, pointed by AGRIF_mygrid, is initialized by the subroutine 
-CCC   Agrif_Init_Grids defi ned in the module Agrif_Util and called in the main 
-CCC   program ). 
-C
-CC    Method:
-CC    Recursive subroutine.        
-C
-C     Declarations:
-C
-C     Pointer argument      
-      TYPE(AGRIF_grid), Pointer  :: g         ! Pointer on the root coarse grid 
-C      
-C     Local variables      
-      TYPE(AGRIF_pgrid), Pointer :: parcours  ! Pointer for the recursive call
-      LOGICAL                    :: Init_Hierarchy
-C      
-C
-      parcours=>g%child_grids
-C      
-      do while (associated(parcours))
-        Init_Hierarchy = .false.
-        if ( AGRIF_USE_FIXED_GRIDS .EQ. 1 .OR. 
-     &       AGRIF_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
-           if ((parcours%gr%fixed) 
-     &         .AND. (Agrif_mygrid%ngridstep == 0)) then
-              Init_Hierarchy = .true.
-           endif      
-       endif
-C
-       if (.NOT. parcours%gr%fixed) Init_Hierarchy = .true.
-       if (parcours % gr % oldgrid) Init_Hierarchy = .false.
-C
-       if (Init_Hierarchy) then 
-C
-C           Instanciation of the grid pointed by parcours%gr and its variables 
-            Call Agrif_Instance (parcours % gr)
-C    
-C           Allocation of the arrays containing values of the variables of the
-C           grid pointed by parcours%gr      
-C      
-            Call Agrif_Allocation (parcours % gr)   
-C            
-            Call Agrif_initialisations(parcours % gr)              
-C       
-            Call Agrif_Instance(parcours % gr)
-C
-            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
-              Call Agrif_Allocate_Restore (parcours % gr)
-            endif
-C
-            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
-C              Initialization by copy of the grids created by clustering 
-               Call AGRIF_CopyFromold_All (parcours%gr,
-     &                                     Agrif_oldmygrid)
-            endif
-C
-C           Initialization by interpolation 
-C           (this routine is written by the user) 
-            Call Agrif_InitValues()
-C
-            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
-               Call Agrif_Free_Restore (parcours % gr)
-            endif
-C
-       endif                                  
-       parcours => parcours % next 
-C         
-      enddo
-C
-      parcours => g % child_grids
-C      
-C     Recursive operation to initialize all the grids
-      do while (associated(parcours))
-        Call Agrif_Init_Hierarchy (parcours%gr)
-        parcours => parcours%next
-      enddo
-C      
-      End Subroutine Agrif_Init_Hierarchy 
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Allocate_Restore  
-C     **************************************************************************
-C
-      Subroutine Agrif_Allocate_Restore(Agrif_Gr)
-C      
-C      
-C     Modules used:
-C
-      TYPE(AGRIF_grid), Pointer  :: Agrif_Gr   ! Pointer on the root coarse grid
-C     
-      INTEGER                    :: i
-C
-        do i = 1 , Agrif_NbVariables
-            if ( Agrif_Mygrid%tabvars(i)%var % restaure ) then
-            if ( Agrif_Gr%tabvars(i)%var % nbdim .EQ. 1 ) then    
-            Allocate( Agrif_Gr%tabvars(i)%var%  
-     &    Restore1D(lbound(Agrif_Gr%tabvars(i)%var%array1,1) 
-     &    :ubound(Agrif_Gr%tabvars(i)%var%array1,1))) 
-            Agrif_Gr%tabvars(i)%var%Restore1D = 0
-C
-            endif
-            if ( Agrif_Gr%tabvars(i)%var % nbdim .EQ. 2 ) then
-            Allocate( Agrif_Gr%tabvars(i)%var%Restore2D(  
-     &      lbound(Agrif_Gr%tabvars(i)%var%array2,1):         
-     &      ubound(Agrif_Gr%tabvars(i)%var%array2,1),         
-     &      lbound(Agrif_Gr%tabvars(i)%var%array2,2)          
-     &      :ubound(Agrif_Gr%tabvars(i)%var%array2,2)))         
-            Agrif_Gr%tabvars(i)%var%Restore2D = 0
-C
-            endif
-            if ( Agrif_Mygrid%tabvars(i)%var % nbdim .EQ. 3 ) then
-C     
-            Allocate( Agrif_Gr%tabvars(i)%var%Restore3D( 
-     &      lbound(Agrif_Gr%tabvars(i)%var%array3,1):        
-     &      ubound(Agrif_Gr%tabvars(i)%var%array3,1),        
-     &      lbound(Agrif_Gr%tabvars(i)%var%array3,2):        
-     &      ubound(Agrif_Gr%tabvars(i)%var%array3,2),        
-     &      lbound(Agrif_Gr%tabvars(i)%var%array3,3):        
-     &      ubound(Agrif_Gr%tabvars(i)%var%array3,3)))  
-            Agrif_Gr%tabvars(i)%var%Restore3D = 0
-            endif
-C 
-            endif
-          enddo
-C
-      Return
-C
-C      
-      End Subroutine Agrif_Allocate_Restore      
-C
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Free_Restore  
-C     **************************************************************************
-C
-      Subroutine Agrif_Free_Restore(Agrif_Gr)
-C
-C      
-C     Pointer argument      
-      TYPE(AGRIF_grid), Pointer  :: Agrif_Gr   ! Pointer on the root coarse grid
-      INTEGER :: i     
-C
-      do i = 1 , Agrif_NbVariables
-         if ( Agrif_Mygrid % tabvars(i) % var % restaure) then
-C  
-            if (associated(Agrif_Gr%tabvars(i)%var%Restore1D)) then
-               Deallocate(Agrif_Gr%tabvars(i)%var%Restore1D)
-            endif
-            if (associated(Agrif_Gr%tabvars(i)%var%Restore2D)) then
-               Deallocate(Agrif_Gr%tabvars(i)%var%Restore2D)
-            endif
-            if (associated(Agrif_Gr%tabvars(i)%var%Restore3D)) then
-               Deallocate(Agrif_Gr%tabvars(i)%var%Restore3D)
-            endif
-            if (associated(Agrif_Gr%tabvars(i)%var%Restore4D)) then
-               Deallocate(Agrif_Gr%tabvars(i)%var%Restore4D)
-            endif
-            if (associated(Agrif_Gr%tabvars(i)%var%Restore5D)) then
-               Deallocate(Agrif_Gr%tabvars(i)%var%Restore5D)
-            endif
-            if (associated(Agrif_Gr%tabvars(i)%var%Restore6D)) then
-               Deallocate(Agrif_Gr%tabvars(i)%var%Restore6D)
-            endif
-C 
-        endif
-      enddo
-C 
-      Return
-C
-C      
-      End Subroutine Agrif_Free_Restore
-C
-C
-C
-      End Module Agrif_Clustering
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90	(revision 5682)
@@ -0,0 +1,1277 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Clustering
+!>
+!> Contains subroutines to create and initialize the grid hierarchy from the
+!> AGRIF_FixedGrids.in file.
+!
+module Agrif_Clustering
+!
+    use Agrif_CurgridFunctions
+    use Agrif_Init_Vars
+    use Agrif_Save
+!
+    implicit none
+!
+    abstract interface
+        subroutine init_proc()
+        end subroutine init_proc
+    end interface
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Cluster_All
+!
+!> Subroutine for the clustering. A temporary grid hierarchy, pointed by parent_rect, is created.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Cluster_All ( g, parent_rect )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid)     , pointer   :: g        !< Pointer on the current grid
+    TYPE(Agrif_Rectangle), pointer   :: parent_rect
+!
+    TYPE(Agrif_LRectangle), pointer  :: parcours
+    TYPE(Agrif_Grid)      , pointer  :: newgrid
+    REAL                             :: g_eps
+    INTEGER                          :: i
+!
+    g_eps = huge(1.)
+    do i = 1,Agrif_Probdim
+        g_eps = min(g_eps, g % Agrif_dx(i))
+    enddo
+!
+    g_eps = g_eps / 100.
+!
+!   Necessary condition for clustering
+    do i = 1,Agrif_Probdim
+        if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps)) return
+    enddo
+!
+    nullify(parent_rect%childgrids)
+!
+    call Agrif_ClusterGridnD(g,parent_rect)
+!
+    parcours => parent_rect % childgrids
+!
+    do while ( associated(parcours) )
+!
+!       Newgrid is created. It is a copy of a fine grid created previously by clustering.
+        allocate(newgrid)
+!
+        do i = 1,Agrif_Probdim
+            newgrid % nb(i) = (parcours % r % imax(i) - parcours % r % imin(i)) * Agrif_Coeffref(i)
+            newgrid % Agrif_x(i)  = g % Agrif_x(i)  + (parcours % r % imin(i) -1) * g%Agrif_dx(i)
+            newgrid % Agrif_dx(i) = g % Agrif_dx(i) / Agrif_Coeffref(i)
+        enddo
+!
+        if ( Agrif_Probdim == 1 ) then
+            allocate(newgrid%tabpoint1D(newgrid%nb(1)+1))
+            newgrid%tabpoint1D = 0
+        endif
+!
+        if ( Agrif_Probdim == 2 ) then
+            allocate(newgrid%tabpoint2D(newgrid%nb(1)+1, newgrid%nb(2)+1))
+            newgrid%tabpoint2D = 0
+        endif
+!
+        if ( Agrif_Probdim == 3 ) then
+            allocate(newgrid%tabpoint3D(newgrid%nb(1)+1, newgrid%nb(2)+1, newgrid%nb(3)+1))
+            newgrid%tabpoint3D = 0
+        endif
+!
+!       Points detection on newgrid
+        call Agrif_TabpointsnD(Agrif_mygrid,newgrid)
+!
+!       recursive call to Agrif_Cluster_All
+        call Agrif_Cluster_All(newgrid, parcours % r)
+!
+        parcours => parcours % next
+!
+        if ( Agrif_Probdim == 1 ) deallocate(newgrid%tabpoint1D)
+        if ( Agrif_Probdim == 2 ) deallocate(newgrid%tabpoint2D)
+        if ( Agrif_Probdim == 3 ) deallocate(newgrid%tabpoint3D)
+!
+        deallocate(newgrid)
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Cluster_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_TabpointsnD
+!
+!> Copy on newgrid of points detected on the grid hierarchy pointed by g.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_TabpointsnD ( g, newgrid )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid), pointer   :: g, newgrid
+!
+    TYPE(Agrif_PGrid), pointer  :: parcours
+!
+    REAL                  :: g_eps, newgrid_eps, eps
+    REAL   , DIMENSION(3) :: newmin, newmax
+    REAL   , DIMENSION(3) :: gmin, gmax
+    REAL   , DIMENSION(3) :: xmin
+    INTEGER, DIMENSION(3) :: igmin, inewmin
+    INTEGER, DIMENSION(3) :: inewmax
+    INTEGER               :: i,  j,  k
+    INTEGER               :: i0, j0, k0
+!
+    parcours => g % child_list % first
+!
+    do while( associated(parcours) )
+        call Agrif_TabpointsnD(parcours%gr,newgrid)
+        parcours => parcours % next
+    enddo
+!
+    g_eps = 10.
+    newgrid_eps = 10.
+!
+    do i = 1,Agrif_probdim
+        g_eps = min( g_eps , g % Agrif_dx(i) )
+        newgrid_eps = min(newgrid_eps,newgrid%Agrif_dx(i))
+    enddo
+!
+    eps = min(g_eps,newgrid_eps)/100.
+!
+    do i = 1,Agrif_probdim
+!
+         if ( newgrid%Agrif_dx(i) < (g%Agrif_dx(i)-eps) ) return
+!
+         gmin(i) = g%Agrif_x(i)
+         gmax(i) = g%Agrif_x(i) + g%nb(i) * g%Agrif_dx(i)
+!
+         newmin(i) = newgrid%Agrif_x(i)
+         newmax(i) = newgrid%Agrif_x(i) + newgrid%nb(i) * newgrid%Agrif_dx(i)
+!
+         if (gmax(i) < newmin(i)) return
+         if (gmin(i) > newmax(i)) return
+!
+         inewmin(i) = 1 - floor(-(max(gmin(i),newmin(i))-newmin(i)) / newgrid%Agrif_dx(i))
+!
+         xmin(i) = newgrid%Agrif_x(i) + (inewmin(i)-1)*newgrid%Agrif_dx(i)
+!
+         igmin(i) = 1 + nint((xmin(i)-gmin(i))/g%Agrif_dx(i))
+!
+         inewmax(i) = 1 + int(   (min(gmax(i),newmax(i))-newmin(i)) / newgrid%Agrif_dx(i))
+!
+    enddo
+!
+    if ( Agrif_probdim == 1 ) then
+        i0 = igmin(1)
+        do i = inewmin(1),inewmax(1)
+            newgrid%tabpoint1D(i) = max( newgrid%tabpoint1D(i), g%tabpoint1D(i0) )
+        enddo
+        i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1))
+    endif
+!
+    if ( Agrif_probdim == 2 ) then
+        i0 = igmin(1)
+        do i = inewmin(1),inewmax(1)
+            j0 = igmin(2)
+            do j = inewmin(2),inewmax(2)
+                newgrid%tabpoint2D(i,j) = max( newgrid%tabpoint2D(i,j), g%tabpoint2D(i0,j0) )
+                j0 = j0 + int(newgrid%Agrif_dx(2)/g%Agrif_dx(2))
+            enddo
+            i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1))
+        enddo
+    endif
+!
+    if ( Agrif_probdim == 3 ) then
+        i0 = igmin(1)
+        do i = inewmin(1),inewmax(1)
+            j0 = igmin(2)
+            do j = inewmin(2),inewmax(2)
+                k0 = igmin(3)
+                do k = inewmin(3),inewmax(3)
+                    newgrid%tabpoint3D(i,j,k) = max( newgrid%tabpoint3D(i,j,k), g%tabpoint3D(i0,j0,k0))
+                    k0 = k0 + int(newgrid%Agrif_dx(3)/g%Agrif_dx(3))
+                enddo
+                j0 = j0 + int(newgrid%Agrif_dx(2)/g%Agrif_dx(2))
+            enddo
+            i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1))
+        enddo
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_TabpointsnD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_ClusterGridnD
+!
+!> Clustering on the grid pointed by g.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_ClusterGridnD ( g, parent_rect )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid)     , pointer  :: g          !< Pointer on the current grid
+    TYPE(Agrif_Rectangle), pointer  :: parent_rect
+!
+    TYPE(Agrif_Rectangle) :: newrect
+    TYPE(Agrif_Variable_i)  :: newflag
+!
+    INTEGER               :: i,j,k
+    INTEGER, DIMENSION(3) :: sx
+    INTEGER               :: bufferwidth,flagpoints
+    INTEGER               :: n1,n2,m1,m2,o1,o2
+!
+    bufferwidth = int(Agrif_Minwidth/5.)
+!
+    do i = 1,Agrif_probdim
+        sx(i) = g % nb(i) + 1
+    enddo
+!
+    if ( Agrif_probdim == 1 ) then
+        allocate(newflag%iarray1(sx(1)))
+        newflag%iarray1 = 0
+    endif
+    if ( Agrif_probdim == 2 ) then
+        allocate(newflag%iarray2(sx(1),sx(2)))
+        newflag%iarray2 = 0
+    endif
+    if ( Agrif_probdim == 3 ) then
+        allocate(newflag%iarray3(sx(1),sx(2),sx(3)))
+        newflag%iarray3 = 0
+    endif
+!
+    flagpoints = 0
+!
+    if ( bufferwidth>0 ) then
+!
+        if ( Agrif_probdim == 1 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1
+                if (g % tabpoint1D(i) == 1) then
+                    m1 = i - bufferwidth + 1
+                    m2 = i + bufferwidth - 1
+                    flagpoints = flagpoints + 1
+                    newflag%iarray1(m1:m2) = 1
+                endif
+            enddo
+        endif
+!
+        if ( Agrif_probdim == 2 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1
+            do j = bufferwidth,sx(2)-bufferwidth+1
+                if (g % tabpoint2D(i,j) == 1) then
+                    n1 = j - bufferwidth + 1
+                    n2 = j + bufferwidth - 1
+                    m1 = i - bufferwidth + 1
+                    m2 = i + bufferwidth - 1
+                    flagpoints = flagpoints + 1
+                    newflag%iarray2(m1:m2,n1:n2) = 1
+                endif
+            enddo
+            enddo
+        endif
+!
+        if ( Agrif_probdim == 3 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1
+            do j = bufferwidth,sx(2)-bufferwidth+1
+            do k = bufferwidth,sx(3)-bufferwidth+1
+                if (g % tabpoint3D(i,j,k) == 1) then
+                    o1 = k - bufferwidth + 1
+                    o2 = k + bufferwidth - 1
+                    n1 = j - bufferwidth + 1
+                    n2 = j + bufferwidth - 1
+                    m1 = i - bufferwidth + 1
+                    m2 = i + bufferwidth - 1
+                    flagpoints = flagpoints + 1
+                    newflag%iarray3(m1:m2,n1:n2,o1:o2) = 1
+                endif
+            enddo
+            enddo
+            enddo
+        endif
+!
+    else
+!
+        flagpoints = 1
+        if ( Agrif_probdim == 1 ) newflag%iarray1 = g % tabpoint1D
+        if ( Agrif_probdim == 2 ) newflag%iarray2 = g % tabpoint2D
+        if ( Agrif_probdim == 3 ) newflag%iarray3 = g % tabpoint3D
+!
+    endif
+!
+    if (flagpoints == 0) then
+        if ( Agrif_probdim == 1 ) deallocate(newflag%iarray1)
+        if ( Agrif_probdim == 2 ) deallocate(newflag%iarray2)
+        if ( Agrif_probdim == 3 ) deallocate(newflag%iarray3)
+        return
+    endif
+!
+    do i = 1 , Agrif_probdim
+        newrect % imin(i) = 1
+        newrect % imax(i) = sx(i)
+    enddo
+!
+    call Agrif_Clusternd(newflag,parent_rect%childgrids,newrect)
+!
+    if ( Agrif_probdim == 1 ) deallocate(newflag%iarray1)
+    if ( Agrif_probdim == 2 ) deallocate(newflag%iarray2)
+    if ( Agrif_probdim == 3 ) deallocate(newflag%iarray3)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_ClusterGridnD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_ClusternD
+!
+!> Clustering on the grid pointed by oldB.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Clusternd ( flag, boxlib, oldB )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Variable_i)            :: flag
+    TYPE(Agrif_LRectangle), pointer :: boxlib
+    TYPE(Agrif_Rectangle)           :: oldB
+!
+    TYPE(Agrif_LRectangle),pointer :: tempbox,parcbox,parcbox2
+    TYPE(Agrif_Rectangle) :: newB,newB2
+    INTEGER :: i,j,k
+    INTEGER, DIMENSION(:), allocatable :: i_sig, j_sig, k_sig
+    INTEGER, DIMENSION(3) :: ipu,ipl
+    INTEGER, DIMENSION(3) :: istr,islice
+    REAL :: cureff, neweff
+    INTEGER :: ValMax,ValSum,TailleTab
+    INTEGER :: nbpoints,nbpointsflag
+    LOGICAL :: test
+!
+                              allocate( i_sig(oldB%imin(1):oldB%imax(1)) )
+    if ( Agrif_probdim >= 2 ) allocate( j_sig(oldB%imin(2):oldB%imax(2)) )
+    if ( Agrif_probdim == 3 ) allocate( k_sig(oldB%imin(3):oldB%imax(3)) )
+!
+    test = .FALSE.
+    do i = 1,Agrif_probdim
+        test = test .OR. ( (oldB%imax(i)-oldB%imin(i)+1) <  Agrif_Minwidth)
+    enddo
+    if ( test ) return
+!
+    if ( Agrif_probdim == 1 ) i_sig = flag%iarray1
+    if ( Agrif_probdim == 2 ) then
+        do i = oldB%imin(1),oldB%imax(1)
+            i_sig(i) = SUM(flag%iarray2(i, oldB%imin(2):oldB%imax(2)))
+        enddo
+        do j = oldB%imin(2),oldB%imax(2)
+            j_sig(j) = SUM(flag%iarray2(oldB%imin(1):oldB%imax(1),j))
+        enddo
+    endif
+    if ( Agrif_probdim == 3 ) then
+        do i = oldB%imin(1),oldB%imax(1)
+            i_sig(i) = SUM(flag%iarray3(i,oldB%imin(2):oldB%imax(2),    &
+                                          oldB%imin(3):oldB%imax(3)))
+        enddo
+        do j = oldB%imin(2),oldB%imax(2)
+            j_sig(j) = SUM(flag%iarray3(  oldB%imin(1):oldB%imax(1), j, &
+                                          oldB%imin(3):oldB%imax(3)))
+        enddo
+        do k = oldB%imin(3),oldB%imax(3)
+            k_sig(k) = SUM(flag%iarray3(  oldB%imin(1):oldB%imax(1),    &
+                                          oldB%imin(2):oldB%imax(2), k) )
+        enddo
+    endif
+!
+    do i = 1,Agrif_probdim
+        ipl(i) = oldB%imin(i)
+        ipu(i) = oldB%imax(i)
+    enddo
+!
+                              call Agrif_Clusterprune(i_sig,ipl(1),ipu(1))
+    if ( Agrif_probdim >= 2 ) call Agrif_Clusterprune(j_sig,ipl(2),ipu(2))
+    if ( Agrif_probdim == 3 ) call Agrif_Clusterprune(k_sig,ipl(3),ipu(3))
+!
+    test = .TRUE.
+    do i = 1,Agrif_probdim
+        test = test .AND. (ipl(i) == oldB%imin(i))
+        test = test .AND. (ipu(i) == oldB%imax(i))
+    enddo
+
+    if (.NOT. test) then
+        do i = 1 , Agrif_probdim
+            newB%imin(i) = ipl(i)
+            newB%imax(i) = ipu(i)
+        enddo
+!
+        if ( Agrif_probdim == 1 ) nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
+        if ( Agrif_probdim == 2 ) nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1),    &
+                                                              newB%imin(2):newB%imax(2)))
+        if ( Agrif_probdim == 3 ) nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1),    &
+                                                              newB%imin(2):newB%imax(2),    &
+                                                              newB%imin(3):newB%imax(3)))
+!
+        if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
+        if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                              (newB%imax(2)-newB%imin(2)+1)
+        if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                              (newB%imax(2)-newB%imin(2)+1) * &
+                                              (newB%imax(3)-newB%imin(3)+1)
+        neweff = REAL(nbpoints) / TailleTab
+!
+        if (nbpoints > 0) then
+!
+            if ((neweff > Agrif_efficiency)) then
+                call Agrif_Add_Rectangle(newB,boxlib)
+                return
+            else
+!
+                tempbox => boxlib
+                newB2 = newB
+                call Agrif_Clusternd(flag,boxlib,newB)
+!
+!               Compute new efficiency
+                cureff = neweff
+                parcbox2 => boxlib
+                nbpoints = 0
+                nbpointsflag = 0
+!
+                do while (associated(parcbox2))
+                    if (associated(parcbox2,tempbox)) exit
+                    newB = parcbox2%r
+!
+                    if ( Agrif_probdim == 1 ) Valsum = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
+                    if ( Agrif_probdim == 2 ) Valsum = SUM(flag%iarray2(newB%imin(1):newB%imax(1), &
+                                                                        newB%imin(2):newB%imax(2)))
+                    if ( Agrif_probdim == 3 ) Valsum = SUM(flag%iarray3(newB%imin(1):newB%imax(1), &
+                                                                        newB%imin(2):newB%imax(2), &
+                                                                        newB%imin(3):newB%imax(3)))
+                    nbpointsflag = nbpointsflag + ValSum
+!
+                    if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
+                    if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                                          (newB%imax(2)-newB%imin(2)+1)
+                    if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                                          (newB%imax(2)-newB%imin(2)+1) * &
+                                                          (newB%imax(3)-newB%imin(3)+1)
+                    nbpoints = nbpoints + TailleTab
+                    parcbox2 => parcbox2%next
+                enddo
+!
+! coefficient 1.05 avant 1.15 possibilite de laisser choix a l utilisateur
+                if ( REAL(nbpointsflag)/REAL(nbpoints) < (1.0001*cureff)) then
+                    parcbox2 => boxlib
+                    do while (associated(parcbox2))
+                        if (associated(parcbox2,tempbox)) exit
+                        deallocate(parcbox2%r)
+                        parcbox2 => parcbox2%next
+                    enddo
+                    boxlib => tempbox
+                    call Agrif_Add_Rectangle(newB2,boxlib)
+                    return
+                endif
+            endif
+        endif
+        return
+    endif
+!
+    do i = 1,Agrif_Probdim
+        istr(i) = oldB%imax(i)
+        islice(i) = oldB%imin(i)
+    enddo
+!
+                              call Agrif_Clusterslice(i_sig,islice(1),istr(1))
+    if ( Agrif_probdim >= 2 ) call Agrif_Clusterslice(j_sig,islice(2),istr(2))
+    if ( Agrif_probdim == 3 ) call Agrif_Clusterslice(k_sig,islice(3),istr(3))
+!
+    ValSum = 0
+    do i = 1,Agrif_Probdim
+        Valsum = valSum + islice(i)
+    enddo
+!
+    if ( Valsum == -Agrif_Probdim ) then
+        call Agrif_Add_Rectangle(oldB,boxlib)
+        return
+    endif
+!
+    nullify(tempbox)
+    tempbox => boxlib
+    if ( Agrif_probdim == 1 ) cureff = (oldB%imax(1)-oldB%imin(1)+1)
+    if ( Agrif_probdim == 2 ) cureff = (oldB%imax(1)-oldB%imin(1)+1) * &
+                                       (oldB%imax(2)-oldB%imin(2)+1)
+    if ( Agrif_probdim == 3 ) cureff = (oldB%imax(1)-oldB%imin(1)+1) * &
+                                       (oldB%imax(2)-oldB%imin(2)+1) * &
+                                       (oldB%imax(3)-oldB%imin(3)+1)
+    nullify(parcbox)
+!
+    do i = 1,Agrif_Probdim
+        newB%imax(i) = oldB%imax(i)
+        newB%imin(i) = oldB%imin(i)
+    enddo
+!
+    ValMax = 0
+    do i = 1 , Agrif_Probdim
+        ValMax = Max(ValMax,istr(i))
+    enddo
+!
+    if (istr(1) == ValMax ) then
+        newB%imax(1) = islice(1)
+        call Agrif_Add_Rectangle(newB,parcbox)
+        newB%imin(1) = islice(1)+1
+        newB%imax(1) = oldB%imax(1)
+        call Agrif_Add_Rectangle(newB,parcbox)
+    else if ( Agrif_probdim >= 2 ) then
+        if (istr(2) == ValMax ) then
+            newB%imax(2) = islice(2)
+            call Agrif_Add_Rectangle(newB,parcbox)
+            newB%imin(2) = islice(2)+1
+            newB%imax(2) = oldB%imax(2)
+            call Agrif_Add_Rectangle(newB,parcbox)
+        else if ( Agrif_probdim == 3 ) then
+            newB%imax(3) = islice(3)
+            call Agrif_Add_Rectangle(newB,parcbox)
+            newB%imin(3) = islice(3)+1
+            newB%imax(3) = oldB%imax(3)
+            call Agrif_Add_Rectangle(newB,parcbox)
+        endif
+    endif
+!
+    do while ( associated(parcbox) )
+        newB = parcbox%r
+!
+        if ( Agrif_probdim == 1 ) nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
+        if ( Agrif_probdim == 2 ) nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1),    &
+                                                              newB%imin(2):newB%imax(2)))
+        if ( Agrif_probdim == 3 ) nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1),    &
+                                                              newB%imin(2):newB%imax(2),    &
+                                                              newB%imin(3):newB%imax(3)))
+!
+        if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
+        if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                              (newB%imax(2)-newB%imin(2)+1)
+        if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                              (newB%imax(2)-newB%imin(2)+1) * &
+                                              (newB%imax(3)-newB%imin(3)+1)
+        neweff = REAL(nbpoints) / TailleTab
+!
+        if ( nbpoints > 0 ) then
+!
+            if ( (neweff > Agrif_efficiency)) then
+                call Agrif_Add_Rectangle(newB,boxlib)
+            else
+                tempbox => boxlib
+                newB2 = newB
+                call Agrif_Clusternd(flag,boxlib,newB)
+!
+!               Compute new efficiency
+                cureff = neweff
+                parcbox2 => boxlib
+                nbpoints = 0
+                nbpointsflag = 0
+!
+                do while (associated(parcbox2))
+                    if (associated(parcbox2,tempbox)) exit
+                    newB = parcbox2%r
+!
+                    if ( Agrif_probdim == 1 ) ValSum = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
+                    if ( Agrif_probdim == 2 ) ValSum = SUM(flag%iarray2(newB%imin(1):newB%imax(1),  &
+                                                                        newB%imin(2):newB%imax(2)))
+                    if ( Agrif_probdim == 3 ) ValSum = SUM(flag%iarray3(newB%imin(1):newB%imax(1),  &
+                                                                        newB%imin(2):newB%imax(2),  &
+                                                                        newB%imin(3):newB%imax(3)))
+                    nbpointsflag = nbpointsflag + ValSum
+!
+                    if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
+                    if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                                          (newB%imax(2)-newB%imin(2)+1)
+                    if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                                          (newB%imax(2)-newB%imin(2)+1) * &
+                                                          (newB%imax(3)-newB%imin(3)+1)
+                    nbpoints = nbpoints + TailleTab
+                    parcbox2 => parcbox2%next
+                enddo
+!
+                if  ( REAL(nbpointsflag)/REAL(nbpoints) < (1.15*cureff)) then
+                    parcbox2 => boxlib
+                    do while (associated(parcbox2))
+                        if (associated(parcbox2,tempbox)) exit
+                        deallocate(parcbox2%r)
+                        parcbox2 => parcbox2%next
+                    enddo
+                    boxlib => tempbox
+                    call Agrif_Add_Rectangle(newB2,boxlib)
+                endif
+            endif
+        endif
+        parcbox => parcbox%next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Clusternd
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Clusterslice
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Clusterslice ( sig, slice, str )
+!---------------------------------------------------------------------------------------------------
+    INTEGER,                       intent(inout) :: slice
+    INTEGER,                       intent(inout) :: str
+    INTEGER, DIMENSION(slice:str), intent(in)    :: sig
+!
+    INTEGER                         :: ideb, ifin
+    INTEGER                         :: i, t, a, di, ts
+    INTEGER, DIMENSION(slice:str)   :: lap
+!
+    ideb = slice
+    ifin = str
+!
+    if (SIZE(sig) <= 2*Agrif_Minwidth) then
+        str = -1
+        slice = -1
+        return
+    endif
+!
+    t = -1
+    a = -1
+!
+    do i = ideb+Agrif_Minwidth-1,ifin-Agrif_Minwidth
+        if (sig(i) == 0) then
+            if ((i-ideb) < (ifin-i)) then
+                di = i - ideb
+            else
+                di = ifin - i
+            endif
+!
+            if (di > t) then
+                a = i
+                t = di
+            endif
+        endif
+    enddo
+!
+    if (a /= -1) then
+        slice = a
+        str = t
+        return
+    endif
+!
+    t = -1
+    a = -1
+!
+    do i = ideb+1,ifin-1
+        lap(i) = sig(i+1) + sig(i-1) - 2*sig(i)
+    enddo
+!
+    do i = ideb + Agrif_Minwidth-1,ifin-Agrif_Minwidth
+        if ((lap(i+1)*lap(i)) <= 0) then
+            ts = ABS(lap(i+1) - lap(i))
+            if (ts > t) then
+                t = ts
+                a = i
+            endif
+       endif
+    enddo
+!
+    if (a == (ideb + Agrif_Minwidth - 1)) then
+        a = -1
+        t = -1
+    endif
+!
+    slice = a
+    str = t
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Clusterslice
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Clusterprune
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Clusterprune ( sig, pl, pu )
+!---------------------------------------------------------------------------------------------------
+    INTEGER,                   intent(inout)    :: pl, pu
+    INTEGER, DIMENSION(pl:pu), intent(in)       :: sig
+!
+    INTEGER :: ideb, ifin
+    INTEGER :: diff, addl, addu, udist, ldist
+!
+    ideb = pl
+    ifin = pu
+!
+    if (SIZE(sig) <= Agrif_Minwidth) return
+!
+    do while ((sig(pl) == 0) .AND. (pl < ifin))
+        pl = pl + 1
+    enddo
+!
+    do while ((sig(pu) == 0) .AND. (pu > ideb))
+        pu = pu - 1
+    enddo
+!
+    if ( (pu-pl) < Agrif_Minwidth ) then
+        diff = Agrif_Minwidth - (pu - pl + 1)
+        udist = ifin - pu
+        ldist = pl - ideb
+        addl = diff / 2
+        addu = diff - addl
+        if (addu > udist) then
+            addu = udist
+            addl = diff - addu
+        endif
+!
+        if (addl > ldist) then
+            addl = ldist
+            addu = diff - addl
+        endif
+!
+        pu = pu + addu
+        pl = pl - addl
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Clusterprune
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Add_Rectangle
+!
+!> Adds the Agrif_Rectangle R in a list managed by LR.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Add_Rectangle ( R, LR )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Rectangle)           :: R
+    TYPE(Agrif_LRectangle), pointer :: LR
+!
+    TYPE(Agrif_LRectangle), pointer :: newrect
+!
+    integer                         :: i
+!
+    allocate(newrect)
+    allocate(newrect % r)
+!
+    newrect % r = R
+!
+    do i = 1,Agrif_Probdim
+        newrect % r % spaceref(i) = Agrif_Coeffref(i)
+        newrect % r % timeref(i)  = Agrif_Coeffreft(i)
+    enddo
+!
+    newrect % r % number = -1
+    newrect % next => LR
+    LR => newrect
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Add_Rectangle
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Copy_Rectangle
+!
+!> Creates and returns a copy of Agrif_Rectangle R.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Copy_Rectangle ( R, expand ) result( copy )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Rectangle), pointer, intent(in) :: R
+    integer, optional,              intent(in) :: expand
+!
+    TYPE(Agrif_Rectangle), pointer :: copy
+!
+    allocate(copy)
+!
+    copy = R
+    if ( present(expand) ) then
+        copy % imin = copy % imin - expand
+        copy % imax = copy % imax + expand
+    endif
+    copy % childgrids => R % childgrids
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Copy_Rectangle
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Read_Fix_Grd
+!
+!> Creates the grid hierarchy from the reading of the AGRIF_FixedGrids.in file.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Read_Fix_Grd ( parent_rect, j, nunit )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Rectangle), pointer   :: parent_rect !< Pointer on the first grid of the grid hierarchy
+    INTEGER                          :: j          !< Number of the new grid
+    INTEGER                          :: nunit      !< unit associated with file
+!
+    TYPE(Agrif_Rectangle)            :: newrect    ! Pointer on a new grid
+    TYPE(Agrif_LRectangle), pointer  :: parcours   ! Pointer for the recursive procedure
+    TYPE(Agrif_LRectangle), pointer  :: newlrect
+    TYPE(Agrif_LRectangle), pointer  :: end_list
+    INTEGER                          :: i,n        ! for each child grid
+    INTEGER                          :: nb_grids   ! Number of child grids
+!
+!   Reading of the number of child grids
+    read(nunit,*,end=99) nb_grids
+!
+    allocate(end_list)
+!
+    parent_rect % childgrids => end_list
+!
+!   Reading of imin(1),imax(1),imin(2),imax(2),imin(3),imax(3), and space and
+!        time refinement factors for each child grid.
+!   Creation and addition of the new grid to the grid hierarchy.
+!
+    do n = 1,nb_grids
+!
+        allocate(newlrect)
+        newrect % number = j   ! Number of the grid
+!
+        if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+            if (Agrif_Probdim == 3) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % imin(2), newrect % imax(2), &
+                              newrect % imin(3), newrect % imax(3), &
+                              newrect % spaceref(1), newrect % spaceref(2), newrect % spaceref(3), &
+                              newrect % timeref(1), newrect % timeref(2), newrect % timeref(3)
+            elseif (Agrif_Probdim == 2) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % imin(2), newrect % imax(2), &
+                              newrect % spaceref(1), newrect % spaceref(2), &
+                              newrect % timeref(1),  newrect % timeref(2)
+            elseif (Agrif_Probdim == 1) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % spaceref(1), &
+                              newrect % timeref(1)
+            endif
+        else
+            if (Agrif_Probdim == 3) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % imin(2), newrect % imax(2), &
+                              newrect % imin(3), newrect % imax(3), &
+                              newrect % spaceref(1), newrect % spaceref(2), newrect % spaceref(3), &
+                              newrect % timeref(1)
+            elseif (Agrif_Probdim == 2) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % imin(2), newrect % imax(2), &
+                              newrect % spaceref(1), newrect % spaceref(2), &
+                              newrect % timeref(1)
+            elseif (Agrif_Probdim == 1) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % spaceref(1), &
+                              newrect % timeref(1)
+            endif
+!
+            if ( Agrif_probdim >= 2 ) then
+                do i = 2,Agrif_probdim
+                    newrect % timeref(i) = newrect % timeref(1)
+                enddo
+            endif
+!
+        endif
+!
+!       Addition to the grid hierarchy
+!
+        j = j + 1
+        allocate(newlrect%r)
+        newlrect % r = newrect
+        end_list % next => newlrect
+        end_list => end_list % next
+!
+    enddo
+!
+    parent_rect % childgrids => parent_rect % childgrids % next
+    parcours => parent_rect % childgrids
+!
+!   recursive operation to create the grid hierarchy branch by branch
+!
+    do while ( associated(parcours) )
+        call Agrif_Read_Fix_Grd(parcours % r, j, nunit)
+        parcours => parcours % next
+    enddo
+99  continue
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Read_Fix_Grd
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Create_Grids
+!
+!> Creates the grid hierarchy (g) from the one created with the #Agrif_Read_Fix_Grd or
+!! #Agrif_Cluster_All procedures (parent_rect).
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Create_Grids ( parent_grid, parent_rect )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid)     , pointer  :: parent_grid  !< Pointer on the root coarse grid
+    TYPE(Agrif_Rectangle), pointer  :: parent_rect  !< Pointer on the root coarse grid of the grid hierarchy
+                                                    !!   created with the #Agrif_Read_Fix_Grd subroutine
+!
+    TYPE(Agrif_Grid)      , pointer :: child_grid   ! Newly created child grid
+    TYPE(Agrif_PGrid)     , pointer :: child_grid_p
+    TYPE(Agrif_LRectangle), pointer :: child_rect_p
+    type(Agrif_Rectangle),  pointer :: child_rect
+!
+    INTEGER                         :: i
+    INTEGER, save                   :: moving_grid_id = 0
+!
+    child_rect_p => parent_rect % childgrids
+!
+!   Creation of the grid hierarchy from the one created by using the Agrif_Read_Fix_Grd subroutine
+!
+    do while ( associated(child_rect_p) )
+!
+        child_rect => child_rect_p % r
+!
+        allocate(child_grid)
+!
+!       Pointer on the parent grid
+        child_grid % parent => parent_grid
+        child_grid % rect_in_parent => Agrif_Copy_Rectangle(child_rect_p % r, expand=Agrif_Extra_Boundary_Cells)
+!
+        moving_grid_id = moving_grid_id+1
+        child_grid % grid_id = moving_grid_id
+!
+        do i = 1,Agrif_Probdim
+            child_grid % spaceref(i) = child_rect % spaceref(i)
+            child_grid % timeref(i)  = child_rect % timeref(i)
+            child_grid % nb(i) = (child_rect % imax(i) - child_rect % imin(i)) * child_rect % spaceref(i)
+            child_grid % ix(i) =  child_rect % imin(i)
+            child_grid % Agrif_dt(i) = parent_grid % Agrif_dt(i) / REAL(child_grid % timeref(i))
+            child_grid % Agrif_dx(i) = parent_grid % Agrif_dx(i) / REAL(child_grid % spaceref(i))
+            child_grid % Agrif_x(i)  = parent_grid % Agrif_x(i) + &
+                                            (child_rect % imin(i) - 1) * parent_grid % Agrif_dx(i)
+        enddo
+!
+!       Size of the grid in terms of cpu cost (nx*ny*timeref)
+        child_grid % size = product( child_grid % nb(1:Agrif_Probdim) ) * child_grid % timeref(1)
+!
+!       Level of the current grid
+        child_grid % level = child_grid % parent % level + 1
+        if (child_grid % level > Agrif_MaxLevelLoc) then
+          Agrif_MaxLevelLoc = child_grid%level
+        endif
+!
+!       Number of the grid pointed by child_grid
+        child_grid % fixedrank = child_rect % number
+!
+!       Grid pointed by child_grid is a fixed grid
+        child_grid % fixed = ( child_grid % fixedrank > 0 )
+!
+!       Update the total number of fixed grids
+        if (child_grid % fixed) then
+            Agrif_nbfixedgrids = Agrif_nbfixedgrids + 1
+        endif
+!
+!       Initialize integration counter
+        child_grid % ngridstep = 0
+!
+!       Test indicating if the current grid has a common border with the root
+!       coarse grid in the x direction
+        do i = 1 , Agrif_Probdim
+!
+            child_grid % NearRootBorder(i) = (                  &
+                (child_grid % parent % NearRootBorder(i)) .AND. &
+                (child_grid % ix(i) == 1) )
+!
+            child_grid % DistantRootBorder(i) = (                  &
+                (child_grid % parent % DistantRootBorder(i)) .AND. &
+                (child_grid % ix(i) + (child_grid%nb(i)/child_grid%spaceref(i))-1  == child_grid % parent % nb(i)) )
+        enddo
+!
+!       Writing in output files
+        child_grid % oldgrid = .FALSE.
+!
+#if defined AGRIF_MPI
+        child_grid % communicator = parent_grid % communicator
+#endif
+!
+!       Definition of the characteristics of the variable of the grid pointed by child_grid
+        call Agrif_Create_Var(child_grid)
+!
+!       Addition of this grid to the grid hierarchy
+        call Agrif_gl_append( parent_grid % child_list, child_grid )
+!
+        child_rect_p => child_rect_p % next
+!
+    enddo
+!
+!   Recursive call to the subroutine Agrif_Create_Fixed_Grids to create the grid hierarchy
+!
+    child_grid_p => parent_grid % child_list % first
+    child_rect_p => parent_rect % childgrids
+!
+    do while ( associated(child_rect_p) )
+        call Agrif_Create_Grids( child_grid_p % gr, child_rect_p % r )
+        child_grid_p => child_grid_p % next
+        child_rect_p => child_rect_p % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Create_Grids
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Init_Hierarchy
+!
+!> Initializes all the grids except the root coarse grid (this one, pointed by Agrif_Types::Agrif_Mygrid, is
+!! initialized by the subroutine Agrif_Util#Agrif_Init_Grids defined in the module Agrif_Util and
+!! called in the main program).
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Init_Hierarchy ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    use Agrif_seq
+!
+    type(Agrif_Grid), pointer       :: g            !< Pointer on the current grid
+    procedure(init_proc), optional  :: procname     !< Initialisation subroutine (Default: Agrif_InitValues)
+!
+    TYPE(Agrif_PGrid), pointer :: parcours  ! Pointer for the recursive call
+    LOGICAL                    :: Init_Hierarchy
+!
+! Initialise the grand mother grid (if any)
+!
+    if ( associated(g, Agrif_Mygrid) .and. agrif_coarse ) then
+        call Agrif_Instance(Agrif_Coarsegrid)
+        call Agrif_Allocation(Agrif_Coarsegrid)
+        call Agrif_initialisations(Agrif_Coarsegrid)
+        call Agrif_InitWorkspace()
+!
+!       Initialization by interpolation (this routine is written by the user)
+        if (present(procname)) Then
+            call procname()
+        else
+            call Agrif_InitValues()
+        endif
+        call Agrif_Instance(Agrif_Mygrid)
+    endif
+
+    parcours => g % child_list % first
+!
+    do while ( associated(parcours) )
+!
+        Init_Hierarchy = .false.
+        if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
+            if ( (parcours%gr%fixed) .AND. (Agrif_Mygrid%ngridstep == 0) ) then
+                Init_Hierarchy = .true.
+            endif
+        endif
+!
+        if (.NOT. parcours % gr % fixed) Init_Hierarchy = .true.
+        if (parcours % gr % oldgrid)     Init_Hierarchy = .false.
+!
+        if (Init_Hierarchy) then
+!
+!           Instanciation of the grid pointed by parcours%gr and its variables
+            call Agrif_Instance(parcours % gr)
+!
+!           Allocation of the arrays containing values of the variables of the
+!           grid pointed by parcours%gr
+!
+            call Agrif_Allocation(parcours % gr)
+            call Agrif_initialisations(parcours % gr)
+!
+            if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+!               Initialization by copy of the grids created by clustering
+                call Agrif_Allocate_Restore(parcours % gr)
+                call Agrif_CopyFromOld_All(parcours % gr, Agrif_oldmygrid)
+            endif
+!
+!           Initialization by interpolation (this routine is written by the user)
+            call Agrif_InitWorkSpace()
+            if (present(procname)) Then
+                call procname()
+            else
+                call Agrif_InitValues()
+            endif
+!
+            if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+                call Agrif_Free_Restore(parcours % gr)
+            endif
+!
+        endif
+!
+        parcours => parcours % next
+!
+    enddo
+!
+    parcours => g % child_list % first
+!
+!   recursive operation to initialize all the grids
+    do while ( associated(parcours) )
+        call Agrif_Init_Hierarchy(parcours%gr,procname)
+        parcours => parcours%next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_Hierarchy
+!===================================================================================================
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!  subroutine Agrif_Init_Hierarchy_Parallel_1
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Init_Hierarchy_Parallel_1 ( g )
+!---------------------------------------------------------------------------------------------------
+    use Agrif_seq
+!
+    type(Agrif_Grid), pointer       :: g            !< Pointer on the current grid
+!
+    TYPE(Agrif_PGrid), pointer :: parcours  ! Pointer for the recursive call
+    LOGICAL                    :: Init_Hierarchy
+!
+    parcours => g % child_list % first
+!
+    do while ( associated(parcours) )
+!
+        Init_Hierarchy = .false.
+        if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
+            if ( (parcours%gr%fixed) .AND. (Agrif_Mygrid%ngridstep == 0) ) then
+                Init_Hierarchy = .true.
+            endif
+        endif
+!
+        if (.NOT. parcours % gr % fixed) Init_Hierarchy = .true.
+        if (parcours % gr % oldgrid)     Init_Hierarchy = .false.
+!
+        if (Init_Hierarchy) then
+!
+!           Instanciation of the grid pointed by parcours%gr and its variables
+            call Agrif_Instance(parcours % gr)
+!
+!           Allocation of the arrays containing values of the variables of the
+!           grid pointed by parcours%gr
+!
+            call Agrif_Allocation(parcours % gr)
+            call Agrif_initialisations(parcours % gr)
+!
+        endif
+!
+        parcours => parcours % next
+!
+    enddo
+!
+    parcours => g % child_list % first
+!
+!   recursive operation to initialize all the grids
+    do while ( associated(parcours) )
+        call Agrif_Init_Hierarchy_Parallel_1(parcours%gr)
+        parcours => parcours%next
+    enddo
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_Hierarchy_Parallel_1
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Init_Hierarchy_Parallel_2
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Init_Hierarchy_Parallel_2 ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    use Agrif_seq
+!
+    type(Agrif_Grid),     pointer   :: g            !< Pointer on the current grid
+    procedure(init_proc), optional  :: procname     !< Initialisation subroutine (Default: Agrif_InitValues)
+!
+    type(Agrif_PGrid), pointer :: parcours  ! Pointer for the recursive call
+    integer :: is
+!
+    call Agrif_Instance(g)
+    call Agrif_seq_init_sequences( g )
+!
+    if ( .not. associated(g % child_seq) ) return
+!
+    do is = 1, g % child_seq % nb_seqs
+!
+        parcours => Agrif_seq_select_child(g,is)
+!
+!     Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+!
+!     Initialization by interpolation (this routine is written by the user)
+        if (present(procname)) Then
+            call procname()
+        else
+            call Agrif_InitValues()
+        endif
+!
+        call Agrif_Init_ProcList(parcours % gr % proc_def_list, &
+                                 parcours % gr % proc_def_in_parent_list % nitems)
+!
+        call Agrif_Init_Hierarchy_Parallel_2(parcours%gr,procname)
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_Hierarchy_Parallel_2
+!===================================================================================================
+#endif
+!
+!===================================================================================================
+!  subroutine Agrif_Allocate_Restore
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Allocate_Restore ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid), pointer  :: Agrif_Gr   !< Pointer on the root coarse grid
+!
+    integer :: i
+!
+    do i = 1,Agrif_NbVariables(0)
+!
+        if ( Agrif_Mygrid%tabvars(i) % restore ) then
+            if ( Agrif_Gr%tabvars(i) % nbdim == 1 ) then
+                allocate( Agrif_Gr%tabvars(i)%Restore1D( &
+                    lbound(Agrif_Gr%tabvars(i)%array1,1):&
+                    ubound(Agrif_Gr%tabvars(i)%array1,1)))
+                Agrif_Gr%tabvars(i)%Restore1D = 0
+            endif
+            if ( Agrif_Gr%tabvars(i) % nbdim == 2 ) then
+                allocate( Agrif_Gr%tabvars(i)%Restore2D( &
+                    lbound(Agrif_Gr%tabvars(i)%array2,1):&
+                    ubound(Agrif_Gr%tabvars(i)%array2,1),&
+                    lbound(Agrif_Gr%tabvars(i)%array2,2):&
+                    ubound(Agrif_Gr%tabvars(i)%array2,2)))
+                Agrif_Gr%tabvars(i)%Restore2D = 0
+            endif
+            if ( Agrif_Mygrid%tabvars(i) % nbdim == 3 ) then
+                allocate( Agrif_Gr%tabvars(i)%Restore3D( &
+                    lbound(Agrif_Gr%tabvars(i)%array3,1):&
+                    ubound(Agrif_Gr%tabvars(i)%array3,1),&
+                    lbound(Agrif_Gr%tabvars(i)%array3,2):&
+                    ubound(Agrif_Gr%tabvars(i)%array3,2),&
+                    lbound(Agrif_Gr%tabvars(i)%array3,3):&
+                    ubound(Agrif_Gr%tabvars(i)%array3,3)))
+                Agrif_Gr%tabvars(i)%Restore3D = 0
+            endif
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Allocate_Restore
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_Restore
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Free_Restore ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid), pointer  :: Agrif_Gr   !< Pointer on the root coarse grid
+!
+    TYPE(Agrif_Variable), pointer :: var
+    integer                       :: i
+!
+    do i = 1,Agrif_NbVariables(0)
+!
+        if ( Agrif_Mygrid % tabvars(i) % restore ) then
+!
+            var = Agrif_Gr % tabvars(i)
+!
+            if (associated(var%Restore1D)) deallocate(var%Restore1D)
+            if (associated(var%Restore2D)) deallocate(var%Restore2D)
+            if (associated(var%Restore3D)) deallocate(var%Restore3D)
+            if (associated(var%Restore4D)) deallocate(var%Restore4D)
+            if (associated(var%Restore5D)) deallocate(var%Restore5D)
+            if (associated(var%Restore6D)) deallocate(var%Restore6D)
+!
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_Restore
+!===================================================================================================
+!
+end module Agrif_Clustering
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F	(revision 5659)
+++ 	(revision )
@@ -1,990 +1,0 @@
-!
-! $Id$
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_CurgridFunctions      
-C      
-      Module Agrif_CurgridFunctions    
-C  
-CCC   Description:
-CCC   Module to define some procedures concerning the current grid
-C
-C     Modules used: 
-C
-      Use Agrif_Init
-C
-      IMPLICIT NONE
-C
-C
-      Contains
-C     Define procedures contained in this module
-C
-C     **************************************************************************
-CCC   Function Agrif_Rhot
-C     **************************************************************************
-C
-      Function Agrif_Rhot()
-C  
-CCC   Description:
-CCC   Function returning the time refinement factor of the current grid.
-C
-C     Declarations:
-C  
-      
-C
-      REAL :: Agrif_Rhot  ! Result
-C
-C     Local scalar      
-      INTEGER :: res         ! Intermediate result
-      INTEGER :: iii
-C
-C
-      res=1
-C
-      do iii = 1 , Agrif_Probdim
-         res = max(res, AGRIF_Curgrid % timeref(iii))
-      enddo
-C
-      Agrif_Rhot = float(res)
-C
-C
-      End function Agrif_rhot
-C
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_IRhot
-C     **************************************************************************
-C
-      Function Agrif_IRhot()
-C  
-CCC   Description:
-CCC   Function returning the time refinement factor of the current grid.
-C
-C     Declarations:
-C  
-      
-C
-      INTEGER :: Agrif_IRhot  ! Result
-C
-C     Local scalar      
-      INTEGER :: res         ! Intermediate result
-      INTEGER :: iii
-C
-C
-      res=1
-C
-      do iii = 1 , Agrif_Probdim
-         res = max(res, AGRIF_Curgrid % timeref(iii))
-      enddo
-C
-      Agrif_IRhot = res
-C
-C
-      End function Agrif_IRhot
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Parent_Rhot
-C     **************************************************************************
-C
-      Function Agrif_Parent_Rhot()
-C  
-CCC   Description:
-CCC   Function returning the time refinement factor of the parent grid of the 
-CCC   current grid.
-C
-C     Declarations:
-C  
-      
-C
-      REAL :: Agrif_Parent_Rhot  ! Result
-C
-C     Local scalar      
-      INTEGER :: res         ! Intermediate result
-      INTEGER :: iii
-C
-C
-      res=1
-C
-      do iii = 1 , Agrif_Probdim
-         res = max(res, AGRIF_Curgrid % parent % timeref(iii))
-      enddo
-C
-      Agrif_Parent_Rhot = float(res)
-C
-C
-      End function Agrif_Parent_Rhot      
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Parent_IRhot
-C     **************************************************************************
-C
-      Function Agrif_Parent_IRhot()
-C  
-CCC   Description:
-CCC   Function returning the time refinement factor of the parent grid of the 
-CCC   current grid.
-C
-C     Declarations:
-C  
-      
-C
-      INTEGER :: Agrif_Parent_IRhot  ! Result
-C
-C     Local scalar      
-      INTEGER :: res         ! Intermediate result
-      INTEGER :: iii
-C
-C
-      res=1
-C
-      do iii = 1 , Agrif_Probdim
-         res = max(res, AGRIF_Curgrid % parent % timeref(iii))
-      enddo
-C
-      Agrif_Parent_IRhot = res
-C
-C
-      End function Agrif_Parent_IRhot      
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Nbstepint
-C     **************************************************************************
-C
-      Function Agrif_Nbstepint()
-C  
-CCC   Description:
-CCC   Function for the calculation of the coefficients used for the time 
-CCC   interpolation (module Agrif_Boundary).
-C
-C     Declarations:
-C  
-      
-C            
-      INTEGER :: Agrif_nbstepint  ! result
-C
-C
-      Agrif_nbstepint = mod(AGRIF_CURGRID % ngridstep,
-     &                      int(AGRIF_rhot()))
-C
-C
-      End function Agrif_Nbstepint
-C
-C
-C
-CC    **************************************************************************
-CCC   Function Agrif_Parent_Nbstepint
-C     **************************************************************************
-C
-      Function Agrif_Parent_Nbstepint()
-C  
-CCC   Description:
-CCC   Function for the calculation of the coefficients used for the time 
-CCC   interpolation (module Agrif_Boundary).
-C
-C     Declarations:
-C  
-      
-C            
-      INTEGER :: Agrif_Parent_Nbstepint  ! result
-C
-C
-      Agrif_Parent_Nbstepint = mod(AGRIF_CURGRID % parent % ngridstep, 
-     &                             int(AGRIF_Parent_Rhot()))
-C
-C
-      End function Agrif_Parent_Nbstepint
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpNearBorderX
-C     **************************************************************************
-C
-      Subroutine Agrif_InterpNearBorderX()
-C  
-CCC   Description:
-CCC   Subroutine allowing to interpole (in the x direction) on a near border of 
-CCC   the current grid if this one has a common border with the root coarse 
-CCC   grid.   
-C
-C     Declarations:
-C  
-      
-C
-C
-      AGRIF_CURGRID % NearRootBorder(1) = .FALSE.             
-C
-C
-      End Subroutine Agrif_InterpNearBorderX 
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpDistantBorderX
-C     **************************************************************************
-C
-      Subroutine Agrif_InterpDistantBorderX()
-C  
-CCC   Description:
-CCC   Subroutine allowing to interpole (in the x direction) on a distant border 
-CCC   of the current grid if this one has a common border with the root coarse  
-CCC   grid.
-C
-C     Declarations:
-C  
-
-C
-C
-      AGRIF_CURGRID % DistantRootBorder(1) = .FALSE.             
-C
-C
-      End Subroutine Agrif_InterpDistantBorderX                 
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpNearBorderY
-C     **************************************************************************
-C
-      Subroutine Agrif_InterpNearBorderY()
-C  
-CCC   Description:
-CCC   Subroutine allowing to interpole (in the y direction) on a near border of 
-CCC   the current grid if this one has a common border with the root coarse 
-CCC   grid.
-C
-C     Declarations:
-C  
-      
-C
-C
-      AGRIF_CURGRID % NearRootBorder(2) = .FALSE.             
-C
-C
-      End Subroutine Agrif_InterpNearBorderY
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpDistantBorderY
-C     **************************************************************************
-C
-      Subroutine Agrif_InterpDistantBorderY()
-C  
-CCC   Description:
-CCC   Subroutine allowing to interpole (in the y direction) on a distant border 
-CCC   of the current grid if this one has a common border with the root coarse  
-CCC   grid.
-C
-C     Declarations:
-C  
-      
-C
-C
-      AGRIF_CURGRID % DistantRootBorder(2) = .FALSE.             
-C
-C
-      End Subroutine Agrif_InterpDistantBorderY      
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpNearBorderZ
-C     **************************************************************************
-C
-      Subroutine Agrif_InterpNearBorderZ()
-C  
-CCC   Description:
-CCC   Subroutine allowing to interpole (in the z direction) on a near border of 
-CCC   the current grid if this one has a common border with the root coarse 
-CCC   grid.
-C
-C     Declarations:
-C  
-      
-C
-C
-      AGRIF_CURGRID % NearRootBorder(3) = .FALSE.             
-C
-C
-      End Subroutine Agrif_InterpNearBorderZ
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpDistantBorderZ
-C     **************************************************************************
-C
-      Subroutine Agrif_InterpDistantBorderZ()
-C  
-CCC   Description:
-CCC   Subroutine allowing to interpole (in the z direction) on a distant border 
-CCC   of the current grid if this one has a common border with the root coarse  
-CCC   grid.
-C
-C     Declarations:
-C  
-      
-C
-C
-      AGRIF_CURGRID % DistantRootBorder(3) = .FALSE.             
-C
-C
-      End Subroutine Agrif_InterpDistantBorderZ
-C 
-C     **************************************************************************
-CCC   Function Agrif_Parent_Nb_Step
-C     ************************************************************************** 
-C 
-      Function AGRIF_Parent_Nb_Step() 
-C  
-CCC   Description:
-CCC   Function returning the number of time steps of the parent grid of the
-CCC   current grid.
-C
-C     Declarations:
-C    
-      
-C
-      INTEGER :: AGRIF_Parent_Nb_Step ! Result 
-C
-C
-      if (Agrif_Root()) then  
-C     
-          Agrif_Parent_Nb_Step = -1 
-C       
-        else
-C       
-          Agrif_Parent_Nb_Step = Agrif_Curgrid % parent % ngridstep
-C     
-      endif
-C
-C     
-      End function Agrif_Parent_Nb_Step    
-C 
-C
-C 
-C     **************************************************************************
-CCC   Function Agrif_Root
-C     **************************************************************************
-C
-      Function Agrif_Root()
-C     
-CCC   Description:
-CCC   Function indicating if the current grid is or not the root grid.
-C
-C     Declarations:
-C
-      
-C
-      LOGICAL :: Agrif_Root   ! Result
-C    
-C
-      if (AGRIF_CURGRID % fixedrank .EQ. 0) then
-C          
-          Agrif_Root = .TRUE.
-C    
-        else
-C    
-          Agrif_Root = .FALSE.
-C     
-      endif
-C
-C    
-      End function Agrif_Root
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Parent_Root
-C     **************************************************************************
-C
-      Function Agrif_Parent_Root()
-C     
-CCC   Description:
-CCC   Function indicating if the parent grid of the current grid is or not the 
-CCC   root grid.
-C
-C     Declarations:
-C
-      
-C
-      LOGICAL :: Agrif_Parent_Root   ! Result
-C    
-C
-      if (AGRIF_CURGRID % parent % fixedrank .EQ. 0) then
-C          
-          Agrif_Parent_Root = .TRUE.
-C    
-        else
-C    
-          Agrif_Parent_Root = .FALSE.
-C     
-      endif
-C
-C    
-      End function Agrif_Parent_Root     
-C 
-C
-C 
-C     **************************************************************************
-CCC   Function Agrif_Fixed
-C     **************************************************************************
-C 
-      Function Agrif_Fixed()
-C  
-CCC   Description:
-CCC   Function returning the number of the current grid.
-C
-C     Declarations:
-C   
-      
-C
-      INTEGER Agrif_Fixed   ! Result 
-C 
-C
-      if (Agrif_Curgrid % fixed) then
-C     
-          Agrif_Fixed = Agrif_Curgrid % fixedrank 
-C
-        else
-C     
-         Agrif_Fixed = -1
-C        
-      endif
-C
-C     
-      End function Agrif_Fixed 
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Parent_Fixed
-C     **************************************************************************
- 
-      Function Agrif_Parent_Fixed()
-C  
-CCC   Description:
-CCC   Function returning the number of the parent grid of the current grid.
-C
-C     Declarations:
-C   
-      
-C
-      INTEGER Agrif_Parent_Fixed   ! Result 
-C 
-C
-      if (Agrif_Curgrid % parent % fixed) then
-C     
-          Agrif_Parent_Fixed = AGRIF_CURGRID % parent % fixedrank 
-C
-        else
-C     
-         Agrif_Parent_Fixed = 0
-C        
-      endif
-C
-C     
-      End function Agrif_Parent_Fixed
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Is_Fixed
-C     **************************************************************************
- 
-      Function Agrif_Is_Fixed()
-C  
-CCC   Description:
-CCC   Function returning true if the current grid is fixed.
-C
-C     Declarations:
-C   
-      
-C
-      LOGICAL Agrif_Is_Fixed   ! Result 
-C 
-C
-      if (Agrif_Curgrid % fixed) then
-C     
-          Agrif_Is_Fixed = .true.
-C
-        else
-C     
-          Agrif_Is_Fixed = .false.
-C        
-      endif
-C
-C     
-      End function Agrif_Is_Fixed
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Parent_Is_Fixed
-C     **************************************************************************
- 
-      Function Agrif_Parent_Is_Fixed()
-C  
-CCC   Description:
-CCC   Function returning true if the parent grid of the current grid is fixed.
-C
-C     Declarations:
-C   
-      
-C
-      LOGICAL Agrif_Parent_Is_Fixed   ! Result 
-C 
-C
-      if (Agrif_Curgrid % parent % fixed) then
-C     
-          Agrif_Parent_Is_Fixed = .true.
-C
-        else
-C     
-          Agrif_Parent_Is_Fixed = .false.
-C        
-      endif
-C
-C     
-      End function Agrif_Parent_Is_Fixed            
-C
-C 
-C
-C     **************************************************************************
-CCC   Function AGRIF_CFixed
-C     **************************************************************************
- 
-            Function AGRIF_CFixed()
-C  
-CCC   Description:
-CCC   Function returning the number of the current grid.
-C
-C     Declarations:
-C   
-      
-C
-      CHARACTER(3) AGRIF_CFixed   ! Result 
-C
-C     Local variables      
-      CHARACTER(3) cfixed
-      INTEGER fixed
-C 
-C
-      fixed = Agrif_Fixed()
-C      
-      if(fixed.NE.-1) then
-C
-           if (fixed .LE. 9) then
-C
-               write(cfixed,'(i1)')fixed
-C 
-           else
-C   
-               write(cfixed,'(i2)')fixed
-C      
-           endif
-C
-           AGrif_Cfixed=cfixed
-C      
-      else
-C
-      print*,'Call to AGRIF_CFixed() on a moving grid'
-      stop
-C
-      endif     
-
-      End function AGRIF_CFixed
-C
-C
-C
-C     **************************************************************************
-CCC   Function AGRIF_Parent_CFixed
-C     **************************************************************************
- 
-      Function AGRIF_Parent_CFixed()
-C  
-CCC   Description:
-CCC   Function returning the number of the parent grid of the current grid.
-C
-C     Declarations:
-C   
-      
-C
-      CHARACTER(3) AGRIF_Parent_CFixed   ! Result 
-C
-C     Local variables      
-      CHARACTER(3) cfixed
-      INTEGER fixed
-C 
-C
-      fixed = Agrif_Parent_Fixed()
-C      
-      if(fixed.NE.-1) then
-C
-          if (fixed .LE. 9) then
-C
-              write(cfixed,'(i1)')fixed
-C      
-          else
-C        
-              write(cfixed,'(i2)')fixed
-C      
-          endif
-C
-          AGrif_Parent_Cfixed=cfixed
-C
-      else
-C
-      print*,'Illegal call to AGRIF_Parent_CFixed()'
-      stop     
-C
-      endif
-
-      End function AGRIF_Parent_CFixed      
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_ChildGrid_to_ParentGrid
-C     **************************************************************************
-C
-      Subroutine Agrif_ChildGrid_to_ParentGrid()
-C  
-CCC   Description:
-CCC   Subroutine allowing to make the pointer AGRIF_CURGRID point on the parent
-CCC   grid of the current grid.
-C
-C     Declarations:
-C  
-      
-C
-      
-      Agrif_Curgrid%Parent%save_grid => Agrif_Curgrid
-C
-      Call Agrif_Instance(Agrif_Curgrid%parent)            
-C
-C
-      End Subroutine Agrif_ChildGrid_to_ParentGrid
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_ParentGrid_to_ChildGrid
-C     **************************************************************************
-C
-      Subroutine Agrif_ParentGrid_to_ChildGrid()
-C  
-CCC   Description:
-CCC   Subroutine allowing to make the pointer AGRIF_CURGRID point on the child 
-CCC   grid after having called the Agrif_ChildGrid_to_ParentGrid subroutine.
-C
-C     Declarations:
-C  
-      
-C
-C
-      Call Agrif_Instance(Agrif_Curgrid%save_grid)
-C
-C
-      End Subroutine Agrif_ParentGrid_to_ChildGrid
-C
-C
-C
-C     **************************************************************************
-CCC   Function Agrif_Get_Unit
-C     **************************************************************************
-C
-      Function Agrif_Get_Unit()
-
-CCC   Description : return a unit not connected to any file
-C
-C     Declarations
-C
-      
-C
-      INTEGER Agrif_Get_Unit
-C
-C     Local scalars
-      INTEGER n
-      LOGICAL op
-C
-      INTEGER :: nunit
-      INTEGER :: iii,out,iiimax
-      Logical :: BEXIST
-      INTEGER,DIMENSION(1:1000) :: ForbiddenUnit
-C
-C
-C     Load forbidden Unit if the file Agrif_forbidenUnit exist
-C      
-
-      INQUIRE(FILE='Agrif_forbiddenUnit.txt',EXIST=BEXIST)
-      If (.not. BEXIST) Then
-c          File Agrif_forbiddenUnit.txt not found
-      Else
-           nunit = 777
-           open(nunit,file='Agrif_forbiddenUnit.txt',form='formatted',
-     &          status="old")
-              iii = 1
-              do while ( .TRUE. )
-                 read(nunit,*,END = 99) ForbiddenUnit(iii)
-                 iii = iii + 1
-              enddo
-   99         CONTINUE
-              iiimax = iii
-           close(nunit)
-      endif     
-C 
-      do n = 7,1000
-C 
-        Inquire(Unit=n,Opened=op)
-C
-        out = 0
-        if ( BEXIST .AND. .NOT.op) then
-           do iii = 1 , iiimax
-              if ( n .EQ. ForbiddenUnit(iii) ) out = 1
-           enddo
-        endif
-C
-        if (.NOT.op .AND. out .EQ. 0) exit
-C      
-      enddo
-C
-      Agrif_Get_Unit=n
-C
-C
-      End Function Agrif_Get_Unit
-      
-      Subroutine Agrif_Set_Efficiency(eff)
-      REAL :: eff
-      
-      IF ((eff.LT.0.).OR.(eff.GT.1)) THEN
-      write(*,*)'Error Efficiency should be between 0 and 1'
-      stop
-      ELSE
-      Agrif_efficiency = eff
-      ENDIF
-      End Subroutine Agrif_Set_Efficiency
-      
-      Subroutine Agrif_Set_Regridding(regfreq)
-      INTEGER :: regfreq
-      
-      IF (regfreq.LT.0) THEN
-      write(*,*)'Regridding frequency should be positive'
-      stop
-      ELSE
-      Agrif_regridding = regfreq
-      ENDIF
-      End Subroutine Agrif_Set_Regridding
-C
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_coeffref_x
-C     **************************************************************************
-      subroutine Agrif_Set_coeffref_x(coefref)
-
-      integer :: coefref
-
-      if (coefref.LT.0) then
-         write(*,*)'Coefficient of raffinement should be positive'
-         stop
-      else
-         AGRIF_coeffref(1) = coefref
-      endif
-      end subroutine Agrif_Set_coeffref_x
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_coeffref_y
-C     **************************************************************************
-      subroutine Agrif_Set_coeffref_y(coefref)
-
-      integer :: coefref
-
-      if (coefref.LT.0) then
-         write(*,*)'Coefficient of raffinement should be positive'
-         stop
-      else
-         AGRIF_coeffref(2) = coefref
-      endif
-      end subroutine Agrif_Set_coeffref_y
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_coeffref_z
-C     **************************************************************************
-      subroutine Agrif_Set_coeffref_z(coefref)
-
-      integer :: coefref
-
-      if (coefref.LT.0) then
-         write(*,*)'Coefficient of raffinement should be positive'
-         stop
-      else
-         AGRIF_coeffref(3) = coefref
-      endif
-      end subroutine Agrif_Set_coeffref_z
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_coeffreft_x
-C     **************************************************************************
-      subroutine Agrif_Set_coeffreft_x(coefref)
-
-      integer :: coefref
-
-      if (coefref.LT.0) then
-         write(*,*)'Coefficient of time raffinement should be positive'
-         stop
-      else
-         AGRIF_coeffreft(1) = coefref
-      endif
-      end subroutine Agrif_Set_coeffreft_x
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_coeffreft_y
-C     **************************************************************************
-      subroutine Agrif_Set_coeffreft_y(coefref)
-
-      integer :: coefref
-
-      if (coefref.LT.0) then
-         write(*,*)'Coefficient of time raffinement should be positive'
-         stop
-      else
-         AGRIF_coeffreft(2) = coefref
-      endif
-      end subroutine Agrif_Set_coeffreft_y
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_coeffreft_z
-C     **************************************************************************
-      subroutine Agrif_Set_coeffreft_z(coefref)
-
-      integer :: coefref
-
-      if (coefref.LT.0) then
-         write(*,*)'Coefficient of time raffinement should be positive'
-         stop
-      else
-         AGRIF_coeffreft(3) = coefref
-      endif
-      end subroutine Agrif_Set_coeffreft_z
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_Minwidth
-C     **************************************************************************
-      subroutine Agrif_Set_Minwidth(coefminwidth)
-
-      integer :: coefminwidth
-
-      if (coefminwidth.LT.0) then
-         write(*,*)'Coefficient of Minwidth should be positive'
-         stop
-      else
-         Agrif_Minwidth = coefminwidth
-      endif
-      end subroutine Agrif_Set_Minwidth
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Set_Rafmax
-C     **************************************************************************
-      subroutine Agrif_Set_Rafmax(coefrafmax)
-
-      integer :: coefrafmax
-      integer :: i
-      real :: res
-
-      if (coefrafmax.LT.0) then
-         write(*,*)'Coefficient of  should be positive'
-         stop
-      else
-         res = 1.
-         do i = 1 , coefrafmax - 1
-            res = res * FLOAT(AGRIF_coeffref(1))
-         enddo
-         if ( res .EQ. 0 ) res = 1
-         Agrif_Mind(1) = 1. / res
-C
-         res = 1.
-         do i = 1 , coefrafmax - 1
-            res = res * FLOAT(AGRIF_coeffref(2))
-         enddo
-         if ( res .EQ. 0 ) res = 1
-         Agrif_Mind(2) = 1. / res
-C
-         res = 1.
-         do i = 1 , coefrafmax - 1
-            res = res * FLOAT(AGRIF_coeffref(3))
-         enddo
-         if ( res .EQ. 0 ) res = 1
-         Agrif_Mind(3) = 1. / res
-C
-      endif
-      end subroutine Agrif_Set_Rafmax
-C
-C     **************************************************************************
-CCC   subroutine Agrif_Open_File
-C     **************************************************************************
-      subroutine Agrif_Open_File(num_id,name_file)
-
-      integer :: num_id
-      character(*) :: name_file
-
-      num_id = Agrif_Get_Unit()
-      if ( .NOT. Agrif_Root() ) then
-         name_file = TRIM(Agrif_CFixed())//'_'//TRIM(name_file)
-      endif
-
-      end subroutine Agrif_Open_File
-
-C     **************************************************************************
-CCC    subroutine Agrif_Set_MaskMaxSearch
-C     **************************************************************************
-      subroutine Agrif_Set_MaskMaxSearch(mymaxsearch)
-      integer mymaxsearch
-      MaxSearch = mymaxsearch
-      end subroutine Agrif_Set_MaskMaxSearch
-      
-C *****************************************************************
-CCC  subroutine Agrif_Level
-C *****************************************************************
-      Function Agrif_Level()
-      Integer :: Agrif_Level
-     
-      Agrif_Level = Agrif_Curgrid % level
-     
-      End Function Agrif_Level
-      
-C *****************************************************************
-CCC  subroutine Agrif_MaxLevel
-C *****************************************************************
-      Function Agrif_MaxLevel()
-      Integer :: Agrif_MaxLevel
-     
-      Agrif_MaxLevel = Agrif_MaxLevelLoc
-     
-      End Function Agrif_MaxLevel      
-
-      End Module Agrif_CurgridFunctions 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90	(revision 5682)
@@ -0,0 +1,765 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+!
+!> Module to define some procedures concerning the current grid
+!
+module Agrif_CurgridFunctions
+!
+    use Agrif_Init
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  function Agrif_rel_dt
+!
+!> Returns the time step of the current grid, relatively to the root grid (for which dt=1.).
+!---------------------------------------------------------------------------------------------------
+function Agrif_rel_dt ( ) result( rel_dt )
+!---------------------------------------------------------------------------------------------------
+    integer :: i
+    real    :: rel_dt
+!
+    rel_dt = 1.
+!
+    do i = 1,Agrif_Probdim
+        rel_dt = min(rel_dt, Agrif_Curgrid % Agrif_dt(i))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_rel_dt
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_rel_idt
+!
+!> Returns the time refinement factor of the current grid, relatively to the root grid (for which idt=1).
+!---------------------------------------------------------------------------------------------------
+function Agrif_rel_idt ( ) result( rel_idt )
+!---------------------------------------------------------------------------------------------------
+    integer :: rel_idt
+!
+    rel_idt = nint(1./Agrif_rel_dt())
+!---------------------------------------------------------------------------------------------------
+end function Agrif_rel_idt
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_IRhot
+!
+!> Returns the time refinement factor of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_IRhot ( ) result( irhot )
+!---------------------------------------------------------------------------------------------------
+    integer :: i, irhot
+!
+    irhot = 1
+!
+    do i = 1,Agrif_Probdim
+        irhot = max(irhot, Agrif_Curgrid % timeref(i))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_IRhot
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Rhot
+!
+!> Returns the time refinement factor of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Rhot ( ) result( rhot )
+!---------------------------------------------------------------------------------------------------
+    real    :: rhot
+!
+    rhot = float(Agrif_IRhot())
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Rhot
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_IRhot
+!
+!> Returns the time refinement factor of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_IRhot ( ) result( irhot )
+!---------------------------------------------------------------------------------------------------
+    integer :: i, irhot
+!
+    irhot = 1
+!
+    do i = 1,Agrif_Probdim
+        irhot = max(irhot, Agrif_Curgrid % parent % timeref(i))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_IRhot
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Rhot
+!
+!> Returns the time refinement factor of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Rhot ( ) result( rhot )
+!---------------------------------------------------------------------------------------------------
+    real :: rhot
+!
+    rhot = float(Agrif_Parent_IRhot())
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Rhot
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Nbstepint
+!
+!> function for the calculation of the coefficients used for the time interpolation
+!! (module #Agrif_Boundary).
+!---------------------------------------------------------------------------------------------------
+function Agrif_Nbstepint ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_nbstepint ! result
+!
+    Agrif_nbstepint = mod(Agrif_Curgrid % ngridstep, Agrif_iRhot())
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Nbstepint
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Nbstepint
+!
+!> function for the calculation of the coefficients used for the time interpolation
+!! (module #Agrif_Boundary).
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Nbstepint ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Parent_Nbstepint ! result
+!
+    Agrif_Parent_Nbstepint = mod(Agrif_Curgrid % parent % ngridstep, int(Agrif_Parent_Rhot()))
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Nbstepint
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpNearBorderX
+!
+!> Allows to interpolate (in the x direction) on a near border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpNearBorderX ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % NearRootBorder(1) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpNearBorderX
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpDistantBorderX
+!
+!> Allows to interpolate (in the x direction) on a distant border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpDistantBorderX ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % DistantRootBorder(1) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpDistantBorderX
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpNearBorderY
+!
+!> Allows to interpolate (in the y direction) on a near border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpNearBorderY ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % NearRootBorder(2) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpNearBorderY
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpDistantBorderY
+!
+!> Allows to interpolate (in the y direction) on a distant border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpDistantBorderY ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % DistantRootBorder(2) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpDistantBorderY
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpNearBorderZ
+!
+!> Allows to interpolate (in the z direction) on a near border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpNearBorderZ ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % NearRootBorder(3) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpNearBorderZ
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpDistantBorderZ
+!
+!> Allows to interpolate (in the z direction) on a distant border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpDistantBorderZ()
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % DistantRootBorder(3) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpDistantBorderZ
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Nb_Step
+!
+!> Returns the number of time steps of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Nb_Step ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Parent_Nb_Step ! Result
+!
+    if (Agrif_Root()) then
+        Agrif_Parent_Nb_Step = -1
+    else
+        Agrif_Parent_Nb_Step = Agrif_Curgrid % parent % ngridstep
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Nb_Step
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Root
+!
+!> Indicates if the current grid is or not the root grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Root ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_Root ! Result
+!
+    Agrif_Root = (Agrif_Curgrid % fixedrank == 0)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Root
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_GrandMother
+!
+!> Indicates if the current grid is or not the root grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_GrandMother ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_GrandMother ! Result
+!
+    Agrif_GrandMother = Agrif_Curgrid % grand_mother_grid
+!---------------------------------------------------------------------------------------------------
+end function Agrif_GrandMother
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Root
+!
+!> Indicates if the parent of the current grid is or not the root grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Root ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_Parent_Root ! Result
+!
+    Agrif_Parent_Root = (Agrif_Curgrid % parent % fixedrank == 0)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Root
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Fixed
+!
+!> Returns the number of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Fixed ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Fixed   ! Result
+!
+    if (Agrif_Curgrid % fixed) then
+        Agrif_Fixed = Agrif_Curgrid % fixedrank
+    else
+        Agrif_Fixed = -1
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Fixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Fixed
+!
+!> Returns the number of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Fixed ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Parent_Fixed   ! Result
+!
+    if (Agrif_Curgrid % parent % fixed) then
+        Agrif_Parent_Fixed = Agrif_Curgrid % parent % fixedrank
+    else
+        Agrif_Parent_Fixed = 0
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Fixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Is_Fixed
+!
+!> Returns .TRUE. if the current grid is fixed.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Is_Fixed ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_Is_Fixed   ! Result
+!
+    Agrif_Is_Fixed = Agrif_Curgrid % fixed
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Is_Fixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Is_Fixed
+!
+!> Returns .TRUE. if the parent of the current grid is fixed.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Is_Fixed ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_Parent_Is_Fixed   ! Result
+!
+    Agrif_Parent_Is_Fixed = Agrif_Curgrid % parent % fixed
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Is_Fixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_CFixed
+!
+!> Returns the number of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_CFixed ( )
+!---------------------------------------------------------------------------------------------------
+    character(3) :: Agrif_CFixed   ! Result
+!
+    character(3) :: cfixed
+    integer      :: fixed
+!
+    fixed = Agrif_Fixed()
+!
+    if (fixed /= -1) then
+!
+        if (fixed <= 9) then
+            write(cfixed,'(i1)') fixed
+        else
+            write(cfixed,'(i2)') fixed
+        endif
+!
+        Agrif_CFixed = cfixed
+        
+        if (associated(agrif_curgrid,agrif_coarsegrid)) then
+          Agrif_CFixed = 'gm'
+        endif
+!
+    else
+        print*,'Call to Agrif_CFixed() on a moving grid'
+        stop
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_CFixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrid_Parent_CFixed
+!
+!> Returns the number of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrid_Parent_CFixed ( )
+!---------------------------------------------------------------------------------------------------
+    character(3) :: Agrid_Parent_CFixed   ! Result
+!
+    character(3) :: cfixed
+    integer      :: fixed
+!
+    fixed = Agrif_Parent_Fixed()
+!
+    if(fixed /= -1) then
+!
+        if (fixed <= 9) then
+            write(cfixed,'(i1)')fixed
+        else
+            write(cfixed,'(i2)')fixed
+        endif
+!
+        Agrid_Parent_CFixed=cfixed
+!
+    else
+        print*,'Illegal call to Agrid_Parent_CFixed()'
+        stop
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrid_Parent_CFixed
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_ChildGrid_to_ParentGrid
+!
+!> Make the pointer #Agrif_Curgrid point on the parent grid of the current grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_ChildGrid_to_ParentGrid ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % parent % save_grid => Agrif_Curgrid
+    call Agrif_Instance(Agrif_Curgrid%parent)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_ChildGrid_to_ParentGrid
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_ParentGrid_to_ChildGrid
+!
+!> Make the pointer #Agrif_Curgrid point on the child grid after having called the
+!! #Agrif_ChildGrid_to_ParentGrid subroutine.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_ParentGrid_to_ChildGrid ( )
+!---------------------------------------------------------------------------------------------------
+    call Agrif_Instance(Agrif_Curgrid%save_grid)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_ParentGrid_to_ChildGrid
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Get_Unit
+!
+!> Returns a unit not connected to any file.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Get_Unit ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Get_Unit  ! Result
+!
+    integer :: n
+    logical :: op
+!
+    integer :: nunit
+    integer :: iii, out, iiimax
+    logical :: bexist
+    integer,dimension(1:1000) :: forbiddenunit
+!
+!   Load forbidden Unit if the file Agrif_forbidenUnit exist
+!
+    INQUIRE(file='Agrif_forbiddenUnit.txt', exist=bexist)
+!
+    if (.not. bexist) then
+!       File Agrif_forbiddenUnit.txt not found
+    else
+        nunit = 777
+        OPEN(nunit,file='Agrif_forbiddenUnit.txt', form='formatted', status="old")
+        iii = 1
+        do while ( .TRUE. )
+            READ(nunit,*, end=99) forbiddenunit(iii)
+            iii = iii + 1
+        enddo
+   99   continue
+        iiimax = iii
+        close(nunit)
+    endif
+!
+    do n = 7,1000
+!
+        INQUIRE(Unit=n,Opened=op)
+!
+        out = 0
+        if ( bexist .AND. (.NOT.op) ) then
+            do iii = 1,iiimax
+                if ( n == forbiddenunit(iii) ) out = 1
+            enddo
+        endif
+!
+        if ( (.NOT.op) .AND. (out == 0) ) exit
+!
+    enddo
+!
+    Agrif_Get_Unit = n
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Get_Unit
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Extra_Boundary_Cells
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Extra_Boundary_Cells ( nb_extra_cells )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: nb_extra_cells
+!
+    Agrif_Extra_Boundary_Cells = nb_extra_cells
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Extra_Boundary_Cells
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Efficiency
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Efficiency ( eff )
+!---------------------------------------------------------------------------------------------------
+    real, intent(in) :: eff
+!
+    if ( (eff < 0.) .OR. (eff > 1) ) then
+        write(*,*) 'Error Efficiency should be between 0 and 1'
+        stop
+    else
+        Agrif_Efficiency = eff
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Efficiency
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Regridding
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Regridding ( regfreq )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: regfreq
+!
+    if (regfreq < 0) then
+        write(*,*) 'Regridding frequency should be positive'
+        stop
+    else
+        Agrif_Regridding = regfreq
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Regridding
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffref_x
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffref_x ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+
+      if (coeffref < 0) then
+         write(*,*) 'Coefficient of raffinement should be positive'
+         stop
+      else
+         Agrif_coeffref(1) = coeffref
+      endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffref_x
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffref_y
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffref_y ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+
+    if (coeffref < 0) then
+        write(*,*) 'Coefficient of raffinement should be positive'
+        stop
+    else
+        Agrif_coeffref(2) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffref_y
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffref_z
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffref_z ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+!
+    if (coeffref < 0) then
+        write(*,*) 'Coefficient of raffinement should be positive'
+        stop
+    else
+        Agrif_coeffref(3) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffref_z
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffreft_x
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffreft_x ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+
+    if (coeffref < 0) then
+        write(*,*) 'Coefficient of time raffinement should be positive'
+        stop
+    else
+        Agrif_coeffreft(1) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffreft_x
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffreft_y
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffreft_y ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+!
+    if (coeffref < 0) then
+        write(*,*) 'Coefficient of time raffinement should be positive'
+        stop
+    else
+        Agrif_coeffreft(2) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffreft_y
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffreft_z
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffreft_z ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+
+    if (coeffref < 0) then
+        write(*,*)'Coefficient of time raffinement should be positive'
+        stop
+    else
+        Agrif_coeffreft(3) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffreft_z
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Minwidth
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Minwidth ( coefminwidth )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coefminwidth
+!
+    if (coefminwidth < 0) then
+        write(*,*)'Coefficient of Minwidth should be positive'
+        stop
+    else
+        Agrif_Minwidth = coefminwidth
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Minwidth
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Rafmax
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Rafmax ( coefrafmax )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coefrafmax
+!
+    integer :: i
+    real    :: res
+!
+    if (coefrafmax < 0) then
+        write(*,*)'Coefficient of  should be positive'
+        stop
+    else
+        res = 1.
+        do i = 1,coefrafmax-1
+            res = res * FLOAT(Agrif_coeffref(1))
+        enddo
+        if ( res == 0 ) res = 1
+        Agrif_Mind(1) = 1. / res
+!
+        res = 1.
+        do i = 1,coefrafmax-1
+            res = res * FLOAT(Agrif_coeffref(2))
+        enddo
+        if ( res == 0 ) res = 1
+        Agrif_Mind(2) = 1. / res
+!
+        res = 1.
+        do i = 1,coefrafmax-1
+            res = res * FLOAT(Agrif_coeffref(3))
+        enddo
+        if ( res == 0 ) res = 1
+        Agrif_Mind(3) = 1. / res
+!
+      endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Rafmax
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_MaskMaxSearch
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_MaskMaxSearch ( mymaxsearch )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: mymaxsearch
+!
+    MaxSearch = mymaxsearch
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_MaskMaxSearch
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Level
+!---------------------------------------------------------------------------------------------------
+function Agrif_Level ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Level  ! Result
+!
+    Agrif_Level = Agrif_Curgrid % level
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Level
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_MaxLevel
+!---------------------------------------------------------------------------------------------------
+function Agrif_MaxLevel ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_MaxLevel  ! Result
+!
+    Agrif_MaxLevel = Agrif_MaxLevelLoc
+!---------------------------------------------------------------------------------------------------
+end function Agrif_MaxLevel
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_GridAllocation_is_done
+!---------------------------------------------------------------------------------------------------
+function Agrif_GridAllocation_is_done ( ) result(isdone)
+!---------------------------------------------------------------------------------------------------
+    logical :: isdone
+!
+    isdone = Agrif_Curgrid % allocation_is_done
+!---------------------------------------------------------------------------------------------------
+end function Agrif_GridAllocation_is_done
+!===================================================================================================
+!
+end module Agrif_CurgridFunctions
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F	(revision 5659)
+++ 	(revision )
@@ -1,339 +1,0 @@
-C     Agrif (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_fluxmod
-C
-      Module Agrif_fluxmod
-      Use Agrif_types
-      Use Agrif_Arrays
-      Use Agrif_Curgridfunctions
-      
-      CONTAINS  
-      
-      
-      Subroutine Agrif_AllocateFlux(Flux,fluxtab)
-      Type(Agrif_Flux), Pointer :: Flux
-      Real, Dimension(:,:) :: fluxtab
-      Type(Agrif_Profile), Pointer :: Profile
-      Integer :: dimensio,n,n2
-      INTEGER, DIMENSION(:,:), Pointer :: normalsizes
-      INTEGER, DIMENSION(6) :: unitarray
-      Type(Agrif_Variable), Pointer :: fluxtabvar
-      Integer :: nbout
-      
-      Profile => Flux%profile
-      dimensio = Profile%nbdim
-      
-      unitarray = 1
-      
-      do n=1,dimensio
-        IF (Profile%posvar(n) == 1) THEN
-          IF (Profile%interptab(n) == 'x') THEN
-            Allocate(Flux%fluxtabx)
-            fluxtabvar => Flux%fluxtabx
-          ELSE IF (Profile%interptab(n) == 'y') THEN
-            Allocate(Flux%fluxtaby)
-            fluxtabvar => Flux%fluxtaby
-          ELSE IF (Profile%interptab(n) == 'z') THEN
-            Allocate(Flux%fluxtabz)
-            fluxtabvar => Flux%fluxtabz
-          ENDIF
-          ALLOCATE(fluxtabvar%iarray2(2,6))
-          normalsizes=>fluxtabvar%iarray2
-          normalsizes(1,1) = 2
-          nbout = 1
-          DO n2 = 1,dimensio
-            IF (n2 .NE. n) THEN
-              nbout = nbout + 1
-              If ((Profile%posvar(n2) == 1)
-     &            .OR.(Profile%posvar(n2) == 2)) THEN
-                IF (Profile%interptab(n2) == 'x') THEN
-                  normalsizes(2,n2) = 
-     &                Agrif_Curgrid%nb(1)/agrif_Curgrid%spaceref(1)
-                  normalsizes(1,nbout) = 
-     &                Agrif_Curgrid%nb(1)/agrif_Curgrid%spaceref(1)
-                ELSE IF (Profile%interptab(n2) == 'y') THEN
-                  normalsizes(2,n2) = 
-     &                Agrif_Curgrid%nb(2)/agrif_Curgrid%spaceref(2)
-                  normalsizes(1,nbout) = 
-     &                Agrif_Curgrid%nb(2)/agrif_Curgrid%spaceref(2)
-                ELSE IF (Profile%interptab(n2) == 'z') THEN
-                  normalsizes(2,n2) = 
-     &                Agrif_Curgrid%nb(3)/agrif_Curgrid%spaceref(3)
-                  normalsizes(1,nbout) = 
-     &                Agrif_Curgrid%nb(3)/agrif_Curgrid%spaceref(3)
-                ENDIF
-              ELSE
-                normalsizes(2,n2) = SIZE(fluxtab,n2)
-                normalsizes(1,nbout) = SIZE(fluxtab,n2)
-              ENDIF
-            ENDIF
-          ENDDO          
-        ENDIF
-      enddo
-      
-      
-      do n=1,dimensio
-        IF (Profile%posvar(n) == 1) THEN
-          IF (Profile%interptab(n) == 'x') THEN
-            fluxtabvar => Flux%fluxtabx
-          ELSE IF (Profile%interptab(n) == 'y') THEN
-            fluxtabvar => Flux%fluxtaby
-          ELSE IF (Profile%interptab(n) == 'z') THEN
-            fluxtabvar => Flux%fluxtabz
-          ENDIF
-          Call Agrif_nbdim_allocation(fluxtabvar,unitarray(1:dimensio),
-     &          fluxtabvar%iarray2(1,1:dimensio),dimensio)
-        ENDIF
-      enddo
-      
-      Flux%fluxallocated = .TRUE.
-      
-      End Subroutine Agrif_AllocateFlux
-      
-      FUNCTION Agrif_Search_Flux(fluxname)
-      character*(*) fluxname
-      Type(Agrif_Flux), Pointer :: Agrif_Search_Flux
-      
-      Type(Agrif_Flux), pointer :: parcours
-      Logical :: foundflux
-      
-      foundflux = .FALSE.
-      parcours => Agrif_Curgrid%fluxes
-      
-      Do While (Associated(parcours))
-         IF (parcours % fluxname == fluxname) THEN
-           foundflux = .TRUE.
-           EXIT
-         ENDIF
-         parcours => parcours%nextflux
-      End Do
-      
-      IF (.NOT.foundflux) THEN
-      write(*,*) 'The array flux '''
-     &           //TRIM(fluxname)//''' has not been declared'
-      stop
-      ENDIF      
-      
-      Agrif_Search_Flux => parcours
-      
-      End Function Agrif_Search_Flux
-      
-      Subroutine Agrif_Save_Fluxtab(Flux,Fluxtab)
-      Type(Agrif_Flux), Pointer :: Flux
-      Real, Dimension(:,:) :: Fluxtab
-      INTEGER, DIMENSION(:,:), Pointer :: normalsizes
-      INTEGER, DIMENSION(6) :: normalsizes2, normalsizes3
-      INTEGER, DIMENSION(6) :: unitarray2, unitarray3
-      Type(Agrif_Variable), Pointer :: fluxtabvar
-      Type(Agrif_Profile), Pointer :: Profile
-      Integer :: dimensio,n,n2,j,j1,j2
-      
-      Profile => Flux%profile
-      dimensio = Profile%nbdim
-            
-      do n=1,dimensio
-        IF (Profile%posvar(n) == 1) THEN
-          IF (Profile%interptab(n) == 'x') THEN
-            fluxtabvar => Flux%fluxtabx
-          ELSE IF (Profile%interptab(n) == 'y') THEN
-            fluxtabvar => Flux%fluxtaby
-          ELSE IF (Profile%interptab(n) == 'z') THEN
-            fluxtabvar => Flux%fluxtabz
-          ENDIF 
-          normalsizes => fluxtabvar%iarray2
-          unitarray2 = 1
-          unitarray3 = 1
-          normalsizes2 = normalsizes(1,:)
-          normalsizes3 = normalsizes(2,:)
-          
-          unitarray3(n) = Profile%point(n)
-          normalsizes3(n) = Profile%point(n) 
-                              
-          SELECT CASE(dimensio)
-          CASE(1)
-          CASE(2)
-            j1 = unitarray3(2)
-            Do j=unitarray3(2),normalsizes3(2)
-            do j2 = j1,j1+Agrif_curgrid%spaceref(2)
-!            print *,'flux stocke fiun = ',j2,fluxtab(unitarray3(1),j2)
-            enddo
-            fluxtabvar%array2(1:1,j) = 
-     &      fluxtabvar%array2(1:1,j) +
-     &             SUM(fluxtab(unitarray3(1):normalsizes3(1),
-     &                        j1:j1+Agrif_Curgrid%spaceref(2)))
-             j1 = j1+Agrif_Curgrid%spaceref(2)
-            EndDo
-          END SELECT
-          
-          unitarray3(n) = Profile%point(n)+Agrif_Curgrid%nb(n)
-          normalsizes3(n) = Profile%point(n)+Agrif_Curgrid%nb(n) 
-          SELECT CASE(dimensio)
-          CASE(1)
-          CASE(2)
-            j1 = unitarray3(2)
-            Do j=unitarray3(2),normalsizes3(2)
-            fluxtabvar%array2(2:2,j) = 
-     &      fluxtabvar%array2(2:2,j) +
-     &             SUM(fluxtab(unitarray3(1):normalsizes3(1),
-     &                        j1:j1+Agrif_Curgrid%spaceref(2)))
-             j1 = j1+Agrif_Curgrid%spaceref(2)
-            EndDo
-         END SELECT
-        ENDIF
-      enddo
-                  
-      End Subroutine Agrif_Save_Fluxtab
-
-      Subroutine Agrif_Save_Fluxtab_child(Flux,Fluxtab)
-      Type(Agrif_Flux), Pointer :: Flux
-      Real, Dimension(:,:) :: Fluxtab
-      INTEGER, DIMENSION(:,:), Pointer :: normalsizes
-      INTEGER, DIMENSION(6) :: normalsizes2, normalsizes3
-      INTEGER, DIMENSION(6) :: unitarray2, unitarray3
-      Type(Agrif_Variable), Pointer :: fluxtabvar
-      Type(Agrif_Profile), Pointer :: Profile
-      Integer :: dimensio,n,n2
-      
-      Profile => Flux%profile
-      dimensio = Profile%nbdim
-            
-      do n=1,dimensio
-        IF (Profile%posvar(n) == 1) THEN
-          IF (Profile%interptab(n) == 'x') THEN
-            fluxtabvar => Flux%fluxtabx
-          ELSE IF (Profile%interptab(n) == 'y') THEN
-            fluxtabvar => Flux%fluxtaby
-          ELSE IF (Profile%interptab(n) == 'z') THEN
-            fluxtabvar => Flux%fluxtabz
-          ENDIF 
-          normalsizes => fluxtabvar%iarray2
-          unitarray2 = 1
-          unitarray3 = 1
-          normalsizes2 = normalsizes(1,:)
-          normalsizes3 = normalsizes(2,:)
-          
-          unitarray3(n) = Profile%point(n)+Agrif_Curgrid%ix(n)
-          normalsizes3(n) = unitarray3(n)
-                              
-          SELECT CASE(dimensio)
-          CASE(1)
-          CASE(2)
-            fluxtabvar%array2(1:1,
-     &                        unitarray2(2):normalsizes2(2)) = 
-     &      - fluxtab(unitarray3(1):normalsizes3(1),
-     &                        unitarray3(2):normalsizes3(2))
-!        print *,'flux stocke = ',fluxtab(unitarray3(1):normalsizes3(1),
-!     &                        unitarray3(2):normalsizes3(2))
-          END SELECT
-          
-          unitarray3(n) = unitarray3(n)+
-     &         Agrif_Curgrid%nb(n)/Agrif_Curgrid%spaceref(n)
-          normalsizes3(n) = unitarray3(n)
-          SELECT CASE(dimensio)
-          CASE(1)
-          CASE(2)
-            fluxtabvar%array2(2:2,
-     &                        unitarray2(2):normalsizes2(2)) = 
-     &      - fluxtab(unitarray3(1):normalsizes3(1),
-     &                        unitarray3(2):normalsizes3(2))    
-         END SELECT
-        ENDIF
-      enddo
-                  
-      End Subroutine Agrif_Save_Fluxtab_child
-      
-      Subroutine Agrif_Cancel_Fluxarray(Flux)
-      Type(Agrif_Flux), Pointer :: Flux
-      Type(Agrif_Variable), Pointer :: fluxtabvar
-      Type(Agrif_Profile), Pointer :: Profile
-      Integer :: dimensio,n,n2
-      
-      Profile => Flux%profile
-      dimensio = Profile%nbdim
-            
-      do n=1,dimensio
-        IF (Profile%posvar(n) == 1) THEN
-          IF (Profile%interptab(n) == 'x') THEN
-            fluxtabvar => Flux%fluxtabx
-          ELSE IF (Profile%interptab(n) == 'y') THEN
-            fluxtabvar => Flux%fluxtaby
-          ELSE IF (Profile%interptab(n) == 'z') THEN
-            fluxtabvar => Flux%fluxtabz
-          ENDIF 
-                              
-          SELECT CASE(dimensio)
-          CASE(1)
-          CASE(2)
-            fluxtabvar%array2 = 0.
-          END SELECT
-        ENDIF
-      enddo
-                  
-      End Subroutine Agrif_Cancel_Fluxarray  
-      
-      Subroutine Agrif_FluxCorrect(Flux, procname)
-      Type(Agrif_Flux), Pointer :: Flux
-      External :: procname
-      Type(Agrif_Variable), Pointer :: fluxtabvar
-      Type(Agrif_Profile), Pointer :: Profile
-      Integer :: dimensio,n,n2,j1,j2
-      Integer, Dimension(:), Allocatable :: Loctab
-      Integer :: locind
-      
-      Profile => Flux%profile
-      dimensio = Profile%nbdim
-
-      do n=1,dimensio
-        IF (Profile%posvar(n) == 1) THEN
-          IF (Profile%interptab(n) == 'x') THEN
-            fluxtabvar => Flux%fluxtabx
-            locind = 1
-          ELSE IF (Profile%interptab(n) == 'y') THEN
-            fluxtabvar => Flux%fluxtaby
-            locind = 2
-          ELSE IF (Profile%interptab(n) == 'z') THEN
-            fluxtabvar => Flux%fluxtabz
-            locind = 3
-          ENDIF 
-                              
-          SELECT CASE(dimensio)
-          CASE(1)
-          CASE(2)
-           Allocate(Loctab(2))
-           Loctab(1) = Agrif_Curgrid%ix(locind)
-           Loctab(2) = Agrif_Curgrid%ix(locind)+
-     &         Agrif_Curgrid%nb(locind)/Agrif_Curgrid%spaceref(locind)
-           j1 = agrif_curgrid%ix(2)
-           j2 = agrif_curgrid%ix(2)+
-     &        agrif_curgrid%nb(2)/Agrif_curgrid%spaceref(2)
-           Call Agrif_ChildGrid_to_ParentGrid()
-            Call procname(fluxtabvar%array2,Loctab(1),Loctab(2),j1,j2)
-           Call Agrif_ParentGrid_to_ChildGrid()
-          END SELECT
-        ENDIF
-      enddo
-      
-      If (Allocated(Loctab)) Deallocate(Loctab)
-                  
-      End Subroutine Agrif_FluxCorrect 
-          
-      End Module Agrif_fluxmod
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90	(revision 5682)
@@ -0,0 +1,478 @@
+module Agrif_Grids
+
+    use Agrif_Types
+!
+    implicit none
+!
+!===================================================================================================
+type Agrif_Grid_List
+!---------------------------------------------------------------------------------------------------
+!<  List of grids.
+!
+    integer                     :: nitems = 0      !< Number of elements in the list
+    type(Agrif_PGrid), pointer  :: first => NULL() !< Pointer to the first grid in the list
+    type(Agrif_PGrid), pointer  :: last  => NULL() !< Pointer to the last  grid inserted in the list
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Grid_List
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_PGrid
+!---------------------------------------------------------------------------------------------------
+!<  Data type to go over the grid hierarchy (used for the creation of this grid hierarchy
+!<  and during the time integration).
+!
+    type(Agrif_Grid) , pointer :: gr   => NULL()  !< Pointer to the actual grid data structure
+    type(Agrif_PGrid), pointer :: next => NULL()  !< Next grid in the list
+!
+!---------------------------------------------------------------------------------------------------
+end type Agrif_PGrid
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Grid
+!---------------------------------------------------------------------------------------------------
+!<  Data type to define a grid (position, space and time refinement factors).
+!
+    type(Agrif_Grid)                    , pointer :: parent      => NULL() !< pointer on the parent grid
+    type(Agrif_Grid)                    , pointer :: save_grid   => NULL() !< pointer on the save grid
+    type(Agrif_Grid_List)                         :: child_list            !< List of child grids
+    type(Agrif_Variable),   dimension(:), allocatable :: tabvars    !< List of grid variables
+    type(Agrif_Variable_c), dimension(:), allocatable :: tabvars_c  !< List of character grid variables
+    type(Agrif_Variable_r), dimension(:), allocatable :: tabvars_r  !< List of real      grid variables
+    type(Agrif_Variable_l), dimension(:), allocatable :: tabvars_l  !< List of logical   grid variables
+    type(Agrif_Variable_i), dimension(:), allocatable :: tabvars_i  !< List of integer   grid variables
+!
+    real   , dimension(3)              :: Agrif_x   !< global x, y and z position
+    real   , dimension(3)              :: Agrif_dx  !< global space step in the x, y and z direction
+    real   , dimension(3)              :: Agrif_dt  !< global time  step in the x, y and z direction
+    integer, dimension(3)              :: nb        !< number of cells in the x, y and z direction
+    integer, dimension(3)              :: ix        !< minimal position in the x, y and z direction
+    integer, dimension(3)              :: spaceref  !< space refinement factor in the x, y and z direction
+    integer, dimension(3)              :: timeref   !< Time refinement factor in the x, y and z direction
+    integer                            :: ngridstep !< number of time steps
+    integer                            :: rank
+    integer                            :: grid_id   !< moving grid id
+    integer                            :: fixedrank !< number of the grid
+    logical                            :: fixed     !< fixed or moving grid ?
+    logical                            :: oldgrid
+!> \name Logicals indicating if the current grid has a common border with the root coarse grid
+!> @{
+    logical, dimension(3)              :: NearRootBorder
+    logical, dimension(3)              :: DistantRootBorder
+!> @}
+!> \name Arrays for adaptive grid refinement
+!> @{
+    integer, dimension(:)    ,   allocatable :: tabpoint1D
+    integer, dimension(:,:)  ,   allocatable :: tabpoint2D
+    integer, dimension(:,:,:),   allocatable :: tabpoint3D
+!> @}
+!> \name Members for parallel integration
+!> @{
+    type(Agrif_Rectangle),  pointer    :: rect_in_parent => NULL()
+    type(Agrif_Grid_List)              :: neigh_list                !< List of neighboring grids (ie. connected through a common proc)
+    type(Agrif_Proc_List)              :: proc_def_list             !< List of procs that will integrate this grid
+    type(Agrif_Proc_List)              :: proc_def_in_parent_list   !< List of procs that will integrate this grid (defined as in the parent grid)
+    type(Agrif_Proc_List)              :: required_proc_list        !< List of procs that are required for this grid
+    type(Agrif_Sequence_List), pointer :: child_seq => NULL()       !< Sequence for childs
+    integer                            :: seq_num = 0
+    integer                            :: size = 0
+    integer                            :: dsat = 0
+#if defined AGRIF_MPI
+    integer                            :: communicator = -1
+#endif
+!> @}
+    type(Agrif_Variables_List), pointer :: variables => NULL()
+    integer                             :: NbVariables = 0
+    integer                             :: level    !< level of the grid in the hierarchy
+    logical                             :: allocation_is_done = .false.
+    logical                             :: grand_mother_grid = .false.
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Grid
+!===================================================================================================
+!
+!> this pointer always points on the root grid of the grid hierarchy
+type(Agrif_Grid) , pointer :: Agrif_Mygrid => NULL()
+
+!> this pointer always points on the grand mother grid of the grid hierarchy (if any)
+type(Agrif_Grid) , pointer :: Agrif_Coarsegrid => NULL()
+
+!> Grid list used in the \link Agrif_Util::Agrif_Regrid() Agrif_regrid \endlink subroutine.
+!> It contains  the safeguard of the grid hierarchy.
+type(Agrif_Grid_List), pointer :: Agrif_oldmygrid => NULL()
+
+!> Pointer to the current grid (the link is done by using the Agrif_Instance procedure (\see module Agrif_Init))
+type(Agrif_Grid) , pointer :: Agrif_Curgrid => NULL()
+!
+!===================================================================================================
+type Agrif_Sequence
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List) :: gridlist
+    type(Agrif_Proc_List) :: proclist
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Sequence
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Sequence_List
+!---------------------------------------------------------------------------------------------------
+    integer :: nb_seqs
+    type(Agrif_Sequence), dimension(:), allocatable :: sequences
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Sequence_List
+!===================================================================================================
+!
+interface
+    function compare_grids ( grid1, grid2 ) result( res )
+        import Agrif_Grid
+        type(Agrif_Grid), intent(in)    :: grid1
+        type(Agrif_Grid), intent(in)    :: grid2
+        integer                         :: res  !< Result of the comparison :
+                                                !!  - res  < 0   if grid1 <  grid2
+                                                !!  - res == 0   if grid1 == grid2
+                                                !!  - res  > 0   if grid1 >  grid2
+    end function compare_grids
+end interface
+!
+contains
+!
+!===================================================================================================
+subroutine Agrif_gl_print ( gridlist )
+!
+!< DEBUG : a virer à terme.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: gridlist
+!
+    type(Agrif_PGrid), pointer  :: gridp
+    type(Agrif_Grid),  pointer  :: grid
+!
+    gridp => gridlist % first
+    do while ( associated(gridp) )
+        grid => gridp % gr
+        write(*,'("G",i0,", ")', advance='no') grid % fixedrank
+        gridp => gridp % next
+    enddo
+    write(*,*)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_print
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_print_debug ( gridlist )
+!
+!< DEBUG : a virer à terme.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: gridlist
+!
+    type(Agrif_PGrid), pointer  :: gridp
+    type(Agrif_Grid),  pointer  :: grid
+!
+    write(*,'(" (nitems=",i2,"), (id,neighs,color,dsat,size) = ")', advance='no') gridlist % nitems
+    gridp => gridlist % first
+    do while ( associated(gridp) )
+        grid => gridp % gr
+        write(*,'("(G",i0,4(",",i0),"), ")', advance='no') grid % fixedrank, &
+            grid % neigh_list % nitems, grid % seq_num, grid % dsat, grid % size
+        gridp => gridp % next
+    enddo
+    write(*,*)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_print_debug
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_append ( gridlist, grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List),     intent(inout)  :: gridlist
+    type(Agrif_Grid), pointer, intent(in)     :: grid
+!
+    type(Agrif_PGrid), pointer   :: new_gp
+!
+    allocate( new_gp )
+!
+    new_gp % gr   => grid
+    new_gp % next => NULL()
+!
+    if ( associated(gridlist % last) ) then
+    ! the list is not empty, append the new pointer at the end
+        gridlist % last % next => new_gp
+    else
+    ! the list is empty, the new pointer is the first one
+        gridlist % first => new_gp
+    endif
+    ! anyway, for next time 'grid' will be the last one.
+    gridlist % last => new_gp
+    gridlist % nitems = gridlist % nitems + 1
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_append
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_gl_popfirst ( gridlist ) result ( grid )
+!
+!<  Removes the first item of the list and returns it.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(inout)    :: gridlist
+!
+    type(Agrif_PGrid), pointer :: grid_p
+    type(Agrif_Grid),  pointer :: grid
+!
+    grid_p => gridlist % first
+!
+    if ( .not. associated( grid_p ) ) then
+        grid => NULL()
+        return
+    endif
+!
+    grid              => grid_p % gr
+    gridlist % first  => grid_p % next
+    gridlist % nitems =  gridlist % nitems - 1
+    if ( .not. associated(gridlist % first) ) then
+       nullify(gridlist % last)
+    endif
+    deallocate(grid_p)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_gl_popfirst
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_copy ( new_gl, model )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(out)  :: new_gl
+    type(Agrif_Grid_List), intent(in)   :: model
+!
+    type(Agrif_PGrid), pointer :: gp
+!
+    call Agrif_gl_clear(new_gl)
+    gp => model % first
+!
+    do while( associated(gp) )
+        call Agrif_gl_append( new_gl, gp % gr )
+        gp => gp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_copy
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_gl_build_from_gp ( gridp ) result ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_PGrid), pointer, intent(in)   :: gridp
+!
+    type(Agrif_Grid_List), pointer  :: gridlist
+    type(Agrif_PGrid),     pointer  :: gp
+!
+    allocate(gridlist)
+!
+    gp => gridp
+!
+    do while ( associated( gp ) )
+        call Agrif_gl_append( gridlist, gp % gr )
+        gp => gp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_gl_build_from_gp
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gp_delete ( gridp )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_PGrid), pointer, intent(inout)  :: gridp
+!
+    type(Agrif_PGrid), pointer   :: gp, gpd
+!
+    if ( .not. associated( gridp ) ) return
+!
+    gp => gridp
+!
+    do while( associated(gp) )
+        gpd => gp
+        gp  => gp % next
+        deallocate(gpd)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gp_delete
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_clear ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(inout)  :: gridlist
+!
+    call Agrif_gp_delete(gridlist % first)
+    gridlist % first => NULL()
+    gridlist % last  => NULL()
+    gridlist % nitems = 0
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_clear
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_delete ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), pointer, intent(inout)  :: gridlist
+!
+    if ( .not. associated( gridlist ) ) return
+!
+    call Agrif_gp_delete(gridlist % first)
+    deallocate( gridlist )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_delete
+!===================================================================================================
+!
+!===================================================================================================
+recursive function Agrif_gl_merge_sort ( gridlist, compare_func, compare_func_opt ) result( gl_sorted )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)    :: gridlist
+    procedure(compare_grids)             :: compare_func
+    procedure(compare_grids), optional   :: compare_func_opt
+!
+    type(Agrif_Grid_List), pointer  :: gl_sorted
+    type(Agrif_Grid_List), pointer  :: gl_left,  gl_sorted_left
+    type(Agrif_Grid_List), pointer  :: gl_right, gl_sorted_right
+    type(Agrif_PGrid),     pointer  :: grid_p
+    integer                         :: n, middle
+!
+! if list size is 1, consider it sorted and return it
+    if  ( (gridlist % nitems <= 1) ) then
+        gl_sorted => Agrif_gl_build_from_gp(gridlist % first)
+        return
+    endif
+!
+! else split the list into two sublists
+    n = 1
+    middle    =  gridlist % nitems / 2
+    grid_p    => gridlist % first
+!
+    allocate( gl_left, gl_right )
+!
+    do while ( associated(grid_p) )
+        if ( n <= middle ) then
+            call Agrif_gl_append(gl_left,  grid_p % gr)
+        else
+            call Agrif_gl_append(gl_right, grid_p % gr)
+        endif
+        grid_p => grid_p % next
+        n = n+1
+    enddo
+!
+! recursively call Agrif_gl_merge_sort() to further split each sublist until sublist size is 1
+    gl_sorted_left  => Agrif_gl_merge_sort(gl_left,  compare_func, compare_func_opt)
+    gl_sorted_right => Agrif_gl_merge_sort(gl_right, compare_func, compare_func_opt)
+!
+! merge the sublists returned from prior calls to gl_merge_sort() and return the resulting merged sublist
+    gl_sorted => Agrif_gl_merge(gl_sorted_left, gl_sorted_right, compare_func, compare_func_opt)
+!
+    call Agrif_gl_delete( gl_left )
+    call Agrif_gl_delete( gl_right )
+    call Agrif_gl_delete( gl_sorted_left )
+    call Agrif_gl_delete( gl_sorted_right )
+!---------------------------------------------------------------------------------------------------
+end function Agrif_gl_merge_sort
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_gl_merge ( gl_left, gl_right, compare_func, compare_func_opt ) result( gl_merged )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(inout)    :: gl_left
+    type(Agrif_Grid_List), intent(inout)    :: gl_right
+    procedure(compare_grids)                :: compare_func
+    procedure(compare_grids), optional      :: compare_func_opt
+!
+    type(Agrif_Grid_List), pointer  :: gl_merged
+    type(Agrif_Grid),      pointer  :: poped_grid
+    integer                         :: comp_value
+!
+    allocate( gl_merged )
+!
+    do while ( gl_left % nitems > 0 .or. gl_right % nitems > 0 )
+!
+        if ( gl_left % nitems > 0 .and. gl_right % nitems > 0 ) then
+!
+!         Let.s compare both items with the first compare function
+            comp_value = compare_func( gl_left % first % gr, gl_right % first % gr )
+!
+            if     ( comp_value < 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
+            elseif ( comp_value > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
+            else ! ( comp_value == 0 )
+!
+!             Both items are equal, let.s use the second criterion if the optional
+!             compare function is present.
+                if ( present(compare_func_opt) ) then
+!
+                    comp_value = compare_func_opt( gl_left % first % gr, gl_right % first % gr )
+!
+                    if ( comp_value <= 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
+                    else                        ; poped_grid => Agrif_gl_popfirst(gl_right)
+                    endif
+                else
+!                 If the second criterion is not present, let.s just pick the left item
+                    poped_grid => Agrif_gl_popfirst(gl_left)
+                endif
+            endif
+!
+!     If one of the lists is empty, we just have to pick in the other one.
+        elseif ( gl_left  % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
+        elseif ( gl_right % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
+        endif
+!
+        call Agrif_gl_append( gl_merged, poped_grid )
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_gl_merge
+!===================================================================================================
+!
+!===================================================================================================
+function compare_grid_degrees ( grid1, grid2 ) result( res )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in)    :: grid1
+    type(Agrif_Grid), intent(in)    :: grid2
+!
+    integer     :: res
+!
+    res = grid2 % neigh_list % nitems - grid1 % neigh_list % nitems
+!---------------------------------------------------------------------------------------------------
+end function compare_grid_degrees
+!===================================================================================================
+!
+!===================================================================================================
+function compare_colors ( grid1, grid2 ) result( res )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in)    :: grid1
+    type(Agrif_Grid), intent(in)    :: grid2
+!
+    integer     :: res
+!
+    res = grid1 % seq_num - grid2 % seq_num
+!---------------------------------------------------------------------------------------------------
+end function compare_colors
+!===================================================================================================
+!
+!===================================================================================================
+function compare_dsat_values ( grid1, grid2 ) result( res )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in)    :: grid1
+    type(Agrif_Grid), intent(in)    :: grid2
+!
+    integer     :: res
+!
+    res = grid2 % dsat - grid1 % dsat
+!---------------------------------------------------------------------------------------------------
+end function compare_dsat_values
+!===================================================================================================
+!
+!===================================================================================================
+function compare_size_values ( grid1, grid2 ) result( res )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in)    :: grid1
+    type(Agrif_Grid), intent(in)    :: grid2
+!
+    integer     :: res
+!
+    res = grid2 % size - grid1 % size
+!---------------------------------------------------------------------------------------------------
+end function compare_size_values
+!===================================================================================================
+!
+end module Agrif_Grids
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F	(revision 5659)
+++ 	(revision )
@@ -1,252 +1,0 @@
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Init
-C
-      Module Agrif_Init 
-C
-CCC   Description:
-CCC   Several operations on the variables of the current grid (creation,
-CCC   instanciation, ...) used during the creation of the grid hierarchy and
-CCC   during the time integration.
-C
-C     Modules used: 
-C
-      Use Agrif_Types 
-      Use Agrif_link
-C   
-      IMPLICIT NONE
-C
-      Contains
-C     Defininition of the procedures contained in this module
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Allocation  
-C     **************************************************************************
-C  
-      Subroutine Agrif_Allocation(Agrif_Gr)
-C
-CCC   Description:
-CCC   Subroutine to allocate the arrays containing the values of the variables 
-CCC   of the current grd.
-C
-CC    Method:
-CC    Use of the allocate function.  
-C
-C     Declarations:
-C      
-C     Pointer argument:
-      TYPE(AGRIF_grid), Pointer :: Agrif_Gr  ! Pointer on the current grid
-C 
-C     Allocation of the arrays of the variables  
-C     We cut this in several files to avoid long compilation timings
-C
-      Call Agrif_Allocationcalls(Agrif_Gr)
-C
-      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
-C
-         if ( Agrif_Probdim .EQ. 1 ) 
-     &      Allocate(Agrif_Gr%tabpoint1D(Agrif_Gr%nb(1)+1))
-         if ( Agrif_Probdim .EQ. 2 ) 
-     &      Allocate(Agrif_Gr%tabpoint2D(Agrif_Gr%nb(1)+1,
-     &       Agrif_Gr%nb(2)+1))      
-         if ( Agrif_Probdim .EQ. 3 ) 
-     &      Allocate(Agrif_Gr%tabpoint3D(Agrif_Gr%nb(1)+1,
-     &       Agrif_Gr%nb(2)+1,Agrif_Gr%nb(3)+1))      
-C
-      endif
-C 
-      End Subroutine Agrif_Allocation
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Instance 
-C     **************************************************************************
-C 
-      Subroutine Agrif_Instance(Agrif_Gr)
-C
-CCC   Description:
-CCC   Subroutine to do an instance of the common variables to the variables of  
-CCC   the current grid.
-C
-CC    Method:
-CC    Pointing the common variables on these of the current grid.  
-C
-C     Declarations:
-C        
-
-C
-C
-
-C
-C     Pointer argument: 
-      Type(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
-C 
-C
-      Agrif_Curgrid => Agrif_Gr
-      Agrif_tabvars => Agrif_Curgrid % tabvars
-C
-      Call Agrif_Get_numberofcells(Agrif_Gr)
-C
-C
-C     Calculation of isf,jsf,nzsf and of the index of the output file 
-      Call Agrif_InitWorkSpace() 
-C
-C 
-      End Subroutine Agrif_Instance
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_initialisations  
-C     **************************************************************************
-      Subroutine Agrif_initialisations(Agrif_Gr)
-C
-CCC   Description:
-C
-CC    Method:
-C
-C     Declarations:
-C        
-      INTEGER :: i
-C
-C     Pointer argument: 
-      Type(Agrif_Grid), Pointer  :: Agrif_Gr
-      
-C
-      do i = 1 , Agrif_NbVariables
-C 
-         Agrif_Gr % tabvars(i) % var % nbdim = 0
-C
-         if (allocated(Agrif_Gr%tabvars(i)%var%array1)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 1
-             Agrif_Gr % tabvars(i) % var % lb(1:1) = 
-     &         lbound(Agrif_Gr%tabvars(i)%var%array1)
-             Agrif_Gr % tabvars(i) % var % ub(1:1) = 
-     &         ubound(Agrif_Gr%tabvars(i)%var%array1)     
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%array2)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 2
-             Agrif_Gr % tabvars(i) % var % lb(1:2) = 
-     &         lbound(Agrif_Gr%tabvars(i)%var%array2)
-             Agrif_Gr % tabvars(i) % var % ub(1:2) = 
-     &         ubound(Agrif_Gr%tabvars(i)%var%array2)
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%array3)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 3
-             Agrif_Gr % tabvars(i) % var % lb(1:3) = 
-     &         lbound(Agrif_Gr%tabvars(i)%var%array3)
-             Agrif_Gr % tabvars(i) % var % ub(1:3) = 
-     &         ubound(Agrif_Gr%tabvars(i)%var%array3)
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%array4)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 4
-             Agrif_Gr % tabvars(i) % var % lb(1:4) = 
-     &         lbound(Agrif_Gr%tabvars(i)%var%array4)
-             Agrif_Gr % tabvars(i) % var % ub(1:4) = 
-     &         ubound(Agrif_Gr%tabvars(i)%var%array4)
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%array5)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 5
-             Agrif_Gr % tabvars(i) % var % lb(1:5) = 
-     &         lbound(Agrif_Gr%tabvars(i)%var%array5)
-             Agrif_Gr % tabvars(i) % var % ub(1:5) = 
-     &         ubound(Agrif_Gr%tabvars(i)%var%array5)
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%array6)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 6
-             Agrif_Gr % tabvars(i) % var % lb(1:6) = 
-     &         lbound(Agrif_Gr%tabvars(i)%var%array6)
-             Agrif_Gr % tabvars(i) % var % ub(1:6) = 
-     &         ubound(Agrif_Gr%tabvars(i)%var%array6)
-         endif
-C
-         if (allocated(Agrif_Gr%tabvars(i)%var%darray1)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 1
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%darray2)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 2
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%darray3)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 3
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%darray4)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 4
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%darray5)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 5
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%darray6)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 6
-         endif
-C
-         if (allocated(Agrif_Gr%tabvars(i)%var%larray1)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 1
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%larray2)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 2
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%larray3)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 3
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%larray4)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 4
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%larray5)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 5
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%larray6)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 6
-         endif
-C
-         if (allocated(Agrif_Gr%tabvars(i)%var%iarray1)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 1
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%iarray2)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 2
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%iarray3)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 3
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%iarray4)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 4
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%iarray5)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 5
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%iarray6)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 6
-         endif
-C
-         if (allocated(Agrif_Gr%tabvars(i)%var%carray1)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 1
-         endif
-         if (allocated(Agrif_Gr%tabvars(i)%var%carray2)) then
-             Agrif_Gr % tabvars(i) % var % nbdim = 2
-         endif
-C 
-      enddo
-C
-      Return
-C 
-C
-      End Subroutine Agrif_initialisations
-C 
-C
-      End Module AGRIF_Init 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90	(revision 5682)
@@ -0,0 +1,209 @@
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Init.
+!>
+!> Several operations on the variables of the current grid (creation, instanciation, ...)
+!! used during the creation of the grid hierarchy and during the time integration.
+!
+module Agrif_Init
+!
+    use Agrif_Grids
+    use Agrif_Link
+    use Agrif_Mpp
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Allocation
+!
+!> Allocates the arrays containing the values of the variables of the current grd.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Allocation ( Agrif_Gr, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid),       pointer   :: Agrif_Gr   !< Pointer on the current grid
+    procedure(alloc_proc),  optional  :: procname   !< Allocation procedure (Default: Agrif_Allocationcalls)
+!
+    if ( present(procname) ) then
+        call procname(Agrif_Gr)
+    else
+        call Agrif_Allocationcalls(Agrif_Gr)
+    endif
+    Agrif_Gr % allocation_is_done = .true.
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+!
+        if ( Agrif_Probdim == 1 ) allocate( Agrif_Gr%tabpoint1D(Agrif_Gr%nb(1)+1) )
+        if ( Agrif_Probdim == 2 ) allocate( Agrif_Gr%tabpoint2D(Agrif_Gr%nb(1)+1, &
+                                                                Agrif_Gr%nb(2)+1) )
+        if ( Agrif_Probdim == 3 ) allocate( Agrif_Gr%tabpoint3D(Agrif_Gr%nb(1)+1, &
+                                                                Agrif_Gr%nb(2)+1, &
+                                                                Agrif_Gr%nb(3)+1) )
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Allocation
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Instance
+!
+!> Make the pointer Agrif_Types::Agrif_Curgrid point to Agrif_Gr
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Instance ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+!
+    Agrif_Curgrid => Agrif_Gr
+    Agrif_tabvars => Agrif_Curgrid % tabvars
+    Agrif_tabvars_c => Agrif_Curgrid % tabvars_c
+    Agrif_tabvars_r => Agrif_Curgrid % tabvars_r
+    Agrif_tabvars_l => Agrif_Curgrid % tabvars_l
+    Agrif_tabvars_i => Agrif_Curgrid % tabvars_i
+!
+#if defined AGRIF_MPI
+    if ( Agrif_Gr % communicator /= -1 ) then
+        call Agrif_MPI_switch_comm( Agrif_Gr % communicator )
+    endif
+#endif
+!
+    call Agrif_Get_numberofcells(Agrif_Gr)
+    call Agrif_InitWorkSpace()
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Instance
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_initialisations
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_initialisations ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+!
+    integer                         :: i
+    type(Agrif_Variable),   pointer :: var => NULL()
+    type(Agrif_Variable_c), pointer :: var_c => NULL()
+    type(Agrif_Variable_r), pointer :: var_r => NULL()
+    type(Agrif_Variable_l), pointer :: var_l => NULL()
+    type(Agrif_Variable_i), pointer :: var_i => NULL()
+!
+    do i = 1,Agrif_NbVariables(0)
+!
+        var => Agrif_Gr % tabvars(i)
+        var % nbdim = 0
+!
+        if (allocated(var%array1)) then
+            var % nbdim = 1
+            var % lb(1:1) = lbound(var%array1)
+            var % ub(1:1) = ubound(var%array1)
+        endif
+        if (allocated(var%array2)) then
+            var % nbdim = 2
+            var % lb(1:2) = lbound(var%array2)
+            var % ub(1:2) = ubound(var%array2)
+        endif
+        if (allocated(var%array3)) then
+            var % nbdim = 3
+            var % lb(1:3) = lbound(var%array3)
+            var % ub(1:3) = ubound(var%array3)
+        endif
+        if (allocated(var%array4)) then
+            var % nbdim = 4
+            var % lb(1:4) = lbound(var%array4)
+            var % ub(1:4) = ubound(var%array4)
+        endif
+        if (allocated(var%array5)) then
+            var % nbdim = 5
+            var % lb(1:5) = lbound(var%array5)
+            var % ub(1:5) = ubound(var%array5)
+        endif
+        if (allocated(var%array6)) then
+            var % nbdim = 6
+            var % lb(1:6) = lbound(var%array6)
+            var % ub(1:6) = ubound(var%array6)
+        endif
+!
+        if (allocated(var%darray1)) var % nbdim = 1
+        if (allocated(var%darray2)) var % nbdim = 2
+        if (allocated(var%darray3)) var % nbdim = 3
+        if (allocated(var%darray4)) var % nbdim = 4
+        if (allocated(var%darray5)) var % nbdim = 5
+        if (allocated(var%darray6)) var % nbdim = 6
+!
+        if (allocated(var%sarray1)) var % nbdim = 1
+        if (allocated(var%sarray2)) var % nbdim = 2
+        if (allocated(var%sarray3)) var % nbdim = 3
+        if (allocated(var%sarray4)) var % nbdim = 4
+        if (allocated(var%sarray5)) var % nbdim = 5
+        if (allocated(var%sarray6)) var % nbdim = 6
+!
+    enddo
+
+    do i = 1,Agrif_NbVariables(1)
+!
+        var_c => Agrif_Gr % tabvars_c(i)
+        var_c % nbdim = 0
+!
+        if (allocated(var_c%carray1)) var_c % nbdim = 1
+        if (allocated(var_c%carray2)) var_c % nbdim = 2
+!
+    enddo
+
+    do i = 1,Agrif_NbVariables(2)
+!
+        var_r => Agrif_Gr % tabvars_r(i)
+        var_r % nbdim = 0
+!
+    enddo
+
+    do i = 1,Agrif_NbVariables(3)
+!
+        var_l => Agrif_Gr % tabvars_l(i)
+        var_l % nbdim = 0
+!
+        if (allocated(var_l%larray1)) var_l % nbdim = 1
+        if (allocated(var_l%larray2)) var_l % nbdim = 2
+        if (allocated(var_l%larray3)) var_l % nbdim = 3
+        if (allocated(var_l%larray4)) var_l % nbdim = 4
+        if (allocated(var_l%larray5)) var_l % nbdim = 5
+        if (allocated(var_l%larray6)) var_l % nbdim = 6
+!
+    enddo
+
+    do i = 1,Agrif_NbVariables(4)
+!
+        var_i => Agrif_Gr % tabvars_i(i)
+        var_i % nbdim = 0
+!
+        if (allocated(var_i%iarray1)) var_i % nbdim = 1
+        if (allocated(var_i%iarray2)) var_i % nbdim = 2
+        if (allocated(var_i%iarray3)) var_i % nbdim = 3
+        if (allocated(var_i%iarray4)) var_i % nbdim = 4
+        if (allocated(var_i%iarray5)) var_i % nbdim = 5
+        if (allocated(var_i%iarray6)) var_i % nbdim = 6
+!
+    enddo
+
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_initialisations
+!===================================================================================================
+!
+end module Agrif_Init
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F	(revision 5659)
+++ 	(revision )
@@ -1,125 +1,0 @@
-!
-! $Id$
-!
-C     Agrif (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Init_Vars
-C
-      Module Agrif_Init_Vars
-C
-CCC   Description:
-CCC   Initialization of the variables of the current grid.
-C
-C     Modules used: 
-C      
-      Use Agrif_Types
-      Use Agrif_link
-C   
-      IMPLICIT NONE
-C
-      Contains
-C     Defininition of the procedures contained in this module 
-C  
-C 
-C     **************************************************************************
-CCC   Subroutine Agrif_Create_var 
-C     **************************************************************************
-C  
-      Subroutine Agrif_Create_Var(Agrif_Gr)
-C
-CCC   Description:
-CCC   Allocation of the field "var" of the grid variables.
-CCC   Fields "root_var", "nbdim" and "parent_var" of the grid variables.
-CCC   Array "tabvars" of the current grid. 
-C
-CC    Method:                  
-C 
-C     Declarations:
-C
-      
-C
-C     Pointer argument:
-      TYPE(Agrif_Grid),pointer   :: Agrif_Gr  ! Pointer on the current grid
-      INTEGER :: nb
-C
-C     Array "tabvars" of the current grid. 
-C
-      Allocate(Agrif_Gr % tabvars(Agrif_NbVariables))
-C      
-      do nb = 1, Agrif_NbVariables
-        Allocate(Agrif_Gr % tabvars(nb) % var)
-      enddo
-
-C     Fields "root_var", "nbdim" and "parent_var" of the grid variables.     
-      if (Agrif_Gr % fixedrank .NE.0) then
-         do nb = 1, Agrif_NbVariables     
-            Agrif_Gr % tabvars(nb) % parent_var => 
-     &      Agrif_Gr % parent %tabvars(nb)
-            Agrif_Gr % tabvars(nb) % var % nbdim =
-     &      Agrif_Mygrid % tabvars(nb) % var % nbdim
-            Agrif_Gr % tabvars(nb) % var % root_var =>
-     &      Agrif_Mygrid % tabvars(nb) % var          
-         enddo
-      endif
-C           
-      End Subroutine Agrif_Create_Var
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_CreateVar
-C     **************************************************************************
-C 
-      Subroutine Agrif_CreateVar(Agrif_Gr)            
-C
-CCC   Description:
-CCC   This subroutine allows to make a link between Mygrid and the current grid 
-C
-C     Modules used:
-C      
-C
-C     Declarations:
-C      
-C
-C
-C     Arguments      
-C
-      TYPE(Agrif_Grid),pointer   :: Agrif_Gr    ! Pointer on the current grid
-      INTEGER                    :: i           ! Loop
-C
-      if (Agrif_Gr % fixedrank .NE. 0) then
-C  
-         do i = 1 , Agrif_NbVariables 
-            Agrif_Gr % tabvars(i) % parent_var => 
-     &      Agrif_Gr % parent % tabvars(i) 
-            Agrif_Gr % tabvars(i) % var % root_var => 
-     &      Agrif_Mygrid % tabvars(i) % var
-            Agrif_Gr % tabvars(i) % var % nbdim  = 
-     &      Agrif_Gr % parent % tabvars(i) % var % nbdim
-         enddo 
-C	 
-      endif 
-C       
-      End Subroutine Agrif_CreateVar
-C
-C
-C
-      End Module Agrif_Init_Vars
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90	(revision 5682)
@@ -0,0 +1,86 @@
+!
+! $Id$
+!
+!     Agrif (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Init_Vars
+!>
+!> Initialization of the variables of the current grid.
+!
+module Agrif_Init_Vars
+!
+    use Agrif_Types
+    use Agrif_Grids
+    use Agrif_Link
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Create_Var
+!
+!> Allocation of the list of grid variables for grid Agrif_Gr.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Create_Var ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: Agrif_Gr  !< Pointer on the current grid
+!
+    integer :: nb
+!
+    if (Agrif_NbVariables(0) > 0) allocate(Agrif_Gr % tabvars  (Agrif_NbVariables(0)))
+    if (Agrif_NbVariables(1) > 0) allocate(Agrif_Gr % tabvars_c(Agrif_NbVariables(1)))
+    if (Agrif_NbVariables(2) > 0) allocate(Agrif_Gr % tabvars_r(Agrif_NbVariables(2)))
+    if (Agrif_NbVariables(3) > 0) allocate(Agrif_Gr % tabvars_l(Agrif_NbVariables(3)))
+    if (Agrif_NbVariables(4) > 0) allocate(Agrif_Gr % tabvars_i(Agrif_NbVariables(4)))
+!
+    if ( Agrif_Gr % fixedrank /= 0 ) then
+        do nb = 1, Agrif_NbVariables(0)
+            Agrif_Gr % tabvars(nb) % parent_var => Agrif_Gr % parent % tabvars(nb)
+            Agrif_Gr % tabvars(nb) % nbdim      =  Agrif_Mygrid % tabvars(nb) % nbdim
+            Agrif_Gr % tabvars(nb) % root_var   => Agrif_Mygrid % tabvars(nb)
+        enddo
+        do nb = 1, Agrif_NbVariables(1)
+            Agrif_Gr % tabvars_c(nb) % parent_var => Agrif_Gr % parent % tabvars_c(nb)
+            Agrif_Gr % tabvars_c(nb) % nbdim      =  Agrif_Mygrid % tabvars_c(nb) % nbdim
+            Agrif_Gr % tabvars_c(nb) % root_var   => Agrif_Mygrid % tabvars_c(nb)
+        enddo
+        do nb = 1, Agrif_NbVariables(2)
+            Agrif_Gr % tabvars_r(nb) % parent_var => Agrif_Gr % parent % tabvars_r(nb)
+            Agrif_Gr % tabvars_r(nb) % nbdim      =  Agrif_Mygrid % tabvars_r(nb) % nbdim
+            Agrif_Gr % tabvars_r(nb) % root_var   => Agrif_Mygrid % tabvars_r(nb)
+        enddo
+        do nb = 1, Agrif_NbVariables(3)
+            Agrif_Gr % tabvars_l(nb) % parent_var => Agrif_Gr % parent % tabvars_l(nb)
+            Agrif_Gr % tabvars_l(nb) % nbdim      =  Agrif_Mygrid % tabvars_l(nb) % nbdim
+            Agrif_Gr % tabvars_l(nb) % root_var   => Agrif_Mygrid % tabvars_l(nb)
+        enddo
+        do nb = 1, Agrif_NbVariables(4)
+            Agrif_Gr % tabvars_i(nb) % parent_var => Agrif_Gr % parent % tabvars_i(nb)
+            Agrif_Gr % tabvars_i(nb) % nbdim      =  Agrif_Mygrid % tabvars_i(nb) % nbdim
+            Agrif_Gr % tabvars_i(nb) % root_var   => Agrif_Mygrid % tabvars_i(nb)
+        enddo
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Create_Var
+!===================================================================================================
+!
+end module Agrif_Init_Vars
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F	(revision 5659)
+++ 	(revision )
@@ -1,2270 +1,0 @@
-!
-! $Id$
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Interpolation
-C
-      Module Agrif_Interpolation
-C
-CCC   Description:
-CCC   Module to initialize a fine grid from its parent grid, by using a space 
-CCC   interpolation
-C
-C     Modules used:
-C  
-      Use Agrif_Interpbasic
-      Use Agrif_Arrays
-      Use Agrif_Mask 
-      Use Agrif_CurgridFunctions
-#if defined key_mpp_mpi
-      Use Agrif_mpp
-#endif
-C      
-      IMPLICIT NONE
-      logical,  private:: precomputedone(7) = .FALSE.
-C
-      CONTAINS
-C     Define procedures contained in this module        
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_1d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_1d(TypeInterp,parent,child,tab,
-     &    torestore,nbdim,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions of a fine grid for a 1D
-C        grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
-                                             !    (linear,lagrange,spline)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-                                             !    grid
-      LOGICAL :: torestore
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1)
-     &         ), Target :: tab    ! Result
-      External :: procname
-      Optional ::  procname
-C
-C
-      allocate(childtemp % var)  
-C      
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = nbdim
-C
-C     Tab is the result of the interpolation
-      childtemp % var % parray1 => tab 
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-C      
-      if (torestore) then
-C 
-          childtemp % var % parray1 = child % var % array1
-C          
-          childtemp % var % restore1D => child % var % restore1D
-C      
-        else
-C        
-          Nullify(childtemp % var % restore1D)
-C      
-      endif     
-C 
-C     Index indicating (in the Agrif_Interp1D procedure) if a space
-C        interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &    child % var % Interpolationshouldbemade 
-      childtemp % var % list_interp => child % var% list_interp            
-C      
-      if (present(procname)) then
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore,procname)
-      else
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore)
-      endif
-      child % var % list_interp => childtemp % var %list_interp     
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_1D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_2d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_2d(TypeInterp,parent,child,tab,
-     &                           torestore,nbdim,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions of a fine grid for a 2D
-C        grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
-                                             !    (linear,lagrange,spline)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-                                             !    grid
-      LOGICAL :: torestore
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2)
-     &    ), Target :: tab    ! Result
-      External :: procname
-      Optional ::  procname
-C
-C
-      allocate(childtemp % var)  
-C      
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = nbdim
-C
-C     Tab is the result of the interpolation
-      childtemp % var % parray2 => tab  
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub
-      
-C
-      if (torestore) then      
-C 
-          childtemp % var % parray2 = child % var % array2          
-C 
-          childtemp % var % restore2D => child % var % restore2D        
-C      
-        else
-C        
-          Nullify(childtemp % var % restore2D)
-C      
-      endif       
-C 
-C     Index indicating (in the Agrif_Interp2D procedure) if a space
-C        interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex       
-      childtemp % var % Interpolationshouldbemade = 
-     &    child % var % Interpolationshouldbemade   
-      childtemp % var % list_interp => child % var% list_interp          
-C     
-      if (present(procname)) then
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore,procname)
-      else
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore)
-      endif
-
-      child % var % list_interp => childtemp % var %list_interp     
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_2D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_3d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_3d(TypeInterp,parent,child,tab,
-     &   torestore,nbdim,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions of a fine grid for a 3D
-C        grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
-                                             !    (linear,lagrange,spline)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-                                             !    grid
-      LOGICAL :: torestore
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3)
-     &      ), Target :: tab  ! Results
-      External :: procname
-      Optional ::  procname
-C
-C
-      allocate(childtemp % var)  
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = nbdim  
-C     
-C     Tab is the result of the interpolation 
-      childtemp % var % parray3 => tab 
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub        
-C      
-      if (torestore) then
-C     
-          childtemp % var % parray3 = child % var % array3
-C
-          childtemp % var % restore3D => child % var % restore3D
-C      
-        else
-C        
-          Nullify(childtemp % var % restore3D)
-C      
-      endif
-C 
-C     Index indicating (in the Agrif_Interp3D procedure) if a space
-C        interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex    
-      childtemp % var % Interpolationshouldbemade = 
-     &    child % var % Interpolationshouldbemade   
-      childtemp % var % list_interp => child % var% list_interp          
-C     
-
-      if (present(procname)) then
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore,procname)
-      else
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore)
-      endif
-
-
-      child % var % list_interp => childtemp % var %list_interp     
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_3D               
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_4d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_4d(TypeInterp,parent,child,tab,
-     &   torestore,nbdim,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions of a fine grid for a 4D
-C        grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
-                                             !    (linear,lagrange,spline)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-                                             !    grid
-      LOGICAL :: torestore
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4)
-     &      ), Target :: tab  ! Results
-      External :: procname
-      Optional ::  procname
-C
-C
-      allocate(childtemp % var)  
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = nbdim  
-C      
-C     Tab is the result of the interpolation
-      childtemp % var % parray4 => tab 
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-C 
-      if (torestore) then
-C 
-          childtemp % var % parray4 = child % var % array4
-C
-          childtemp % var % restore4D => child % var % restore4D
-C      
-        else
-C        
-          Nullify(childtemp % var % restore4D)
-C      
-      endif        
-C 
-C     Index indicating (in the Agrif_Interp4D procedure) if a space
-C        interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex    
-      childtemp % var % Interpolationshouldbemade = 
-     &    child % var % Interpolationshouldbemade  
-      childtemp % var % list_interp => child % var% list_interp           
-C     
-      if (present(procname)) then
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore,procname)
-      else
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore)
-      endif
-
-
-      child % var % list_interp => childtemp % var %list_interp
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_4D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_5d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_5d(TypeInterp,parent,child,tab,
-     &   torestore,nbdim,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions of a fine grid for a 5D
-C        grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
-                                             !    (linear,lagrange,spline)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-                                             !    grid
-      LOGICAL :: torestore
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4),
-     &         child%var%lb(5):child%var%ub(5)
-     &      ),  Target :: tab  ! Results
-      External :: procname
-      Optional ::  procname
-C
-C
-      allocate(childtemp % var)  
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = nbdim  
-C      
-C     Tab is the result of the interpolation
-      childtemp % var % parray5 => tab  
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-C      
-      if (torestore) then
-C 
-          childtemp % var % parray5 = child % var % array5
-C
-          childtemp % var % restore5D => child % var % restore5D
-C      
-        else
-C        
-          Nullify(childtemp % var % restore5D)
-C      
-      endif       
-C 
-C     Index indicating (in the Agrif_Interp5D procedure) if a space
-C        interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex    
-      childtemp % var % Interpolationshouldbemade = 
-     &    child % var % Interpolationshouldbemade   
-      childtemp % var % list_interp => child % var% list_interp          
-C      
-      if (present(procname)) then
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore,procname)
-      else
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore)
-      endif
-
-     
-      child % var % list_interp => childtemp % var %list_interp
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_5D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_6d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Interp_6d(TypeInterp,parent,child,tab,
-     &  torestore,nbdim,procname)            
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions of a fine grid for a 6D
-C        grid variable.
-C
-C     Declarations:
-C      
-      
-C
-C     Arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
-                                             !    (linear,lagrange,spline)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-                                             !    grid
-      LOGICAL :: torestore
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4),
-     &         child%var%lb(5):child%var%ub(5),
-     &         child%var%lb(6):child%var%ub(6)
-     &      ),  Target :: tab  ! Results
-      External :: procname
-      Optional ::  procname
-C
-C
-      allocate(childtemp % var)  
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = nbdim  
-C      
-C     Tab is the result of the interpolation
-      childtemp % var % parray6 => tab  
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-C      
-      if (torestore) then
-C 
-          childtemp % var % parray6 = child % var % array6
-C
-          childtemp % var % restore6D => child % var % restore6D
-C      
-        else
-C        
-          Nullify(childtemp % var % restore6D)
-C      
-      endif       
-C 
-C     Index indicating (in the Agrif_Interp6D procedure) if a space
-C        interpolation is necessary
-      childtemp % var % interpIndex => child % var % interpIndex    
-      childtemp % var % Interpolationshouldbemade = 
-     &    child % var % Interpolationshouldbemade  
-     
-      childtemp % var % list_interp => child % var% list_interp           
-C      
-
-      if (present(procname)) then
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore,procname)
-      else
-      Call Agrif_InterpVariable
-     &     (TypeInterp,parent,childtemp,torestore)
-      endif
-
-
-C      
-      child % var % list_interp => childtemp % var %list_interp
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Interp_6D
-C
-C
-C
-C     **************************************************************************
-C     Subroutine Agrif_InterpVariable    
-C     **************************************************************************
-C   
-      Subroutine Agrif_InterpVariable(TYPEinterp,parent,child,torestore,
-     &            procname)
-C
-CCC   Description:
-CCC   Subroutine to set some arguments of subroutine Agrif_InterpnD, n being the
-CCC   DIMENSION of the grid variable.
-C
-CC    Declarations:
-C      
-c      
-C      
-C
-C     Scalar argument
-      INTEGER,DIMENSION(6) :: TYPEinterp! TYPE of interpolation
-                                        !    (linear,spline,...)
-C     Data TYPE arguments                                   
-      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid
-C
-C     LOGICAL argument      
-      LOGICAL:: torestore               ! Its value is .false., it indicates the
-                                        ! results of the interpolation are    
-                                        ! applied on the whole current grid   
-C
-C     Local scalars      
-      INTEGER               :: nbdim          ! Number of dimensions of the
-                                              !    current grid
-      INTEGER ,DIMENSION(6) :: pttab_child  
-      INTEGER ,DIMENSION(6) :: petab_child      
-      INTEGER ,DIMENSION(6) :: pttab_parent  
-      REAL    ,DIMENSION(6) :: s_child,s_parent
-      REAL    ,DIMENSION(6) :: ds_child,ds_parent
-      External :: procname
-      Optional ::  procname
-
-C
-      Call PreProcessToInterpOrUpdate(parent,child,
-     &             petab_Child(1:nbdim),
-     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &             s_Child(1:nbdim),s_Parent(1:nbdim),
-     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &             nbdim)
-C
-C
-C     Call to a procedure of interpolation against the number of dimensions of 
-C     the grid variable
-C
-
-      if (present(procname)) then
-      call Agrif_InterpnD
-     &            (TYPEinterp,parent,child,
-     &             pttab_Child(1:nbdim),petab_Child(1:nbdim),
-     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &             s_Child(1:nbdim),s_Parent(1:nbdim),
-     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &             child,torestore,nbdim,procname)
-      else
-      call Agrif_InterpnD
-     &            (TYPEinterp,parent,child,
-     &             pttab_Child(1:nbdim),petab_Child(1:nbdim),
-     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &             s_Child(1:nbdim),s_Parent(1:nbdim),
-     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &             child,torestore,nbdim)
-
-      endif
-C
-      Return
-C
-C
-      End subroutine Agrif_InterpVariable       
-C
-C
-C     **************************************************************************
-C     Subroutine Agrif_InterpnD  
-C     **************************************************************************
-C  
-      Subroutine Agrif_InterpnD(TYPEinterp,parent,child,
-     &                          pttab,petab,
-     &                          pttab_Child,pttab_Parent,
-     &                          s_Child,s_Parent,ds_Child,ds_Parent,
-     &                          restore,torestore,nbdim,procname)
-C
-C     Description:
-C     Subroutine to interpolate a nD grid variable from its parent grid,
-C     by using a space interpolation. 
-C
-C     Declarations:
-C
-      
-C
-#ifdef key_mpp_mpi
-C
-        INCLUDE 'mpif.h'
-C
-#endif
-C
-C     Arguments
-      External :: procname
-      Optional :: procname
-      INTEGER                    :: nbdim
-      INTEGER,DIMENSION(6)       :: TYPEinterp         ! TYPE of interpolation
-                                                       !    (linear,...)
-      TYPE(AGRIF_PVARIABLE)      :: parent             ! Variable of the parent
-                                                       !    grid
-      TYPE(AGRIF_PVARIABLE)      :: child              ! Variable of the child
-                                                       !    grid
-      INTEGER,DIMENSION(nbdim)   :: pttab              ! Index of the first
-                                                       !    point inside the
-                                                       !    domain
-      INTEGER,DIMENSION(nbdim)   :: petab              ! Index of the first
-                                                       !    point inside the
-                                                       !    domain
-      INTEGER,DIMENSION(nbdim)   :: pttab_Child        ! Index of the first
-                                                       !    point inside the
-                                                       !    domain for the child
-                                                       !    grid variable
-      INTEGER,DIMENSION(nbdim)   :: pttab_Parent       ! Index of the first
-                                                       !    point inside the
-                                                       !    domain for the
-                                                       !    parent grid variable
-      TYPE(AGRIF_PVARIABLE)      :: restore            ! Indicates points where
-                                                       !    interpolation
-      REAL,DIMENSION(nbdim)      :: s_Child,s_Parent   ! Positions of the parent
-                                                       !    and child grids
-      REAL,DIMENSION(nbdim)      :: ds_Child,ds_Parent ! Space steps of the
-                                                       !    parent and child
-                                                       !    grids
-      LOGICAL                        :: torestore      ! Indicates if the array
-                                                       !    restore is used
-C
-C     Local pointers
-      TYPE(AGRIF_PVARIABLE),SAVE      :: tempP,tempPextend  ! Temporary parent grid variable
-      TYPE(AGRIF_PVARIABLE),SAVE      :: tempC      ! Temporary child grid variable
-C
-C     Local scalars        
-      INTEGER                     :: i,j,k,l,m,n
-      INTEGER,DIMENSION(nbdim)    :: pttruetab,cetruetab
-      INTEGER,DIMENSION(nbdim)    :: indmin,indmax
-      LOGICAL,DIMENSION(nbdim)    :: noraftab
-      REAL   ,DIMENSION(nbdim)    :: s_Child_temp,s_Parent_temp
-      INTEGER,DIMENSION(nbdim)    :: lowerbound,upperbound
-      INTEGER,DIMENSION(nbdim)    :: indminglob,indmaxglob
-      INTEGER,DIMENSION(nbdim,2,2) :: childarray
-      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
-      LOGICAL :: memberin,member
-      TYPE(AGRIF_PVARIABLE),SAVE                      ::  parentvalues
-      LOGICAL :: find_list_interp
-      INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2      
-C
-#ifdef key_mpp_mpi
-C
-      LOGICAL :: memberout
-      INTEGER,PARAMETER                          :: etiquette = 100
-      INTEGER                                    :: code
-      INTEGER,DIMENSION(nbdim,4)           :: tab3
-      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
-      LOGICAL, DIMENSION(1) :: memberin1
-C
-#endif      
-C     
-
-C   
-C     Boundaries of the current grid where interpolation is done
-
-      IF (Associated(child%var%list_interp)) THEN
-      Call Agrif_Find_list_interp(child%var%list_interp,pttab,petab,
-     &                          pttab_Child,pttab_Parent,nbdim,
-     &                          indmin,indmax,indminglob,
-     &       indmaxglob,indminglob2,indmaxglob2,parentarray,
-     &       pttruetab,cetruetab,member,memberin,find_list_interp
-#if defined key_mpp_mpi
-     &       ,tab4t,memberinall,sendtoproc1,recvfromproc1
-#endif
-     &    )
-      ELSE
-      find_list_interp = .FALSE.
-      ENDIF
-      
-      IF (.not.find_list_interp) THEN
-
-      Call Agrif_nbdim_Get_bound_dimension(child % var,
-     &                               lowerbound,upperbound,nbdim)
-      
-      Call Agrif_Childbounds(nbdim,lowerbound,upperbound,
-     &                                   pttab,petab,
-     &                                   pttruetab,cetruetab,memberin)
-     
-C
-      Call Agrif_Parentbounds(TYPEinterp,nbdim,indminglob,indmaxglob,
-     &                        s_Parent_temp,s_Child_temp,
-     &                        s_Child,ds_Child,
-     &                        s_Parent,ds_Parent,
-     &                        pttab,petab,
-     &                        pttab_Child,pttab_Parent,
-     &                        child%var%root_var%posvar,
-     &                        child % var % root_var % interptab)
-       
-#ifdef key_mpp_mpi
-       IF (memberin) THEN
-        Call Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
-     &                        s_Parent_temp,s_Child_temp,
-     &                        s_Child,ds_Child,
-     &                        s_Parent,ds_Parent,
-     &                        pttruetab,cetruetab,
-     &                        pttab_Child,pttab_Parent,
-     &                        child%var%root_var%posvar,
-     &                        child % var % root_var % interptab)
-      ENDIF
-       
-      Call Agrif_nbdim_Get_bound_dimension(parent%var,
-     &                              lowerbound,upperbound,nbdim)
-       
-      Call Agrif_ChildGrid_to_ParentGrid()
-C
-      Call Agrif_Childbounds(nbdim,
-     &                       lowerbound,upperbound,
-     &                       indminglob,indmaxglob,
-     &                       indminglob2,indmaxglob2,member)
-
-C
-      IF (member) THEN
-      Call Agrif_GlobtoLocInd2(parentarray,
-     &                     lowerbound,upperbound,
-     &                     indminglob2,indmaxglob2,
-     &                     nbdim,Agrif_Procrank,
-     &                     member)
-       endif
-       
-      Call Agrif_ParentGrid_to_ChildGrid()
-#else
-      parentarray(:,1,1) = indminglob
-      parentarray(:,2,1) = indmaxglob
-      parentarray(:,1,2) = indminglob
-      parentarray(:,2,2) = indmaxglob
-      indmin = indminglob
-      indmax = indmaxglob
-      member = .TRUE.
-#endif
-
-      ELSE
-      
-#if !defined key_mpp_mpi
-      parentarray(:,1,1) = indminglob
-      parentarray(:,2,1) = indmaxglob
-      parentarray(:,1,2) = indminglob
-      parentarray(:,2,2) = indmaxglob
-      indmin = indminglob
-      indmax = indmaxglob
-      member = .TRUE.
-      s_Parent_temp = s_Parent + (indminglob - pttab_Parent)*ds_Parent
-      s_Child_temp = s_Child + (pttab - pttab_Child) * ds_Child
-#else      
-      s_Parent_temp = s_Parent + (indmin - pttab_Parent)*ds_Parent
-      s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child
-#endif      
-           
-      ENDIF
-
-      IF (member) THEN
-      IF (.not.associated(tempP%var)) allocate(tempP%var)
-
-C
-      Call Agrif_nbdim_allocation(tempP%var,
-     &     parentarray(:,1,1),parentarray(:,2,1),nbdim)
-
-      Call Agrif_nbdim_Full_VarEQreal(tempP%var,0.,nbdim)
-
-      IF (present(procname)) THEN
-      Call Agrif_ChildGrid_to_ParentGrid()
-            SELECT CASE (nbdim)
-        CASE(1)
-          CALL procname(tempP%var%array1,
-     &                          parentarray(1,1,2),parentarray(1,2,2))
-        CASE(2)
-          CALL procname(tempP%var%array2,
-     &                          parentarray(1,1,2),parentarray(1,2,2),
-     &                          parentarray(2,1,2),parentarray(2,2,2))
-        CASE(3)
-          CALL procname(tempP%var%array3,
-     &                          parentarray(1,1,2),parentarray(1,2,2),
-     &                          parentarray(2,1,2),parentarray(2,2,2),
-     &                          parentarray(3,1,2),parentarray(3,2,2))
-        CASE(4)
-          CALL procname(tempP%var%array4,
-     &                          parentarray(1,1,2),parentarray(1,2,2),
-     &                          parentarray(2,1,2),parentarray(2,2,2),
-     &                          parentarray(3,1,2),parentarray(3,2,2),
-     &                          parentarray(4,1,2),parentarray(4,2,2))
-        CASE(5)
-          CALL procname(tempP%var%array5,
-     &                          parentarray(1,1,2),parentarray(1,2,2),
-     &                          parentarray(2,1,2),parentarray(2,2,2),
-     &                          parentarray(3,1,2),parentarray(3,2,2),
-     &                          parentarray(4,1,2),parentarray(4,2,2),
-     &                          parentarray(5,1,2),parentarray(5,2,2))
-        CASE(6)
-          CALL procname(tempP%var%array6,
-     &                          parentarray(1,1,2),parentarray(1,2,2),
-     &                          parentarray(2,1,2),parentarray(2,2,2),
-     &                          parentarray(3,1,2),parentarray(3,2,2),
-     &                          parentarray(4,1,2),parentarray(4,2,2),
-     &                          parentarray(5,1,2),parentarray(5,2,2),
-     &                          parentarray(6,1,2),parentarray(6,2,2))
-            END SELECT
-      Call Agrif_ParentGrid_to_ChildGrid()
-      ELSE
-
-      Call Agrif_nbdim_VarEQvar(tempP%var,
-     &        parentarray(:,1,1),parentarray(:,2,1),
-     &        parent%var,parentarray(:,1,2),parentarray(:,2,2),
-     &        nbdim)
-      ENDIF
-            endif
-
-#ifdef key_mpp_mpi
-      if (.not.find_list_interp) then
-      tab3(:,1) = indminglob2(:)
-      tab3(:,2) = indmaxglob2(:)
-      tab3(:,3) = indmin(:)
-      tab3(:,4) = indmax(:)
-C
-C
-      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
-     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
-
-      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var)
-
-      DO k=0,Agrif_Nbprocs-1
-       do j=1,4
-         do i=1,nbdim
-         tab4t(i,k,j) = tab4(i,j,k)
-                enddo
-      enddo
-      enddo
-      
-      memberin1(1) = memberin
-      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,
-     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
-
-       Call Get_External_Data_first(tab4t(:,:,1),
-     &            tab4t(:,:,2),
-     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin,
-     &            memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5),
-     & tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
-          
-      endif     
-           
-!      Call Get_External_Data(tempP,tempPextend,tab4t(:,:,1),
-!     &            tab4t(:,:,2),
-!     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin,
-!     &            memberinall)
-     
-      Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim,
-     &            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),
-     &            tab4t(:,:,7),tab4t(:,:,8),memberin,tempP,
-     &            tempPextend)
-#else
-      tempPextend%var => tempP%var
-#endif
-
-      if (.not.find_list_interp) then
-      Call Agrif_Addto_list_interp(child%var%list_interp,pttab,petab,
-     &                          pttab_Child,pttab_Parent,indmin,indmax,
-     &   indminglob,indmaxglob,indminglob2,indmaxglob2,parentarray,
-     &   pttruetab,cetruetab,member,memberin,nbdim
-#if defined key_mpp_mpi
-     &   ,tab4t,memberinall,sendtoproc1,recvfromproc1
-#endif
-     &    )
-      endif   
-C
-C
-      IF (memberin) THEN
-      IF (.not.associated(tempC%var)) allocate(tempC%var)
-C
-
-      Call Agrif_nbdim_allocation(tempC%var,pttruetab,cetruetab,nbdim)
-
-C
-C
-C     Special values on the parent grid
-      if (Agrif_UseSpecialValue) then
-C
-          noraftab(1:nbdim) =
-     &         child % var % root_var % interptab(1:nbdim) .EQ. 'N'
-C
-          IF (.not.associated(parentvalues%var))
-     &            Allocate(parentvalues%var)
-C
-          Call Agrif_nbdim_allocation
-     &               (parentvalues%var,indmin,indmax,nbdim)
-          Call Agrif_nbdim_Full_VarEQvar
-     &               (parentvalues%var,tempPextend%var,nbdim)
-C
-          Call Agrif_CheckMasknD(tempPextend,
-     &                           parentvalues,
-     &                           indmin(1:nbdim),indmax(1:nbdim),
-     &                           indmin(1:nbdim),indmax(1:nbdim),
-     &                           noraftab(1:nbdim),nbdim)
-C
-          Call Agrif_nbdim_deallocation(parentvalues%var,nbdim)
-C          Deallocate(parentvalues%var)
-C
-C
-      endif      
-
-C
-C
-C     Interpolation of the current grid
-
-      IF (memberin) THEN
-      if ( nbdim .EQ. 1 ) then
-         Call Agrif_Interp_1D_recursive(TypeInterp,
-     &           tempPextend%var%array1,tempC%var%array1,
-     &           indmin,indmax,
-     &           pttruetab,cetruetab,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      elseif ( nbdim .EQ. 2 ) then
-
-         Call Agrif_Interp_2D_recursive(TypeInterp,
-     &           tempPextend%var%array2,tempC%var%array2,
-     &           indmin,indmax,
-     &           pttruetab,cetruetab,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      elseif ( nbdim .EQ. 3 ) then
-
-         Call Agrif_Interp_3D_recursive(TypeInterp,
-     &           tempPextend%var%array3,tempC%var%array3,
-     &           indmin,indmax,
-     &           pttruetab,cetruetab,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      elseif ( nbdim .EQ. 4 ) then
-         Call Agrif_Interp_4D_recursive(TypeInterp,
-     &           tempPextend%var%array4,tempC%var%array4,
-     &           indmin,indmax,
-     &           pttruetab,cetruetab,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      elseif ( nbdim .EQ. 5 ) then
-         Call Agrif_Interp_5D_recursive(TypeInterp,
-     &           tempPextend%var%array5,tempC%var%array5,
-     &           indmin,indmax,
-     &           pttruetab,cetruetab,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      elseif ( nbdim .EQ. 6 ) then
-         Call Agrif_Interp_6D_recursive(TypeInterp,
-     &           tempPextend%var%array6,tempC%var%array6,
-     &           indmin,indmax,
-     &           pttruetab,cetruetab,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-       endif
-
-
-C  
-
-      Call Agrif_nbdim_Get_bound_dimension(child % var,
-     &                               lowerbound,upperbound,nbdim)
-
-#ifdef key_mpp_mpi
-      Call Agrif_GlobtoLocInd2(childarray,
-     &                     lowerbound,upperbound,
-     &                     pttruetab,cetruetab,
-     &                     nbdim,Agrif_Procrank,
-     &                     memberout)
-
-#else
-       childarray(:,1,1) = pttruetab
-       childarray(:,2,1) = cetruetab
-       childarray(:,1,2) = pttruetab
-       childarray(:,2,2) = cetruetab
-ccccccccccccccc       memberout = .TRUE.
-#endif
-
-
-C
-C
-C     Special values on the child grid  
-      if (Agrif_UseSpecialValueFineGrid) then
-C
-
-          Call GiveAgrif_SpecialValueToTab_mpi(child%var,tempC%var,
-     &                 childarray,
-     &                 pttruetab,cetruetab,
-     &                 Agrif_SpecialValueFineGrid,nbdim)
-
-C        
-      endif
-      
-      endif
-
-C
-      if (torestore) then
-C
-#ifdef key_mpp_mpi
-C
-        SELECT CASE (nbdim)
-        CASE (1)
-             do i = pttruetab(1),cetruetab(1)         
-ChildarrayAModifier                if (restore%var%restore1D(i) == 0) 
-ChildarrayAModifier     &                child%var%array1(childarray(i,1,2)
-ChildarrayAModifier     &                                 ) = 
-ChildarrayAModifier     &                tempC%var%array1(i)
-             enddo
-        CASE (2)
-             do i = pttruetab(1),cetruetab(1)
-             do j = pttruetab(2),cetruetab(2)
-ChildarrayAModifier                   if (restore%var%restore2D(i,j) == 0) 
-ChildarrayAModifier     &                child%var%array2(childarray(i,1,2),
-ChildarrayAModifier     &                                 childarray(j,2,2)) = 
-ChildarrayAModifier     &                tempC%var%array2(i,j)
-             enddo
-             enddo
-        CASE (3)
-             do i = pttruetab(1),cetruetab(1)
-             do j = pttruetab(2),cetruetab(2)  
-             do k = pttruetab(3),cetruetab(3)
-ChildarrayAModifier                      if (restore%var%restore3D(i,j,k) == 0) 
-ChildarrayAModifier     &                child%var%array3(childarray(i,1,2),
-ChildarrayAModifier     &                                 childarray(j,2,2),
-ChildarrayAModifier     &                                 childarray(k,3,2)) = 
-ChildarrayAModifier     &                tempC%var%array3(i,j,k)
-             enddo
-             enddo
-             enddo
-        CASE (4)
-             do i = pttruetab(1),cetruetab(1)
-             do j = pttruetab(2),cetruetab(2)
-             do k = pttruetab(3),cetruetab(3)
-             do l = pttruetab(4),cetruetab(4)
-ChildarrayAModifier                         if (restore%var%restore4D(i,j,k,l) == 0) 
-ChildarrayAModifier     &                      child%var%array4(childarray(i,1,2),
-ChildarrayAModifier     &                                       childarray(j,2,2),
-ChildarrayAModifier     &                                       childarray(k,3,2),
-ChildarrayAModifier     &                                       childarray(l,4,2)) = 
-ChildarrayAModifier     &                      tempC%var%array4(i,j,k,l)
-             enddo
-             enddo
-             enddo
-             enddo
-        CASE (5)
-             do i = pttruetab(1),cetruetab(1)
-             do j = pttruetab(2),cetruetab(2)
-             do k = pttruetab(3),cetruetab(3)
-             do l = pttruetab(4),cetruetab(4)
-             do m = pttruetab(5),cetruetab(5)
-ChildarrayAModifier              if (restore%var%restore5D(i,j,k,l,m) == 0) 
-ChildarrayAModifier     &                child%var%array5(childarray(i,1,2),
-ChildarrayAModifier     &                                 childarray(j,2,2),
-ChildarrayAModifier     &                                 childarray(k,3,2),
-ChildarrayAModifier     &                                 childarray(l,4,2),
-ChildarrayAModifier     &                                 childarray(m,5,2)) = 
-ChildarrayAModifier     &                tempC%var%array5(i,j,k,l,m)
-             enddo
-             enddo
-             enddo
-             enddo
-             enddo
-        CASE (6)
-             do i = pttruetab(1),cetruetab(1)
-             do j = pttruetab(2),cetruetab(2)
-             do k = pttruetab(3),cetruetab(3)
-             do l = pttruetab(4),cetruetab(4)
-             do m = pttruetab(5),cetruetab(5)
-             do n = pttruetab(6),cetruetab(6)
-ChildarrayAModifier              if (restore%var%restore6D(i,j,k,l,m,n) == 0) 
-ChildarrayAModifier     &                child%var%array6(childarray(i,1,2),
-ChildarrayAModifier     &                                 childarray(j,2,2),
-ChildarrayAModifier     &                                 childarray(k,3,2),
-ChildarrayAModifier     &                                 childarray(l,4,2),
-ChildarrayAModifier     &                                 childarray(m,5,2),
-ChildarrayAModifier     &                                 childarray(n,6,2)) = 
-ChildarrayAModifier     &                tempC%var%array6(i,j,k,l,m,n)
-             enddo
-             enddo
-             enddo
-             enddo
-             enddo
-             enddo
-        END SELECT
-C
-#else
-        SELECT CASE (nbdim)
-        CASE (1)
-           do i = pttruetab(1),cetruetab(1)         
-            if (restore%var%restore1D(i) == 0)
-     &            child % var % parray1(i) = 
-     &            tempC % var % array1(i)    
-          enddo
-        CASE (2)
-           do j = pttruetab(2),cetruetab(2)
-             do i = pttruetab(1),cetruetab(1) 
-              if (restore%var%restore2D(i,j) == 0)     
-     &              child % var % parray2(i,j) = 
-     &              tempC % var % array2(i,j)    
-              enddo
-             enddo
-        CASE (3)
-           do k = pttruetab(3),cetruetab(3)
-           do j = pttruetab(2),cetruetab(2)
-             do i = pttruetab(1),cetruetab(1) 
-              if (restore%var%restore3D(i,j,k) == 0)
-     &                  child % var % parray3(i,j,k) =
-     &                  tempC % var % array3(i,j,k)    
-                  enddo
-              enddo
-             enddo
-        CASE (4)
-           do l = pttruetab(4),cetruetab(4)
-           do k = pttruetab(3),cetruetab(3)
-          do j = pttruetab(2),cetruetab(2)
-             do i = pttruetab(1),cetruetab(1)
-                if (restore%var%restore4D(i,j,k,l) == 0)
-     &                 child % var % parray4(i,j,k,l) = 
-     &                 tempC % var % array4(i,j,k,l)    
-             enddo
-             enddo
-              enddo
-             enddo
-        CASE (5)
-           do m = pttruetab(5),cetruetab(5)
-          do l = pttruetab(4),cetruetab(4)
-         do k = pttruetab(3),cetruetab(3)
-           do j = pttruetab(2),cetruetab(2)
-             do i = pttruetab(1),cetruetab(1)
-                if (restore%var%restore5D(i,j,k,l,m) == 0)
-     &                  child % var % parray5(i,j,k,l,m) = 
-     &                  tempC % var % array5(i,j,k,l,m)    
-             enddo
-             enddo
-                  enddo
-              enddo
-             enddo
-        CASE (6)
-           do n = pttruetab(6),cetruetab(6)
-          do m = pttruetab(5),cetruetab(5)
-          do l = pttruetab(4),cetruetab(4)
-         do k = pttruetab(3),cetruetab(3)
-          do j = pttruetab(2),cetruetab(2)
-             do i = pttruetab(1),cetruetab(1)
-                if (restore%var%restore6D(i,j,k,l,m,n) == 0)
-     &                      child % var % parray6(i,j,k,l,m,n) = 
-     &                      tempC % var % array6(i,j,k,l,m,n)    
-             enddo
-            enddo
-                      enddo
-                  enddo
-              enddo
-             enddo
-        END SELECT
-C
-#endif
-C        
-        else
-C
-C
-          IF (memberin) THEN
-          SELECT CASE (nbdim)
-          CASE (1)
-            child%var%parray1(childarray(1,1,2):childarray(1,2,2)) =
-     &       tempC%var%array1(childarray(1,1,1):childarray(1,2,1))
-          CASE (2)
-            child%var%parray2(childarray(1,1,2):childarray(1,2,2),
-     &                       childarray(2,1,2):childarray(2,2,2)) =
-     &      tempC%var%array2(childarray(1,1,1):childarray(1,2,1),
-     &                       childarray(2,1,1):childarray(2,2,1))
-          CASE (3)
-            child%var%parray3(childarray(1,1,2):childarray(1,2,2),
-     &                       childarray(2,1,2):childarray(2,2,2),
-     &                       childarray(3,1,2):childarray(3,2,2)) =
-     &      tempC%var%array3(childarray(1,1,1):childarray(1,2,1),
-     &                       childarray(2,1,1):childarray(2,2,1),
-     &                       childarray(3,1,1):childarray(3,2,1))
-          CASE (4)
-            child%var%parray4(childarray(1,1,2):childarray(1,2,2),
-     &                       childarray(2,1,2):childarray(2,2,2),
-     &                       childarray(3,1,2):childarray(3,2,2),
-     &                       childarray(4,1,2):childarray(4,2,2)) =
-     &      tempC%var%array4(childarray(1,1,1):childarray(1,2,1),
-     &                       childarray(2,1,1):childarray(2,2,1),
-     &                       childarray(3,1,1):childarray(3,2,1),
-     &                       childarray(4,1,1):childarray(4,2,1))
-          CASE (5)
-            child%var%parray5(childarray(1,1,2):childarray(1,2,2),
-     &                       childarray(2,1,2):childarray(2,2,2),
-     &                       childarray(3,1,2):childarray(3,2,2),
-     &                       childarray(4,1,2):childarray(4,2,2),
-     &                       childarray(5,1,2):childarray(5,2,2)) =
-     &      tempC%var%array5(childarray(1,1,1):childarray(1,2,1),
-     &                       childarray(2,1,1):childarray(2,2,1),
-     &                       childarray(3,1,1):childarray(3,2,1),
-     &                       childarray(4,1,1):childarray(4,2,1),
-     &                       childarray(5,1,1):childarray(5,2,1))
-          CASE (6)
-            child%var%parray6(childarray(1,1,2):childarray(1,2,2),
-     &                       childarray(2,1,2):childarray(2,2,2),
-     &                       childarray(3,1,2):childarray(3,2,2),
-     &                       childarray(4,1,2):childarray(4,2,2),
-     &                       childarray(5,1,2):childarray(5,2,2),
-     &                       childarray(6,1,2):childarray(6,2,2)) =
-     &      tempC%var%array6(childarray(1,1,1):childarray(1,2,1),
-     &                       childarray(2,1,1):childarray(2,2,1),
-     &                       childarray(3,1,1):childarray(3,2,1),
-     &                       childarray(4,1,1):childarray(4,2,1),
-     &                       childarray(5,1,1):childarray(5,2,1),
-     &                       childarray(6,1,1):childarray(6,2,1))
-          END SELECT
-          ENDIF
-C
-C       
-      endif
-
-        Call Agrif_nbdim_deallocation(tempPextend%var,nbdim)
-C        deallocate(tempPextend%var)
-
-      Call Agrif_nbdim_deallocation(tempC%var,nbdim)
-      
-C      Deallocate(tempC % var)
-      ELSE
-      
-C      deallocate(tempPextend%var)
-
-      ENDIF
-C
-C             
-C     Deallocations
-#ifdef key_mpp_mpi        
-      IF (member) THEN
-      Call Agrif_nbdim_deallocation(tempP%var,nbdim)
-C      Deallocate(tempP % var)
-      endif
-#endif
-C
-C
-      
-C
-C
-      End Subroutine Agrif_InterpnD 
-C
-C
-C
-C                  
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Parentbounds
-C     **************************************************************************
-C
-      Subroutine Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
-     &                              s_Parent_temp,
-     &                              s_Child_temp,s_Child,ds_Child,
-     &                              s_Parent,ds_Parent,
-     &                              pttruetab,cetruetab,pttab_Child,
-     &                              pttab_Parent,posvar,interptab)
-C
-CCC   Description:
-CCC   Subroutine calculating the bounds of the parent grid for the interpolation
-CCC   of the child grid     
-C
-C
-C     Declarations:
-C
-C
-C     Arguments
-      INTEGER :: nbdim
-      INTEGER, DIMENSION(6) :: TypeInterp
-      INTEGER,DIMENSION(nbdim) :: indmin,indmax
-      REAL,DIMENSION(nbdim) :: s_Parent_temp,s_child_temp
-      REAL,DIMENSION(nbdim) :: s_Child,ds_child
-      REAL,DIMENSION(nbdim) :: s_Parent,ds_Parent
-      INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
-      INTEGER,DIMENSION(nbdim) :: pttab_Child,pttab_Parent
-      INTEGER,DIMENSION(nbdim) :: posvar
-      CHARACTER(6), DIMENSION(nbdim) :: interptab
-C
-C     Local variables
-      INTEGER :: i
-      REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax      
-C
-      dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child
-      dim_newmax = s_Child + (cetruetab - pttab_Child) * ds_Child
-      
-      DO i = 1,nbdim         
-C     
-        indmin(i) = pttab_Parent(i) + 
-     &         agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
-C
-        indmax(i) = pttab_Parent(i) + 
-     &                agrif_ceiling((dim_newmax(i)-
-     &                s_Parent(i))/ds_Parent(i))
-     
-C
-C
-C       Necessary for the Quadratic interpolation
-C  
-
-        IF ((pttruetab(i) == cetruetab(i)) .AND. 
-     &                           (posvar(i) == 1)) THEN
-        ELSEIF (interptab(i) .EQ. 'N') THEN
-        ELSEIF ( TYPEinterp(i) .eq. Agrif_ppm .or.
-     &      TYPEinterp(i) .eq. Agrif_eno  .or.
-     &      TYPEinterp(i) .eq. Agrif_weno) THEN            
-           indmin(i) = indmin(i) - 2  
-           indmax(i) = indmax(i) + 2                  
-        ELSE IF (( TYPEinterp(i) .ne. Agrif_constant )
-     &        .AND.( TYPEinterp(i) .ne. Agrif_linear )) THEN
-           indmin(i) = indmin(i) - 1  
-           indmax(i) = indmax(i) + 1
-        ENDIF
-        
-
-C        
-       ENDDO 
-C
-        s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
-C     
-        s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child
-C
-C
-      Return
-C
-C
-      End Subroutine Agrif_Parentbounds
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_1D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Interp_1D_recursive(TypeInterp,tabin,tabout,
-     &           indmin,indmax, 
-     &           pttab_child,petab_child,
-     &           s_child,s_parent,ds_child,ds_parent,nbdim)     
-C
-CCC   Description:
-CCC   Subroutine for the interpolation of a 1D grid variable. 
-CCC   It calls Agrif_InterpBase. 
-C
-C     Declarations:
-C
-      
-C
-C     Arguments
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(1) :: TypeInterp
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim) :: s_child,s_parent
-      REAL, DIMENSION(nbdim) :: ds_child,ds_parent
-      REAL, INTENT(IN),DIMENSION(indmin(nbdim):indmax(nbdim)) :: tabin        
-      REAL, INTENT(OUT),
-     &      DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tabout
-      INTEGER :: coeffraf
-C
-C
-C     Commentaire perso : nbdim vaut toujours 1 ici. 
-C
-      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
-      
-      Call Agrif_InterpBase(TypeInterp(1),
-     &                  tabin(indmin(nbdim):indmax(nbdim)),
-     &                  tabout(pttab_child(nbdim):petab_child(nbdim)),
-     &                  indmin(nbdim),indmax(nbdim),            
-     &                  pttab_child(nbdim),petab_child(nbdim),
-     &                  s_parent(nbdim),s_child(nbdim),
-     &                  ds_parent(nbdim),ds_child(nbdim),coeffraf)
-                
-C                
-      Return
-C
-C
-      End Subroutine Agrif_Interp_1D_recursive
-C
-C
-C      
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_2D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Interp_2D_recursive(TypeInterp,
-     &           tabin,tabout,
-     &           indmin,indmax,   
-     &           pttab_child,petab_child,
-     &            s_child, s_parent,
-     &           ds_child,ds_parent,
-     &           nbdim)
-C
-CCC   Description:
-CCC   Subroutine for the interpolation of a 2D grid variable. 
-CCC   It calls Agrif_Interp_1D_recursive and Agrif_InterpBase.    
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER                   :: nbdim
-      INTEGER,DIMENSION(2)      :: TypeInterp
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL   , DIMENSION(nbdim) ::  s_child, s_parent
-      REAL   , DIMENSION(nbdim) :: ds_child,ds_parent
-      REAL   ,INTENT(IN), DIMENSION(
-     &                indmin(nbdim-1):indmax(nbdim-1),
-     &                indmin(nbdim):indmax(nbdim)
-     &                ) :: tabin        
-      REAL   ,INTENT(OUT), DIMENSION(
-     &                pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                pttab_child(nbdim):petab_child(nbdim)
-     &                ) :: tabout
-C
-C     Local variables      
-      REAL, DIMENSION(pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
-      INTEGER i,j
-      INTEGER :: coeffraf
-      REAL   , DIMENSION(
-     &                pttab_child(nbdim):petab_child(nbdim),
-     &                pttab_child(nbdim-1):petab_child(nbdim-1)
-     &                ) :: tabout_trsp
-      REAL, DIMENSION(indmin(nbdim):indmax(nbdim),
-     &        pttab_child(nbdim-1):petab_child(nbdim-1)) :: tabtemp_trsp
-
-C
-C
-C
-C
-C     Commentaire perso : nbdim vaut toujours 2 ici.
-C
-      coeffraf = nint ( ds_parent(1) / ds_child(1) )
-      IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN
-
-!---CDIR NEXPAND
-          IF(.NOT. precomputedone(1) ) call linear1Dprecompute2D(
-     &          indmax(2)-indmin(2)+1,   
-     &          indmax(1)-indmin(1)+1,   
-     &          petab_child(1)-pttab_child(1)+1,
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-!---CDIR NEXPAND
-           call linear1daftercompute(tabin,tabtemp,
-     &          size(tabin), size(tabtemp),  
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
- 
-      ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN
-!---CDIR NEXPAND
-          IF(.NOT. precomputedone(1) ) call ppm1Dprecompute2D(
-     &          indmax(2)-indmin(2)+1,   
-     &          indmax(1)-indmin(1)+1,   
-     &          petab_child(1)-pttab_child(1)+1,
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-!---CDIR NEXPAND
-           call ppm1daftercompute(tabin,tabtemp,
-     &          size(tabin), size(tabtemp),  
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-
-      ELSE
-
-      do j = indmin(nbdim),indmax(nbdim)
-C        
-!---CDIR NEXPAND
-        Call Agrif_Interp_1D_recursive(TypeInterp(1),
-     &         tabin(indmin(nbdim-1):indmax(nbdim-1),j),
-     &         tabtemp(pttab_child(nbdim-1):petab_child(nbdim-1),j),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C        
-      enddo
-      ENDIF   
-
-      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
-      
-      tabtemp_trsp = TRANSPOSE(tabtemp)
-
-      IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN
-
-!---CDIR NEXPAND
-          IF(.NOT. precomputedone(2) ) call linear1Dprecompute2D(
-     &          petab_child(1)-pttab_child(1)+1,
-     &          indmax(2)-indmin(2)+1,
-     &          petab_child(2)-pttab_child(2)+1,
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-!---CDIR NEXPAND
-           call linear1daftercompute(tabtemp_trsp,tabout_trsp,
-     &          size(tabtemp_trsp), size(tabout_trsp),
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-
-      ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN
-
-!---CDIR NEXPAND
-           IF(.NOT. precomputedone(1) )call ppm1Dprecompute2D(
-     &          petab_child(1)-pttab_child(1)+1,
-     &          indmax(2)-indmin(2)+1,
-     &          petab_child(2)-pttab_child(2)+1,
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-!---CDIR NEXPAND
-           call ppm1daftercompute(tabtemp_trsp,tabout_trsp,
-     &          size(tabtemp_trsp), size(tabout_trsp),
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-
-      ELSE
-      do i=pttab_child(nbdim-1),petab_child(nbdim-1)
-C
-!---CDIR NEXPAND
-        Call Agrif_InterpBase(TypeInterp(2),
-     &           tabtemp_trsp(indmin(nbdim):indmax(nbdim),i),
-     &           tabout_trsp(pttab_child(nbdim):petab_child(nbdim),i),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
-
-C        
-      enddo
-      ENDIF
-      
-      tabout = TRANSPOSE(tabout_trsp)
-C
-      Return
-C
-C
-      End Subroutine Agrif_Interp_2D_recursive
-C
-C
-C      
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_3D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Interp_3D_recursive(TypeInterp,tabin,tabout,
-     &           indmin,indmax,   
-     &           pttab_child,petab_child,
-     &           s_child,s_parent,ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine for the interpolation of a 3D grid variable. 
-CCC   It calls Agrif_Interp_2D_recursive and Agrif_InterpBase.    
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(3) :: TypeInterp
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
-      REAL,INTENT(IN), DIMENSION(indmin(nbdim-2):indmax(nbdim-2),
-     &                indmin(nbdim-1):indmax(nbdim-1),
-     &                indmin(nbdim)  :indmax(nbdim)) :: tabin        
-      REAL,INTENT(OUT),
-     &        DIMENSION(pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
-C
-C     Local variables      
-      REAL, DIMENSION(pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                 pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
-      INTEGER i,j,k
-      INTEGER :: coeffraf, locind_child_left, kdeb
-C
-C
-      coeffraf = nint ( ds_parent(1) / ds_child(1) )
-      IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf/=1))THEN 
-        Call linear1Dprecompute2D(
-     &          indmax(2)-indmin(2)+1,
-     &          indmax(1)-indmin(1)+1,
-     &          petab_child(1)-pttab_child(1)+1,
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-      precomputedone(1) = .TRUE. 
-      ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf/=1))THEN
-        Call ppm1Dprecompute2D(
-     &          indmax(2)-indmin(2)+1,
-     &          indmax(1)-indmin(1)+1,
-     &          petab_child(1)-pttab_child(1)+1,
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-      precomputedone(1) = .TRUE.
-      ENDIF
-
-      coeffraf = nint ( ds_parent(2) / ds_child(2) )
-      IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf/=1)) THEN
-         Call linear1Dprecompute2D(
-     &          petab_child(1)-pttab_child(1)+1,
-     &          indmax(2)-indmin(2)+1,
-     &          petab_child(2)-pttab_child(2)+1,
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-      precomputedone(2) = .TRUE. 
-      ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf/=1)) THEN
-         Call ppm1Dprecompute2D(
-     &          petab_child(1)-pttab_child(1)+1,
-     &          indmax(2)-indmin(2)+1,
-     &          petab_child(2)-pttab_child(2)+1,
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-      precomputedone(2) = .TRUE.
-      ENDIF
-
-      do k = indmin(nbdim),indmax(nbdim)
-C        
-        Call Agrif_Interp_2D_recursive(TypeInterp(1:2),
-     &         tabin(indmin(nbdim-2):indmax(nbdim-2),
-     &         indmin(nbdim-1):indmax(nbdim-1),k),
-     &         tabtemp(pttab_child(nbdim-2):petab_child(nbdim-2),
-     &         pttab_child(nbdim-1):petab_child(nbdim-1),k),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C        
-      enddo
-      
-      precomputedone(1) = .FALSE.
-      precomputedone(2) = .FALSE.
-      coeffraf = nint ( ds_parent(3) / ds_child(3) )
-
-      Call Agrif_Compute_nbdim_interp(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-           
-      IF (coeffraf == 1) THEN
-      
-      kdeb = indmin(3)+locind_child_left-2
-      do k=pttab_child(3),petab_child(3)
-      kdeb = kdeb + 1
-      do j = pttab_child(2),petab_child(2)
-        do i = pttab_child(1),petab_child(1)
-        tabout(i,j,k) = tabtemp(i,j,kdeb)
-      enddo
-      enddo
-      enddo
-              
-      ELSE      
-C
-      do j=pttab_child(nbdim-1),petab_child(nbdim-1) 
-C        
-        do i=pttab_child(nbdim-2),petab_child(nbdim-2)
-C
-          Call Agrif_InterpBase(TypeInterp(3),
-     &           tabtemp(i,j,indmin(nbdim):indmax(nbdim)),
-     &           tabout(i,j,pttab_child(nbdim):petab_child(nbdim)),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
-C
-        enddo 
-C       
-      enddo
-      ENDIF
-C
-      Return
-C        
-C
-      End Subroutine Agrif_Interp_3D_recursive
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_4D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Interp_4D_recursive(TypeInterp,tabin,tabout,
-     &           indmin,indmax,   
-     &           pttab_child,petab_child,
-     &           s_child,s_parent,ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine for the interpolation of a 4D grid variable. 
-CCC   It calls Agrif_Interp_3D_recursive and Agrif_InterpBase.    
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(4) :: TypeInterp
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
-      REAL,INTENT(IN), DIMENSION(indmin(nbdim-3):indmax(nbdim-3),
-     &                indmin(nbdim-2):indmax(nbdim-2),
-     &                indmin(nbdim-1):indmax(nbdim-1),
-     &                indmin(nbdim):indmax(nbdim)) :: tabin        
-      REAL,INTENT(OUT),
-     &       DIMENSION(pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
-C
-C     Local variables      
-      REAL, DIMENSION(pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                 pttab_child(nbdim-1):petab_child(nbdim-1),  
-     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
-      INTEGER i,j,k,l
-      INTEGER :: coeffraf
-C
-C
-      do l = indmin(nbdim),indmax(nbdim)
-C        
-        Call Agrif_Interp_3D_recursive(TypeInterp(1:3),
-     &         tabin(indmin(nbdim-3):indmax(nbdim-3),
-     &               indmin(nbdim-2):indmax(nbdim-2),
-     &               indmin(nbdim-1):indmax(nbdim-1),l),
-     &         tabtemp(pttab_child(nbdim-3):petab_child(nbdim-3),
-     &         pttab_child(nbdim-2):petab_child(nbdim-2),
-     &         pttab_child(nbdim-1):petab_child(nbdim-1),l),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C        
-      enddo
-C
-      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
-      
-      do k = pttab_child(nbdim-1),petab_child(nbdim-1)
-C
-        do j = pttab_child(nbdim-2),petab_child(nbdim-2) 
-C        
-          do i = pttab_child(nbdim-3),petab_child(nbdim-3)
-C
-            Call Agrif_InterpBase(TypeInterp(4),
-     &           tabtemp(i,j,k,indmin(nbdim):indmax(nbdim)),
-     &           tabout(i,j,k,pttab_child(nbdim):petab_child(nbdim)),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
-C
-          enddo
-C
-        enddo 
-C       
-      enddo
-C
-      Return
-C
-C        
-      End Subroutine Agrif_Interp_4D_recursive
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_5D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Interp_5D_recursive(TypeInterp,tabin,tabout,
-     &           indmin,indmax,   
-     &           pttab_child,petab_child,
-     &           s_child,s_parent,ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine for the interpolation of a 5D grid variable. 
-CCC   It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.    
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(5) :: TypeInterp
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
-      REAL,INTENT(IN), DIMENSION(indmin(nbdim-4):indmax(nbdim-4),
-     &                indmin(nbdim-3):indmax(nbdim-3),
-     &                indmin(nbdim-2):indmax(nbdim-2),
-     &                indmin(nbdim-1):indmax(nbdim-1),
-     &                indmin(nbdim):indmax(nbdim)) :: tabin  
-      REAL,INTENT(OUT),
-     &    DIMENSION(pttab_child(nbdim-4):petab_child(nbdim-4),
-     &                pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
-C
-C     Local variables      
-      REAL, DIMENSION(pttab_child(nbdim-4):petab_child(nbdim-4),
-     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                 pttab_child(nbdim-1):petab_child(nbdim-1),    
-     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
-      INTEGER i,j,k,l,m
-      INTEGER :: coeffraf
-C
-C
-      do m = indmin(nbdim),indmax(nbdim)
-C        
-        Call Agrif_Interp_4D_recursive(TypeInterp(1:4),
-     &         tabin(indmin(nbdim-4):indmax(nbdim-4),
-     &               indmin(nbdim-3):indmax(nbdim-3),
-     &               indmin(nbdim-2):indmax(nbdim-2),
-     &               indmin(nbdim-1):indmax(nbdim-1),m),
-     &         tabtemp(pttab_child(nbdim-4):petab_child(nbdim-4),
-     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                 pttab_child(nbdim-1):petab_child(nbdim-1),m),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C        
-      enddo
-      
-      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
-C
-      do l = pttab_child(nbdim-1),petab_child(nbdim-1) 
-C
-        do k = pttab_child(nbdim-2),petab_child(nbdim-2)
-C
-          do j = pttab_child(nbdim-3),petab_child(nbdim-3) 
-C        
-            do i = pttab_child(nbdim-4),petab_child(nbdim-4)
-C
-              Call Agrif_InterpBase(TypeInterp(5),
-     &             tabtemp(i,j,k,l,indmin(nbdim):indmax(nbdim)),
-     &                    tabout(i,j,k,l,
-     &             pttab_child(nbdim):petab_child(nbdim)),
-     &             indmin(nbdim),indmax(nbdim),
-     &             pttab_child(nbdim),petab_child(nbdim),
-     &             s_parent(nbdim),s_child(nbdim),
-     &             ds_parent(nbdim),ds_child(nbdim),coeffraf)
-C
-            enddo
-C
-          enddo
-C
-        enddo 
-C       
-      enddo
-C
-C
-      Return
-C
-C        
-      End Subroutine Agrif_Interp_5D_recursive
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Interp_6D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Interp_6D_recursive(TypeInterp,tabin,tabout,
-     &           indmin,indmax,   
-     &           pttab_child,petab_child,
-     &           s_child,s_parent,ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine for the interpolation of a 6D grid variable. 
-CCC   It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.    
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(6) :: TypeInterp
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
-      REAL,INTENT(IN), DIMENSION(indmin(nbdim-5):indmax(nbdim-5),
-     &                indmin(nbdim-4):indmax(nbdim-4),
-     &                indmin(nbdim-3):indmax(nbdim-3), 
-     &                indmin(nbdim-2):indmax(nbdim-2),
-     &                indmin(nbdim-1):indmax(nbdim-1),
-     &                indmin(nbdim):indmax(nbdim)) :: tabin        
-      REAL,INTENT(OUT),
-     &    DIMENSION(pttab_child(nbdim-5):petab_child(nbdim-5),
-     &                pttab_child(nbdim-4):petab_child(nbdim-4),
-     &                pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                pttab_child(nbdim-1):petab_child(nbdim-1),
-     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
-C
-C     Local variables      
-      REAL, DIMENSION(pttab_child(nbdim-5):petab_child(nbdim-5),
-     &                 pttab_child(nbdim-4):petab_child(nbdim-4),
-     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                 pttab_child(nbdim-2):petab_child(nbdim-2),    
-     &                 pttab_child(nbdim-1):petab_child(nbdim-1),    
-     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
-      INTEGER i,j,k,l,m,n
-      INTEGER :: coeffraf
-C
-C        
-C
-      do n = indmin(nbdim),indmax(nbdim)
-C        
-        Call Agrif_Interp_5D_recursive(TypeInterp(1:5),
-     &         tabin(indmin(nbdim-5):indmax(nbdim-5),
-     &               indmin(nbdim-4):indmax(nbdim-4),
-     &               indmin(nbdim-3):indmax(nbdim-3),
-     &               indmin(nbdim-2):indmax(nbdim-2),
-     &               indmin(nbdim-1):indmax(nbdim-1),n),
-     &         tabtemp(pttab_child(nbdim-5):petab_child(nbdim-5),
-     &                 pttab_child(nbdim-4):petab_child(nbdim-4),
-     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
-     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
-     &                 pttab_child(nbdim-1):petab_child(nbdim-1),n),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C        
-      enddo
-      
-      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
-C
-      do m = pttab_child(nbdim-1),petab_child(nbdim-1) 
-      do l = pttab_child(nbdim-2),petab_child(nbdim-2) 
-C
-        do k = pttab_child(nbdim-3),petab_child(nbdim-3)
-C
-          do j = pttab_child(nbdim-4),petab_child(nbdim-4) 
-C        
-            do i = pttab_child(nbdim-5),petab_child(nbdim-5)
-C
-              Call Agrif_InterpBase(TypeInterp(6),
-     &             tabtemp(i,j,k,l,m,indmin(nbdim):indmax(nbdim)),
-     &                    tabout(i,j,k,l,m,
-     &                    pttab_child(nbdim):petab_child(nbdim)),
-     &             indmin(nbdim),indmax(nbdim),
-     &             pttab_child(nbdim),petab_child(nbdim),
-     &             s_parent(nbdim),s_child(nbdim),
-     &             ds_parent(nbdim),ds_child(nbdim),coeffraf)
-C
-            enddo
-C
-          enddo
-C
-        enddo 
-C       
-      enddo
-      enddo
-C                
-C
-      Return
-C
-C        
-      End Subroutine Agrif_Interp_6D_recursive
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_InterpBase  
-C     **************************************************************************
-C  
-      Subroutine Agrif_InterpBase(TypeInterp,
-     &                           parenttab,childtab,
-     &                           indmin,indmax,pttab_child,petab_child,
-     &                           s_parent,s_child,ds_parent,ds_child,
-     &                           coeffraf)   
-C
-CCC   Description:
-CCC   Subroutine calling the interpolation method chosen by the user (linear, 
-CCC   lagrange or spline). 
-C
-C     Declarations:
-C
-      
-C
-      INTEGER                :: TypeInterp
-      INTEGER :: indmin,indmax
-      INTEGER :: pttab_child,petab_child
-      REAL,INTENT(IN),DIMENSION(indmin:indmax)           :: parenttab       
-      REAL,INTENT(OUT),DIMENSION(pttab_child:petab_child) :: childtab        
-      REAL    :: s_parent,s_child,ds_parent,ds_child 
-      INTEGER :: coeffraf
-C 
-C
-       IF ((indmin == indmax).AND.(pttab_child == petab_child)) THEN
-         childtab(pttab_child) = parenttab(indmin)
-       ELSEIF (TYPEinterp .EQ. AGRIF_LINEAR) then    
-C
-C         Linear interpolation 
-  
-          Call linear1D
-     &         (parenttab,childtab,
-     &          indmax-indmin+1,petab_child-pttab_child+1,
-     &          s_parent,s_child,ds_parent,ds_child)
-C          
-      elseif ( TYPEinterp .EQ. AGRIF_PPM ) then
-
-          Call ppm1D
-     &         (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)
-C
-
-        elseif (TYPEinterp .EQ. AGRIF_LAGRANGE) then
-C          
-C         Lagrange interpolation    
-          Call lagrange1D
-     &        (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)
-C            
-        elseif (TYPEinterp .EQ. AGRIF_ENO) then
-C          
-C         Eno interpolation
-          Call eno1D
-     &         (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)
-C        
-        elseif (TYPEinterp .EQ. AGRIF_WENO) then
-C          
-C         Eno interpolation
-          Call weno1D
-     &         (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)
-C            
-        Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERV) then
-C          
-C         Linear conservative interpolation
-          
-          Call linear1Dconserv
-     &         (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)   
-C              
-        Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERVLIM) then
-C          
-C         Linear conservative interpolation
-          
-          Call linear1Dconservlim
-     &         (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)         
-C              
-        elseif (TYPEinterp .EQ. AGRIF_CONSTANT) then
-C          
-          Call constant1D
-     &         (parenttab,childtab,
-     &         indmax-indmin+1,petab_child-pttab_child+1,
-     &         s_parent,s_child,ds_parent,ds_child)
-C              
-      endif 
-C
-C      
-      End Subroutine Agrif_InterpBase 
-C
-
-      Subroutine Agrif_Compute_nbdim_interp(s_parent,s_child,
-     &  ds_parent,ds_child,coeffraf,locind_child_left)
-      real :: s_parent,s_child,ds_parent,ds_child
-      integer :: coeffraf,locind_child_left
-     
-      coeffraf = nint(ds_parent/ds_child)
-      locind_child_left = 1 + agrif_int((s_child-s_parent)/ds_parent)
-      End Subroutine Agrif_Compute_nbdim_interp
-C          
-
-      Subroutine Agrif_Find_list_interp(list_interp,pttab,petab,
-     &                          pttab_Child,pttab_Parent,nbdim,
-     &                          indmin,indmax,indminglob,
-     &      indmaxglob,indminglob2,indmaxglob2,parentarray,
-     &       pttruetab,cetruetab,member,memberin,
-     &      find_list_interp
-#if defined key_mpp_mpi
-     &     ,tab4t,memberinall,sendtoproc1,recvfromproc1
-#endif
-     &    )     
-      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
-      LOGICAL :: find_list_interp
-      Type(Agrif_List_Interp_loc), Pointer :: parcours
-      INTEGER,DIMENSION(nbdim)   :: indmin,indmax  
-      INTEGER,DIMENSION(nbdim)   :: indminglob,indmaxglob
-      INTEGER,DIMENSION(nbdim)   :: pttruetab,cetruetab      
-      INTEGER,DIMENSION(nbdim)   :: indminglob2,indmaxglob2  
-      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
-      LOGICAL :: member, memberin
-      INTEGER :: i
-#ifdef key_mpp_mpi
-C
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
-#endif 
-                    
-      find_list_interp = .FALSE.
-      
-      parcours => list_interp
-      Find_loop :   Do While (associated(parcours))
-        Do i=1,nbdim
-          IF ((pttab(i) /= parcours%interp_loc%pttab(i)).OR.
-     &        (petab(i) /= parcours%interp_loc%petab(i)).OR.
-     &        (pttab_child(i) /= parcours%interp_loc%pttab_child(i)).OR.
-     &        (pttab_parent(i) /= parcours%interp_loc%pttab_parent(i)))
-     &               THEN
-            parcours=>parcours%suiv
-            Cycle Find_loop
-          ENDIF
-        EndDo
-
-        indmin = parcours%interp_loc%indmin(1:nbdim)
-        indmax = parcours%interp_loc%indmax(1:nbdim)
-        
-        pttruetab = parcours%interp_loc%pttruetab(1:nbdim)
-        cetruetab = parcours%interp_loc%cetruetab(1:nbdim)
-                
-#if !defined key_mpp_mpi
-        indminglob = parcours%interp_loc%indminglob(1:nbdim)
-        indmaxglob = parcours%interp_loc%indmaxglob(1:nbdim)
-#else
-        indminglob2 = parcours%interp_loc%indminglob2(1:nbdim)
-        indmaxglob2 = parcours%interp_loc%indmaxglob2(1:nbdim)
-        parentarray = parcours%interp_loc%parentarray(1:nbdim,:,:)
-        member = parcours%interp_loc%member
-        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
-        memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
-        sendtoproc1 = parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)
-        recvfromproc1 = 
-     &    parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)
-#endif        
-        memberin = parcours%interp_loc%memberin
-        find_list_interp = .TRUE.   
-        Exit Find_loop
-      End Do Find_loop  
-                              
-      End Subroutine Agrif_Find_list_interp   
-      
-      Subroutine Agrif_AddTo_list_interp(list_interp,pttab,petab,
-     &                          pttab_Child,pttab_Parent,indmin,indmax,
-     &                          indminglob,indmaxglob,
-     &                          indminglob2,indmaxglob2,
-     &                          parentarray,pttruetab,cetruetab,
-     &                          member,memberin,nbdim
-#if defined key_mpp_mpi
-     &      ,tab4t,memberinall,sendtoproc1,recvfromproc1
-#endif
-     &    )
-          
-      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
-      INTEGER,DIMENSION(nbdim)   :: indmin,indmax
-      INTEGER,DIMENSION(nbdim)   :: indminglob,indmaxglob
-      INTEGER,DIMENSION(nbdim)   :: indminglob2,indmaxglob2
-      INTEGER,DIMENSION(nbdim)   :: pttruetab,cetruetab
-      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
-      LOGICAL :: member, memberin
-#ifdef key_mpp_mpi
-C
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: recvfromproc1
-#endif                   
-      Type(Agrif_List_Interp_loc), Pointer :: parcours
-            
-       Allocate(parcours)
-      Allocate(parcours%interp_loc)
-      
-      parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
-      parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
-      parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim)
-      parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
-  
-  
-      parcours%interp_loc%indmin(1:nbdim) = indmin(1:nbdim)
-      parcours%interp_loc%indmax(1:nbdim) = indmax(1:nbdim)
-
-      parcours%interp_loc%memberin = memberin
-#if !defined key_mpp_mpi
-      parcours%interp_loc%indminglob(1:nbdim) = indminglob(1:nbdim)
-      parcours%interp_loc%indmaxglob(1:nbdim) = indmaxglob(1:nbdim)
-#else
-      parcours%interp_loc%indminglob2(1:nbdim) = indminglob2(1:nbdim)
-      parcours%interp_loc%indmaxglob2(1:nbdim) = indmaxglob2(1:nbdim)
-      parcours%interp_loc%parentarray(1:nbdim,:,:) 
-     &       = parentarray(1:nbdim,:,:)
-      parcours%interp_loc%member = member
-      Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
-      Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1))
-      Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
-      Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))                  
-      parcours%interp_loc%tab4t=tab4t   
-      parcours%interp_loc%memberinall=memberinall   
-      parcours%interp_loc%sendtoproc1=sendtoproc1
-      parcours%interp_loc%recvfromproc1=recvfromproc1            
-#endif      
-
-      parcours%interp_loc%pttruetab(1:nbdim) = pttruetab(1:nbdim)
-      parcours%interp_loc%cetruetab(1:nbdim) = cetruetab(1:nbdim)
-      
-      parcours%suiv => list_interp
-      
-      list_interp => parcours
-      End Subroutine Agrif_Addto_list_interp 
-                
-      End Module Agrif_Interpolation
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90	(revision 5682)
@@ -0,0 +1,1507 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module to initialize a fine grid from its parent grid, by using a space interpolation
+!
+module Agrif_Interpolation
+!
+    use Agrif_InterpBasic
+    use Agrif_Arrays
+    use Agrif_Mask
+    use Agrif_CurgridFunctions
+#if defined AGRIF_MPI
+    use Agrif_Mpp
+#endif
+!
+    implicit none
+!
+    logical, private:: precomputedone(7) = .FALSE.
+!
+    private :: Agrif_Parentbounds
+    private :: Agrif_Interp_1D_recursive, Agrif_Interp_2D_recursive, Agrif_Interp_3D_recursive
+    private :: Agrif_Interp_4D_recursive, Agrif_Interp_5D_recursive, Agrif_Interp_6D_recursive
+    private :: Agrif_InterpBase
+    private :: Agrif_Find_list_interp, Agrif_AddTo_list_interp
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_InterpVariable
+!
+!> Sets some arguments of subroutine Agrif_InterpnD, n being the dimension of the grid variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpVariable ( parent, child, torestore, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer       :: parent       !< Variable on the parent grid
+    type(Agrif_Variable), pointer       :: child        !< Variable on the child grid
+    logical,              intent(in)    :: torestore    !< .false. indicates that the results of the
+                                                        !! interpolation are applied on the whole current grid
+    procedure()                         :: procname     !< Data recovery procedure
+!---------------------------------------------------------------------------------------------------
+    logical               :: memberin
+    integer               :: nbdim        ! Number of dimensions of the current grid
+    integer, dimension(6) :: type_interp  ! Type of interpolation (linear,spline,...)
+    integer, dimension(6) :: nb_child
+    integer, dimension(6) :: lb_child
+    integer, dimension(6) :: ub_child
+    integer, dimension(6) :: lb_parent
+    real   , dimension(6) :: s_child,   s_parent
+    real   , dimension(6) :: ds_child, ds_parent
+    integer, dimension(child % root_var % nbdim,2,2) :: childarray
+!
+    nbdim       = child % root_var % nbdim
+    type_interp = child % root_var % type_interp
+!
+    call PreProcessToInterpOrUpdate( parent,   child,       &
+                                     nb_child, ub_child,    &
+                                     lb_child, lb_parent,   &
+                                      s_child,  s_parent,   &
+                                     ds_child, ds_parent, nbdim, interp=.true.)
+!
+!   Call to a procedure of interpolation against the number of dimensions of the grid variable
+!
+    call Agrif_InterpnD(type_interp, parent, child, &
+                        lb_child, ub_child,         &
+                        lb_child, lb_parent,        &
+                        s_child,   s_parent,        &
+                        ds_child, ds_parent,        &
+                        child, torestore, nbdim,    &
+                        childarray, memberin,       &
+                        .false., procname, 0, 0)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpVariable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpnD
+!
+!> Interpolates a nD grid variable from its parent grid, by using a space interpolation
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpnD ( type_interp, parent, child, pttab, petab, pttab_Child, pttab_Parent, &
+                            s_Child, s_Parent, ds_Child, ds_Parent, restore, torestore,          &
+                            nbdim, childarray, memberin, in_bc, procname, nb, ndir )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    INTEGER, DIMENSION(6),     INTENT(in)   :: type_interp  !< Type of interpolation !    (linear,...)
+    TYPE(Agrif_Variable),      pointer      :: parent       !< Variable of the parent grid
+    TYPE(Agrif_Variable),      pointer      :: child        !< Variable of the child grid
+    INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab        !< Index of the first point inside the domain
+    INTEGER, DIMENSION(nbdim), INTENT(in)   :: petab        !< Index of the first point inside the domain
+    INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab_Child  !< Index of the first point inside the domain
+                                                            !<    for the child grid variable
+    INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab_Parent !< Index of the first point inside the domain
+                                                            !<    for the parent grid variable
+    REAL,    DIMENSION(nbdim), INTENT(in)   :: s_Child,s_Parent   !< Positions of the parent and child grids
+    REAL,    DIMENSION(nbdim), INTENT(in)   :: ds_Child,ds_Parent !< Space steps of the parent and child grids
+    TYPE(Agrif_Variable),      pointer      :: restore            !< Indicates points where interpolation
+    LOGICAL,                   INTENT(in)   :: torestore          !< Indicates if the array restore is used
+    INTEGER,                   INTENT(in)   :: nbdim
+    LOGICAL,                   INTENT(out)  :: memberin
+    LOGICAL,                   INTENT(in)   :: in_bc              !< .true. if called from Agrif_CorrectVariable \n
+                                                                  !! .false. if called from Agrif_InterpVariable
+    procedure()                             :: procname           !< Data recovery procedure
+    INTEGER,                   INTENT(in)   :: nb, ndir
+!
+    INTEGER                       :: i,j,k,l,m,n
+    INTEGER, DIMENSION(nbdim)     :: pttruetab,cetruetab
+    INTEGER, DIMENSION(nbdim)     :: indmin,     indmax
+    INTEGER, DIMENSION(nbdim)     :: indminglob, indmaxglob
+#if defined AGRIF_MPI
+    INTEGER, DIMENSION(nbdim)     :: indminglob2,indmaxglob2
+#endif
+    LOGICAL, DIMENSION(nbdim)     :: noraftab
+    REAL   , DIMENSION(nbdim)     :: s_Child_temp,s_Parent_temp
+    INTEGER, DIMENSION(nbdim)     :: lowerbound, upperbound, coords
+    INTEGER, DIMENSION(nbdim,2,2), INTENT(OUT) :: childarray
+    INTEGER, DIMENSION(nbdim,2,2)              :: parentarray
+    LOGICAL :: member
+    LOGICAL :: find_list_interp
+!
+#if defined AGRIF_MPI
+!
+    INTEGER, PARAMETER          :: etiquette = 100
+    INTEGER                     :: code, local_proc
+    INTEGER, DIMENSION(nbdim,4)                     :: tab3
+    INTEGER, DIMENSION(nbdim,4,0:Agrif_Nbprocs-1)   :: tab4
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8)   :: tab4t
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1)           :: memberinall
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1)           :: sendtoproc1, recvfromproc1
+    LOGICAL, DIMENSION(1)                           :: memberin1
+    LOGICAL                                         :: memberout
+!
+#endif
+!
+    type(Agrif_Variable), pointer, save :: tempC => NULL()        ! Temporary child grid variable
+    type(Agrif_Variable), pointer, save :: tempP => NULL()        ! Temporary parent grid variable
+    type(Agrif_Variable), pointer, save :: tempPextend => NULL()  ! Temporary parent grid variable
+    type(Agrif_Variable), pointer, save :: parentvalues => NULL()
+!
+    coords = child % root_var % coords
+!
+!   Boundaries of the current grid where interpolation is done
+    find_list_interp =                                              &
+        Agrif_Find_list_interp(                                     &
+            child % list_interp,                                    &
+            pttab, petab, pttab_Child, pttab_Parent, nbdim,         &
+            indmin, indmax, indminglob, indmaxglob,                 &
+            pttruetab, cetruetab, memberin                          &
+#if defined AGRIF_MPI
+           ,indminglob2, indmaxglob2, parentarray,                  &
+            member, tab4t,memberinall,  sendtoproc1, recvfromproc1  &
+#endif
+        )
+!
+    if (.not.find_list_interp) then
+!
+        call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim)
+        call Agrif_Childbounds(nbdim, lowerbound, upperbound,               &
+                               pttab, petab, Agrif_Procrank, coords,        &
+                               pttruetab, cetruetab, memberin)
+        call Agrif_Parentbounds(type_interp,nbdim,indminglob,indmaxglob,    &
+                                s_Parent_temp,s_Child_temp,                 &
+                                s_Child,ds_Child,                           &
+                                s_Parent,ds_Parent,                         &
+                                pttab,petab,                                &
+                                pttab_Child,pttab_Parent,                   &
+                                child%root_var % posvar, coords)
+#if defined AGRIF_MPI
+        if (memberin) then
+            call Agrif_Parentbounds(type_interp,nbdim,indmin,indmax,        &
+                                    s_Parent_temp,s_Child_temp,             &
+                                    s_Child,ds_Child,                       &
+                                    s_Parent,ds_Parent,                     &
+                                    pttruetab,cetruetab,                    &
+                                    pttab_Child,pttab_Parent,               &
+                                    child%root_var % posvar, coords)
+        endif
+
+        local_proc = Agrif_Procrank
+        call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
+        call Agrif_ChildGrid_to_ParentGrid()
+!
+        call Agrif_Childbounds(nbdim,lowerbound,upperbound,                 &
+                               indminglob,indmaxglob, local_proc, coords,   &
+                               indminglob2,indmaxglob2,member)
+!
+        if (member) then
+            call Agrif_GlobalToLocalBounds(parentarray,                     &
+                                           lowerbound,  upperbound,         &
+                                           indminglob2, indmaxglob2, coords,&
+                                           nbdim, local_proc, member)
+        endif
+
+        call Agrif_ParentGrid_to_ChildGrid()
+#else
+        parentarray(:,1,1) = indminglob
+        parentarray(:,2,1) = indmaxglob
+        parentarray(:,1,2) = indminglob
+        parentarray(:,2,2) = indmaxglob
+        indmin = indminglob
+        indmax = indmaxglob
+        member = .TRUE.
+#endif
+
+    else
+
+#if defined AGRIF_MPI
+        s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
+        s_Child_temp  = s_Child + (pttruetab - pttab_Child) * ds_Child
+#else
+        parentarray(:,1,1) = indminglob
+        parentarray(:,2,1) = indmaxglob
+        parentarray(:,1,2) = indminglob
+        parentarray(:,2,2) = indmaxglob
+        indmin = indminglob
+        indmax = indmaxglob
+        member = .TRUE.
+        s_Parent_temp = s_Parent + (indminglob - pttab_Parent) * ds_Parent
+        s_Child_temp  = s_Child + (pttab - pttab_Child) * ds_Child
+#endif
+    endif
+!
+    if (member) then
+        if (.not.associated(tempP)) allocate(tempP)
+!
+        call Agrif_array_allocate(tempP,parentarray(:,1,1),parentarray(:,2,1),nbdim)
+        call Agrif_var_set_array_tozero(tempP,nbdim)
+
+        call Agrif_ChildGrid_to_ParentGrid()
+!
+        select case (nbdim)
+        case(1)
+            call procname(tempP%array1,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),.TRUE.,nb,ndir)
+        case(2)
+            call procname(tempP%array2,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),.TRUE.,nb,ndir)
+        case(3)
+            call procname(tempP%array3,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),    &
+                      parentarray(3,1,2),parentarray(3,2,2),.TRUE.,nb,ndir)
+        case(4)
+            call procname(tempP%array4,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),    &
+                      parentarray(3,1,2),parentarray(3,2,2),    &
+                      parentarray(4,1,2),parentarray(4,2,2),.TRUE.,nb,ndir)
+        case(5)
+            call procname(tempP%array5,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),    &
+                      parentarray(3,1,2),parentarray(3,2,2),    &
+                      parentarray(4,1,2),parentarray(4,2,2),    &
+                      parentarray(5,1,2),parentarray(5,2,2),.TRUE.,nb,ndir)
+        case(6)
+            call procname(tempP%array6,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),    &
+                      parentarray(3,1,2),parentarray(3,2,2),    &
+                      parentarray(4,1,2),parentarray(4,2,2),    &
+                      parentarray(5,1,2),parentarray(5,2,2),    &
+                      parentarray(6,1,2),parentarray(6,2,2),.TRUE.,nb,ndir)
+        end select
+!
+        call Agrif_ParentGrid_to_ChildGrid()
+!
+    endif
+
+#if defined AGRIF_MPI
+    if (.not.find_list_interp) then
+!
+        tab3(:,1) = indminglob2(:)
+        tab3(:,2) = indmaxglob2(:)
+        tab3(:,3) = indmin(:)
+        tab3(:,4) = indmax(:)
+!
+        call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
+
+        if (.not.associated(tempPextend))   allocate(tempPextend)
+
+        do k=0,Agrif_Nbprocs-1
+            do j=1,4
+                do i=1,nbdim
+                    tab4t(i,k,j) = tab4(i,j,k)
+                enddo
+            enddo
+        enddo
+
+        memberin1(1) = memberin
+        call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,1,MPI_LOGICAL,Agrif_mpi_comm,code)
+
+        call Get_External_Data_first(tab4t(:,:,1),tab4t(:,:,2),         &
+                                     tab4t(:,:,3),tab4t(:,:,4),         &
+                                     nbdim,memberinall, coords,         &
+                                     sendtoproc1,recvfromproc1,         &
+                                     tab4t(:,:,5),tab4t(:,:,6),         &
+                                     tab4t(:,:,7),tab4t(:,:,8) )
+    endif
+
+    call ExchangeSameLevel(sendtoproc1,recvfromproc1,nbdim,         &
+            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),    &
+            tab4t(:,:,7),tab4t(:,:,8),memberin,tempP,tempPextend)
+#else
+    tempPextend => tempP
+#endif
+
+    if (.not.find_list_interp) then
+        call Agrif_Addto_list_interp(                           &
+                child%list_interp,pttab,petab,                  &
+                pttab_Child,pttab_Parent,indmin,indmax,         &
+                indminglob,indmaxglob,                          &
+                pttruetab,cetruetab,                            &
+                memberin,nbdim                                  &
+#if defined AGRIF_MPI
+               ,indminglob2,indmaxglob2,                        &
+                parentarray,                                    &
+                member,                                         &
+                tab4t,memberinall,sendtoproc1,recvfromproc1     &
+#endif
+        )
+    endif
+!
+    if (memberin) then
+!
+        if (.not.associated(tempC)) allocate(tempC)
+!
+        call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim)
+!
+!       Special values on the parent grid
+        if (Agrif_UseSpecialValue) then
+!
+            noraftab(1:nbdim) = child % root_var % interptab(1:nbdim) == 'N'
+!
+            if (.not.associated(parentvalues))  allocate(parentvalues)
+!
+            call Agrif_array_allocate(parentvalues,indmin,indmax,nbdim)
+            call Agrif_var_full_copy_array(parentvalues,tempPextend,nbdim)
+!
+            call Agrif_CheckMasknD(tempPextend,parentvalues,    &
+                    indmin(1:nbdim),indmax(1:nbdim),            &
+                    indmin(1:nbdim),indmax(1:nbdim),            &
+                    noraftab(1:nbdim),nbdim)
+!
+            call Agrif_array_deallocate(parentvalues,nbdim)
+!
+        endif
+!
+!       Interpolation of the current grid
+!
+        if ( memberin ) then
+            select case(nbdim)
+            case(1)
+                call Agrif_Interp_1D_recursive( type_interp(1),                         &
+                                                tempPextend%array1,                     &
+                                                tempC%array1,                           &
+                                                indmin(1), indmax(1),                   &
+                                                pttruetab(1),    cetruetab(1),          &
+                                                s_Child_temp(1), s_Parent_temp(1),      &
+                                                ds_Child(1),     ds_Parent(1) )
+            case(2)
+                call Agrif_Interp_2D_recursive( type_interp(1:2),                       &
+                                                tempPextend % array2,                   &
+                                                tempC       % array2,                   &
+                                                indmin(1:2), indmax(1:2),               &
+                                                pttruetab(1:2),    cetruetab(1:2),      &
+                                                s_Child_temp(1:2), s_Parent_temp(1:2),  &
+                                                ds_Child(1:2),    ds_Parent(1:2) )
+            case(3)
+                call Agrif_Interp_3D_recursive( type_interp(1:3),                       &
+                                                tempPextend % array3,                   &
+                                                tempC       % array3,                   &
+                                                indmin(1:3), indmax(1:3),               &
+                                                pttruetab(1:3),    cetruetab(1:3),      &
+                                                s_Child_temp(1:3), s_Parent_temp(1:3),  &
+                                                ds_Child(1:3),    ds_Parent(1:3) )
+            case(4)
+                call Agrif_Interp_4D_recursive( type_interp(1:4),                       &
+                                                tempPextend % array4,                   &
+                                                tempC       % array4,                   &
+                                                indmin(1:4), indmax(1:4),               &
+                                                pttruetab(1:4),    cetruetab(1:4),      &
+                                                s_Child_temp(1:4), s_Parent_temp(1:4),  &
+                                                ds_Child(1:4),    ds_Parent(1:4) )
+            case(5)
+                call Agrif_Interp_5D_recursive( type_interp(1:5),                       &
+                                                tempPextend % array5,                   &
+                                                tempC       % array5,                   &
+                                                indmin(1:5), indmax(1:5),               &
+                                                pttruetab(1:5),    cetruetab(1:5),      &
+                                                s_Child_temp(1:5), s_Parent_temp(1:5),  &
+                                                ds_Child(1:5),    ds_Parent(1:5) )
+            case(6)
+                call Agrif_Interp_6D_recursive( type_interp(1:6),                       &
+                                                tempPextend % array6,                   &
+                                                tempC       % array6,                   &
+                                                indmin(1:6), indmax(1:6),               &
+                                                pttruetab(1:6),    cetruetab(1:6),      &
+                                                s_Child_temp(1:6), s_Parent_temp(1:6),  &
+                                                ds_Child(1:6),    ds_Parent(1:6) )
+            end select
+!
+            call Agrif_get_var_bounds_array(child,lowerbound,upperbound,nbdim)
+
+#if defined AGRIF_MPI
+            call Agrif_GlobalToLocalBounds(childarray, lowerbound, upperbound,  &
+                                            pttruetab, cetruetab, coords,       &
+                                            nbdim, Agrif_Procrank, memberout)
+#else
+            childarray(:,1,1) = pttruetab
+            childarray(:,2,1) = cetruetab
+            childarray(:,1,2) = pttruetab
+            childarray(:,2,2) = cetruetab
+!cccccccccccccc       memberout = .TRUE.
+#endif
+!
+!           Special values on the child grid
+            if (Agrif_UseSpecialValueFineGrid) then
+                call GiveAgrif_SpecialValueToTab_mpi( child, tempC, childarray, Agrif_SpecialValueFineGrid,nbdim )
+            endif
+!
+        endif   ! ( memberin )
+!
+        if (torestore) then
+!
+#if defined AGRIF_MPI
+!
+            SELECT CASE (nbdim)
+            CASE (1)
+                do i = pttruetab(1),cetruetab(1)
+!hildarrayAModifier     if (restore%restore1D(i) == 0)      &
+!hildarrayAModifier         child%array1(childarray(i,1,2)) = tempC%array1(i)
+                enddo
+            CASE (2)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+!hildarrayAModifier     if (restore%restore2D(i,j) == 0)    &
+!hildarrayAModifier         child%array2(childarray(i,1,2), &
+!hildarrayAModifier                          childarray(j,2,2)) = tempC%array2(i,j)
+                enddo
+                enddo
+            CASE (3)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+                do k = pttruetab(3),cetruetab(3)
+!hildarrayAModifier     if (restore%restore3D(i,j,k) == 0)  &
+!hildarrayAModifier         child%array3(childarray(i,1,2), &
+!hildarrayAModifier                          childarray(j,2,2), &
+!hildarrayAModifier                          childarray(k,3,2)) = tempC%array3(i,j,k)
+                enddo
+                enddo
+                enddo
+            CASE (4)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+                do k = pttruetab(3),cetruetab(3)
+                do l = pttruetab(4),cetruetab(4)
+!hildarrayAModifier     if (restore%restore4D(i,j,k,l) == 0)    &
+!hildarrayAModifier         child%array4(childarray(i,1,2),     &
+!hildarrayAModifier                          childarray(j,2,2),     &
+!hildarrayAModifier                          childarray(k,3,2),     &
+!hildarrayAModifier                          childarray(l,4,2)) = tempC%array4(i,j,k,l)
+                enddo
+                enddo
+                enddo
+                enddo
+            CASE (5)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+                do k = pttruetab(3),cetruetab(3)
+                do l = pttruetab(4),cetruetab(4)
+                do m = pttruetab(5),cetruetab(5)
+!hildarrayAModifier     if (restore%restore5D(i,j,k,l,m) == 0)  &
+!hildarrayAModifier         child%array5(childarray(i,1,2),     &
+!hildarrayAModifier                          childarray(j,2,2),     &
+!hildarrayAModifier                          childarray(k,3,2),     &
+!hildarrayAModifier                          childarray(l,4,2),     &
+!hildarrayAModifier                          childarray(m,5,2)) = tempC%array5(i,j,k,l,m)
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+            CASE (6)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+                do k = pttruetab(3),cetruetab(3)
+                do l = pttruetab(4),cetruetab(4)
+                do m = pttruetab(5),cetruetab(5)
+                do n = pttruetab(6),cetruetab(6)
+!hildarrayAModifier     if (restore%restore6D(i,j,k,l,m,n) == 0)    &
+!hildarrayAModifier         child%array6(childarray(i,1,2),         &
+!hildarrayAModifier                          childarray(j,2,2),         &
+!hildarrayAModifier                          childarray(k,3,2),         &
+!hildarrayAModifier                          childarray(l,4,2),         &
+!hildarrayAModifier                          childarray(m,5,2),         &
+!hildarrayAModifier                          childarray(n,6,2)) = tempC%array6(i,j,k,l,m,n)
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+            END SELECT
+!
+#else
+            select case (nbdim)
+            case (1)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore1D(i) == 0)          &
+                        parray1(i) = tempC % array1(i)
+                enddo
+            case (2)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore2D(i,j) == 0)        &
+                        parray2(i,j) = tempC % array2(i,j)
+                enddo
+                enddo
+            case (3)
+                do k = pttruetab(3),cetruetab(3)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore3D(i,j,k) == 0)      &
+                        parray3(i,j,k) = tempC % array3(i,j,k)
+                enddo
+                enddo
+                enddo
+            case (4)
+                do l = pttruetab(4),cetruetab(4)
+                do k = pttruetab(3),cetruetab(3)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore4D(i,j,k,l) == 0)    &
+                        parray4(i,j,k,l) = tempC % array4(i,j,k,l)
+                enddo
+                enddo
+                enddo
+                enddo
+            case (5)
+                do m = pttruetab(5),cetruetab(5)
+                do l = pttruetab(4),cetruetab(4)
+                do k = pttruetab(3),cetruetab(3)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore5D(i,j,k,l,m) == 0)  &
+                        parray5(i,j,k,l,m) = tempC % array5(i,j,k,l,m)
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+            case (6)
+                do n = pttruetab(6),cetruetab(6)
+                do m = pttruetab(5),cetruetab(5)
+                do l = pttruetab(4),cetruetab(4)
+                do k = pttruetab(3),cetruetab(3)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore6D(i,j,k,l,m,n) == 0)    &
+                        parray6(i,j,k,l,m,n) = tempC % array6(i,j,k,l,m,n)
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+            end select
+!
+#endif
+!
+        else    ! .not.to_restore
+!
+            if (memberin) then
+    !
+                if ( .not.in_bc ) then
+                    select case(nbdim)
+                    case(1)
+                        call procname(tempC % array1(            &
+                                childarray(1,1,1):childarray(1,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),.FALSE.,nb,ndir)
+                    case(2)
+                        call procname(                                &
+                                tempC % array2(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),.FALSE.,nb,ndir)
+                    case(3)
+                        call procname(                                &
+                                tempC % array3(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1),  &
+                                childarray(3,1,1):childarray(3,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),  &
+                                childarray(3,1,2),childarray(3,2,2),.FALSE.,nb,ndir)
+                    case(4)
+                        call procname(                                &
+                                tempC % array4(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1),  &
+                                childarray(3,1,1):childarray(3,2,1),  &
+                                childarray(4,1,1):childarray(4,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),  &
+                                childarray(3,1,2),childarray(3,2,2),  &
+                                childarray(4,1,2),childarray(4,2,2),.FALSE.,nb,ndir)
+                    case(5)
+                        call procname(                                &
+                                tempC % array5(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1),  &
+                                childarray(3,1,1):childarray(3,2,1),  &
+                                childarray(4,1,1):childarray(4,2,1),  &
+                                childarray(5,1,1):childarray(5,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),  &
+                                childarray(3,1,2),childarray(3,2,2),  &
+                                childarray(4,1,2),childarray(4,2,2),  &
+                                childarray(5,1,2),childarray(5,2,2),.FALSE.,nb,ndir)
+                    case(6)
+                        call procname(                                &
+                                tempC % array6(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1),  &
+                                childarray(3,1,1):childarray(3,2,1),  &
+                                childarray(4,1,1):childarray(4,2,1),  &
+                                childarray(5,1,1):childarray(5,2,1),  &
+                                childarray(6,1,1):childarray(6,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),  &
+                                childarray(3,1,2),childarray(3,2,2),  &
+                                childarray(4,1,2),childarray(4,2,2),  &
+                                childarray(5,1,2),childarray(5,2,2),  &
+                                childarray(6,1,2),childarray(6,2,2),.FALSE.,nb,ndir)
+                    end select
+                else    ! we are in_bc
+                    select case (nbdim)
+                    case (1)
+                        parray1(childarray(1,1,2):childarray(1,2,2)) =    &
+                         tempC%array1(childarray(1,1,1):childarray(1,2,1))
+                    case (2)
+                        parray2(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2)) =    &
+                         tempC%array2(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1))
+                    case (3)
+                        parray3(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2),      &
+                                      childarray(3,1,2):childarray(3,2,2)) =    &
+                         tempC%array3(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1),      &
+                                      childarray(3,1,1):childarray(3,2,1))
+                    case (4)
+                        parray4(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2),      &
+                                      childarray(3,1,2):childarray(3,2,2),      &
+                                      childarray(4,1,2):childarray(4,2,2)) =    &
+                         tempC%array4(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1),      &
+                                      childarray(3,1,1):childarray(3,2,1),      &
+                                      childarray(4,1,1):childarray(4,2,1))
+                    case (5)
+                        parray5(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2),      &
+                                      childarray(3,1,2):childarray(3,2,2),      &
+                                      childarray(4,1,2):childarray(4,2,2),      &
+                                      childarray(5,1,2):childarray(5,2,2)) =    &
+                         tempC%array5(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1),      &
+                                      childarray(3,1,1):childarray(3,2,1),      &
+                                      childarray(4,1,1):childarray(4,2,1),      &
+                                      childarray(5,1,1):childarray(5,2,1))
+                    case (6)
+                        parray6(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2),      &
+                                      childarray(3,1,2):childarray(3,2,2),      &
+                                      childarray(4,1,2):childarray(4,2,2),      &
+                                      childarray(5,1,2):childarray(5,2,2),      &
+                                      childarray(6,1,2):childarray(6,2,2)) =    &
+                         tempC%array6(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1),      &
+                                      childarray(3,1,1):childarray(3,2,1),      &
+                                      childarray(4,1,1):childarray(4,2,1),      &
+                                      childarray(5,1,1):childarray(5,2,1),      &
+                                      childarray(6,1,1):childarray(6,2,1))
+                    end select
+                endif  ! < (.not.in_bc)
+            endif  ! < memberin
+!
+        endif
+
+        call Agrif_array_deallocate(tempPextend,nbdim)
+        call Agrif_array_deallocate(tempC,nbdim)
+
+    endif
+!
+!   Deallocations
+#if defined AGRIF_MPI
+    if (member) then
+        call Agrif_array_deallocate(tempP,nbdim)
+    endif
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpnD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Parentbounds
+!
+!> Calculates the bounds of the parent grid for the interpolation of the child grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Parentbounds ( type_interp, nbdim, indmin, indmax, &
+                                s_Parent_temp, s_Child_temp,        &
+                                s_Child, ds_Child,                  &
+                                s_Parent,ds_Parent,                 &
+                                pttruetab, cetruetab,               &
+                                pttab_Child, pttab_Parent, posvar, coords )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, DIMENSION(6),     intent(in)  :: type_interp
+    INTEGER,                   intent(in)  :: nbdim
+    INTEGER, DIMENSION(nbdim), intent(out) :: indmin, indmax
+    REAL,    DIMENSION(nbdim), intent(out) :: s_Parent_temp, s_child_temp
+    REAL,    DIMENSION(nbdim), intent(in)  :: s_Child, ds_child
+    REAL,    DIMENSION(nbdim), intent(in)  :: s_Parent,ds_Parent
+    INTEGER, DIMENSION(nbdim), intent(in)  :: pttruetab, cetruetab
+    INTEGER, DIMENSION(nbdim), intent(in)  :: pttab_Child, pttab_Parent
+    INTEGER, DIMENSION(nbdim), intent(in)  :: posvar
+    INTEGER, DIMENSION(nbdim), intent(in)  :: coords
+!
+    INTEGER :: i
+    REAL,DIMENSION(nbdim) :: dim_newmin, dim_newmax
+!
+    dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child
+    dim_newmax = s_Child + (cetruetab - pttab_Child) * ds_Child
+!
+    do i = 1,nbdim
+!
+        indmin(i) = pttab_Parent(i) + agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
+        indmax(i) = pttab_Parent(i) + agrif_ceiling((dim_newmax(i)-s_Parent(i))/ds_Parent(i))
+!
+!       Necessary for the Quadratic interpolation
+!
+        if ( (pttruetab(i) == cetruetab(i)) .and. (posvar(i) == 1) ) then
+        elseif ( coords(i) == 0 ) then  ! (interptab == 'N')
+        elseif ( (type_interp(i) == Agrif_ppm)     .or.     &
+                 (type_interp(i) == Agrif_eno)     .or.     &
+                 (type_interp(i) == Agrif_ppm_lim) .or.     &
+                 (type_interp(i) == Agrif_weno) ) then
+            indmin(i) = indmin(i) - 2
+            indmax(i) = indmax(i) + 2
+        elseif ( (type_interp(i) /= Agrif_constant) .and.   &
+                 (type_interp(i) /= Agrif_linear) ) then
+            indmin(i) = indmin(i) - 1
+            indmax(i) = indmax(i) + 1
+        endif
+!
+    enddo
+!
+    s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
+    s_Child_temp  = s_Child + (pttruetab - pttab_Child) * ds_Child
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Parentbounds
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_1D_Recursive
+!
+!> Subroutine for the interpolation of a 1D grid variable.
+!> It calls Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_1D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer,            intent(in)  :: type_interp
+    integer,            intent(in)  :: indmin, indmax
+    integer,            intent(in)  :: pttab_child, petab_child
+    real,               intent(in)  :: s_child, s_parent
+    real,               intent(in)  :: ds_child, ds_parent
+    real, dimension(            &
+        indmin:indmax           &
+    ),                  intent(in)  :: tabin
+    real, dimension(            &
+        pttab_child:petab_child &
+    ),                  intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    call Agrif_InterpBase(type_interp,                      &
+                          tabin(indmin:indmax),             &
+                          tabout(pttab_child:petab_child),  &
+                          indmin, indmax,                   &
+                          pttab_child, petab_child,         &
+                          s_parent,    s_child,             &
+                         ds_parent,   ds_child)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_1D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_2D_Recursive
+!
+!> Subroutine for the interpolation of a 2D grid variable.
+!> It calls Agrif_Interp_1D_recursive and Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_2D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(2),              intent(in)  :: type_interp
+    integer, dimension(2),              intent(in)  :: indmin, indmax
+    integer, dimension(2),              intent(in)  :: pttab_child, petab_child
+    real,    dimension(2),              intent(in)  :: s_child, s_parent
+    real,    dimension(2),              intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2)),           intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2)), intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        indmin(2):indmax(2))            :: tabtemp
+    real, dimension(                    &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(1):petab_child(1))  :: tabout_trsp
+    real, dimension(                    &
+        indmin(2):indmax(2),            &
+        pttab_child(1):petab_child(1))  :: tabtemp_trsp
+    integer                             :: i, j, coeffraf
+!---------------------------------------------------------------------------------------------------
+!
+    coeffraf = nint ( ds_parent(1) / ds_child(1) )
+!
+    if ((type_interp(1) == Agrif_Linear) .and. (coeffraf /= 1)) then
+!---CDIR NEXPAND
+        if(.NOT. precomputedone(1))     &
+            call Linear1dPrecompute2d(                  &
+                    indmax(2)-indmin(2)+1,              &
+                    indmax(1)-indmin(1)+1,              &
+                    petab_child(1)-pttab_child(1)+1,    &
+                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+        call Linear1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1)
+!
+    elseif ((type_interp(1) == Agrif_PPM) .and. (coeffraf /= 1)) then
+!---CDIR NEXPAND
+        if(.NOT. precomputedone(1))     &
+            call PPM1dPrecompute2d(                     &
+                    indmax(2)-indmin(2)+1,              &
+                    indmax(1)-indmin(1)+1,              &
+                    petab_child(1)-pttab_child(1)+1,        &
+                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+        call PPM1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1)
+    else
+        do j = indmin(2),indmax(2)
+!
+!---CDIR NEXPAND
+            call Agrif_Interp_1D_recursive(type_interp(1),                  &
+                    tabin(indmin(1):indmax(1),j),               &
+                    tabtemp(pttab_child(1):petab_child(1),j),   &
+                    indmin(1),indmax(1),                    &
+                    pttab_child(1),petab_child(1),          &
+                    s_child(1), s_parent(1),                &
+                    ds_child(1),ds_parent(1))
+!
+        enddo
+    endif
+
+    coeffraf = nint(ds_parent(2)/ds_child(2))
+    tabtemp_trsp = TRANSPOSE(tabtemp)
+
+    if ((type_interp(2) == Agrif_Linear) .and. (coeffraf /= 1)) then
+!---CDIR NEXPAND
+        if(.NOT. precomputedone(2))     &
+            call Linear1dPrecompute2d(                  &
+                    petab_child(1)-pttab_child(1)+1,    &
+                    indmax(2)-indmin(2)+1,              &
+                    petab_child(2)-pttab_child(2)+1,    &
+                    s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+        call Linear1dAfterCompute(tabtemp_trsp,tabout_trsp, &
+                size(tabtemp_trsp),size(tabout_trsp),2)
+
+    elseif ((type_interp(2) == Agrif_PPM) .and. (coeffraf /= 1)) then
+!---CDIR NEXPAND
+        if(.NOT. precomputedone(2))     &
+            call PPM1dPrecompute2d(                     &
+                    petab_child(1)-pttab_child(1)+1,    &
+                    indmax(2)-indmin(2)+1,              &
+                    petab_child(2)-pttab_child(2)+1,    &
+                    s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+        call PPM1dAfterCompute(tabtemp_trsp, tabout_trsp,    &
+                               size(tabtemp_trsp), size(tabout_trsp), 2)
+    else
+        do i = pttab_child(1), petab_child(1)
+!
+!---CDIR NEXPAND
+            call Agrif_InterpBase(type_interp(2),                                   &
+                                  tabtemp_trsp(indmin(2):indmax(2), i),             &
+                                  tabout_trsp(pttab_child(2):petab_child(2), i),    &
+                                  indmin(2), indmax(2),                             &
+                                  pttab_child(2), petab_child(2),                   &
+                                  s_parent(2),    s_child(2),                       &
+                                 ds_parent(2),   ds_child(2) )
+        enddo
+    endif
+!
+    tabout = TRANSPOSE(tabout_trsp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_2D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_3D_Recursive
+!
+!> Subroutine for the interpolation of a 3D grid variable.
+!> It calls #Agrif_Interp_2D_recursive and #Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_3D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(3),              intent(in)  :: type_interp
+    integer, dimension(3),              intent(in)  :: indmin, indmax
+    integer, dimension(3),              intent(in)  :: pttab_child, petab_child
+    real,    dimension(3),              intent(in)  :: s_child, s_parent
+    real,    dimension(3),              intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2),            &
+        indmin(3):indmax(3)),           intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3)), intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        indmin(3):indmax(3))            :: tabtemp
+    integer                             :: i, j, k, coeffraf
+    integer                             :: locind_child_left, kdeb
+!
+    coeffraf = nint ( ds_parent(1) / ds_child(1) )
+    if ( (type_interp(1) == Agrif_Linear) .and. (coeffraf/=1) ) then
+        call Linear1dPrecompute2d(indmax(2)-indmin(2)+1,            &
+                                  indmax(1)-indmin(1)+1,            &
+                                  petab_child(1)-pttab_child(1)+1,  &
+                                  s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+        precomputedone(1) = .TRUE.
+    elseif ( (type_interp(1) == Agrif_PPM) .and. (coeffraf/=1) ) then
+        call PPM1dPrecompute2d(indmax(2)-indmin(2)+1,           &
+                               indmax(1)-indmin(1)+1,           &
+                               petab_child(1)-pttab_child(1)+1, &
+                               s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+        precomputedone(1) = .TRUE.
+    endif
+
+    coeffraf = nint ( ds_parent(2) / ds_child(2) )
+    if ( (type_interp(2) == Agrif_Linear) .and. (coeffraf/=1) ) then
+        call Linear1dPrecompute2d(petab_child(1)-pttab_child(1)+1,  &
+                                  indmax(2)-indmin(2)+1,            &
+                                  petab_child(2)-pttab_child(2)+1,  &
+                                  s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+        precomputedone(2) = .TRUE.
+    elseif ( (type_interp(2) == Agrif_PPM) .and. (coeffraf/=1) ) then
+        call PPM1dPrecompute2d(petab_child(1)-pttab_child(1)+1, &
+                               indmax(2)-indmin(2)+1,           &
+                               petab_child(2)-pttab_child(2)+1, &
+                               s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+        precomputedone(2) = .TRUE.
+    endif
+!
+    do k = indmin(3), indmax(3)
+        call Agrif_Interp_2D_recursive(type_interp(1:2),                            &
+                                       tabin(indmin(1):indmax(1),                   &
+                                             indmin(2):indmax(2), k),               &
+                                       tabtemp(pttab_child(1):petab_child(1),       &
+                                               pttab_child(2):petab_child(2), k),   &
+                                       indmin(1:2), indmax(1:2),                    &
+                                       pttab_child(1:2), petab_child(1:2),          &
+                                       s_child(1:2),     s_parent(1:2),             &
+                                       ds_child(1:2),   ds_parent(1:2) )
+    enddo
+!
+    precomputedone(1) = .FALSE.
+    precomputedone(2) = .FALSE.
+    coeffraf = nint(ds_parent(3)/ds_child(3))
+!
+    if ( coeffraf == 1 ) then
+        locind_child_left = 1 + agrif_int((s_child(3)-s_parent(3))/ds_parent(3))
+        kdeb = indmin(3)+locind_child_left-2
+        do k = pttab_child(3),petab_child(3)
+            kdeb = kdeb + 1
+            do j = pttab_child(2), petab_child(2)
+            do i = pttab_child(1), petab_child(1)
+                tabout(i,j,k) = tabtemp(i,j,kdeb)
+            enddo
+            enddo
+        enddo
+    else
+        do j = pttab_child(2), petab_child(2)
+        do i = pttab_child(1), petab_child(1)
+            call Agrif_InterpBase(type_interp(3),                                   &
+                                  tabtemp(i,j,indmin(3):indmax(3)),                 &
+                                  tabout(i,j,pttab_child(3):petab_child(3)),        &
+                                  indmin(3), indmax(3),                             &
+                                  pttab_child(3), petab_child(3),                   &
+                                  s_parent(3),    s_child(3),                       &
+                                 ds_parent(3),   ds_child(3) )
+        enddo
+        enddo
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_3D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_4D_Recursive
+!
+!> Subroutine for the interpolation of a 4D grid variable.
+!> It calls #Agrif_Interp_3D_recursive and #Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_4D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(4),              intent(in)  :: type_interp
+    integer, dimension(4),              intent(in)  :: indmin, indmax
+    integer, dimension(4),              intent(in)  :: pttab_child, petab_child
+    real,    dimension(4),              intent(in)  :: s_child, s_parent
+    real,    dimension(4),              intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2),            &
+        indmin(3):indmax(3),            &
+        indmin(4):indmax(4)),           intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4)), intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        indmin(4):indmax(4))            :: tabtemp
+    integer                             :: i, j, k, l
+!
+    do l = indmin(4), indmax(4)
+        call Agrif_Interp_3D_recursive(type_interp(1:3),                            &
+                                       tabin(indmin(1):indmax(1),                   &
+                                             indmin(2):indmax(2),                   &
+                                             indmin(3):indmax(3), l),               &
+                                       tabtemp(pttab_child(1):petab_child(1),       &
+                                               pttab_child(2):petab_child(2),       &
+                                               pttab_child(3):petab_child(3), l),   &
+                                       indmin(1:3), indmax(1:3),                    &
+                                       pttab_child(1:3), petab_child(1:3),          &
+                                       s_child(1:3),    s_parent(1:3),              &
+                                       ds_child(1:3),  ds_parent(1:3) )
+    enddo
+!
+    do k = pttab_child(3), petab_child(3)
+    do j = pttab_child(2), petab_child(2)
+    do i = pttab_child(1), petab_child(1)
+        call Agrif_InterpBase(type_interp(4),                                       &
+                              tabtemp(i,j,k,indmin(4):indmax(4)),                   &
+                              tabout(i,j,k,pttab_child(4):petab_child(4)),          &
+                              indmin(4), indmax(4),                                 &
+                              pttab_child(4), petab_child(4),                       &
+                              s_parent(4),    s_child(4),                           &
+                             ds_parent(4),   ds_child(4) )
+    enddo
+    enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_4D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_5D_Recursive
+!
+!> Subroutine for the interpolation of a 5D grid variable.
+!> It calls #Agrif_Interp_4D_recursive and #Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_5D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(5),              intent(in)  :: type_interp
+    integer, dimension(5),              intent(in)  :: indmin, indmax
+    integer, dimension(5),              intent(in)  :: pttab_child, petab_child
+    real,    dimension(5),              intent(in)  :: s_child, s_parent
+    real,    dimension(5),              intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2),            &
+        indmin(3):indmax(3),            &
+        indmin(4):indmax(4),            &
+        indmin(5):indmax(5)),           intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4),  &
+        pttab_child(5):petab_child(5)), intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4),  &
+        indmin(5):indmax(5))            :: tabtemp
+    integer                             :: i, j, k, l, m
+!
+    do m = indmin(5), indmax(5)
+        call Agrif_Interp_4D_recursive(type_interp(1:4),                            &
+                                       tabin(indmin(1):indmax(1),                   &
+                                             indmin(2):indmax(2),                   &
+                                             indmin(3):indmax(3),                   &
+                                             indmin(4):indmax(4),m),                &
+                                       tabtemp(pttab_child(1):petab_child(1),       &
+                                               pttab_child(2):petab_child(2),       &
+                                               pttab_child(3):petab_child(3),       &
+                                               pttab_child(4):petab_child(4), m),   &
+                                       indmin(1:4),indmax(1:4),                     &
+                                       pttab_child(1:4), petab_child(1:4),          &
+                                       s_child(1:4),     s_parent(1:4),             &
+                                       ds_child(1:4),   ds_parent(1:4) )
+    enddo
+!
+    do l = pttab_child(4), petab_child(4)
+    do k = pttab_child(3), petab_child(3)
+    do j = pttab_child(2), petab_child(2)
+    do i = pttab_child(1), petab_child(1)
+        call Agrif_InterpBase(type_interp(5),                                       &
+                              tabtemp(i,j,k,l,indmin(5):indmax(5)),                 &
+                              tabout(i,j,k,l,pttab_child(5):petab_child(5)),        &
+                              indmin(5), indmax(5),                                 &
+                              pttab_child(5), petab_child(5),                       &
+                              s_parent(5),   s_child(5),                            &
+                              ds_parent(5), ds_child(5) )
+    enddo
+    enddo
+    enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_5D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_6D_Recursive
+!
+!> Subroutine for the interpolation of a 6D grid variable.
+!> It calls #Agrif_Interp_5D_recursive and Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_6D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(6),                  intent(in)  :: type_interp
+    integer, dimension(6),                  intent(in)  :: indmin, indmax
+    integer, dimension(6),                  intent(in)  :: pttab_child, petab_child
+    real,    dimension(6),                  intent(in)  :: s_child, s_parent
+    real,    dimension(6),                  intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2),            &
+        indmin(3):indmax(3),            &
+        indmin(4):indmax(4),            &
+        indmin(5):indmax(5),            &
+        indmin(6):indmax(6)),               intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4),  &
+        pttab_child(5):petab_child(5),  &
+        pttab_child(6):petab_child(6)),     intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4),  &
+        pttab_child(5):petab_child(5),  &
+        indmin(6):indmax(6))            :: tabtemp
+    integer                             :: i, j, k, l, m, n
+!
+    do n = indmin(6), indmax(6)
+        call Agrif_Interp_5D_recursive(type_interp(1:5),                            &
+                                       tabin(indmin(1):indmax(1),                   &
+                                             indmin(2):indmax(2),                   &
+                                             indmin(3):indmax(3),                   &
+                                             indmin(4):indmax(4),                   &
+                                             indmin(5):indmax(5), n),               &
+                                        tabtemp(pttab_child(1):petab_child(1),      &
+                                                pttab_child(2):petab_child(2),      &
+                                                pttab_child(3):petab_child(3),      &
+                                                pttab_child(4):petab_child(4),      &
+                                                pttab_child(5):petab_child(5), n),  &
+                                        indmin(1:5),indmax(1:5),                    &
+                                        pttab_child(1:5), petab_child(1:5),         &
+                                        s_child(1:5), s_parent(1:5),                &
+                                        ds_child(1:5),ds_parent(1:5) )
+    enddo
+!
+    do m = pttab_child(5), petab_child(5)
+    do l = pttab_child(4), petab_child(4)
+    do k = pttab_child(3), petab_child(3)
+    do j = pttab_child(2), petab_child(2)
+    do i = pttab_child(1), petab_child(1)
+        call Agrif_InterpBase(type_interp(6),                                       &
+                              tabtemp(i,j,k,l,m,indmin(6):indmax(6)),               &
+                              tabout(i,j,k,l,m,pttab_child(6):petab_child(6)),      &
+                              indmin(6), indmax(6),                                 &
+                              pttab_child(6), petab_child(6),                       &
+                              s_parent(6),   s_child(6),                            &
+                              ds_parent(6), ds_child(6) )
+    enddo
+    enddo
+    enddo
+    enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_6D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpBase
+!
+!> Calls the interpolation method chosen by the user (linear, lagrange, spline, etc.).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpBase ( type_interp, parenttab, childtab, indmin, indmax, &
+                              pttab_child, petab_child,                         &
+                              s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    INTEGER                                                 :: type_interp
+    INTEGER                                                 :: indmin, indmax
+    INTEGER                                                 :: pttab_child, petab_child
+    REAL, DIMENSION(indmin:indmax),           INTENT(IN)    :: parenttab
+    REAL, DIMENSION(pttab_child:petab_child), INTENT(OUT)   :: childtab
+    REAL                                                    :: s_parent, s_child
+    REAL                                                    :: ds_parent,ds_child
+!
+    if ( (indmin == indmax) .and. (pttab_child == petab_child) ) then
+!
+        childtab(pttab_child) = parenttab(indmin)
+!
+    elseif (type_interp == Agrif_LINEAR) then    !       Linear interpolation
+!
+        call Agrif_basicinterp_linear1D(parenttab,childtab,                   &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif ( type_interp == Agrif_PPM ) then     !       PPM interpolation
+
+        call PPM1d(parenttab,childtab,                      &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif ( type_interp == Agrif_PPM_LIM ) then     !       PPM interpolation
+
+        call PPM1d_lim(parenttab,childtab,                      &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_LAGRANGE) then  !       Lagrange interpolation
+!
+        call lagrange1D(parenttab,childtab,                 &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_ENO) then       !       Eno interpolation
+!
+        call ENO1d(parenttab,childtab,                      &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_WENO) then      !       Weno interpolation
+!
+        call WENO1d(parenttab,childtab,                     &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_LINEARCONSERV) then !   Linear conservative interpolation
+!
+        call Linear1dConserv(parenttab,childtab,            &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_LINEARCONSERVLIM) then !Linear conservative interpolation
+!
+        call Linear1dConservLim(parenttab,childtab,         &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_CONSTANT) then
+!
+        call Constant1d(parenttab,childtab,                 &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpBase
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Find_list_interp
+!---------------------------------------------------------------------------------------------------
+function Agrif_Find_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent,     &
+                                    nbdim, indmin, indmax, indminglob,  indmaxglob,         &
+                                    pttruetab, cetruetab, memberin                          &
+#if defined AGRIF_MPI
+                                   ,indminglob2, indmaxglob2, parentarray,                  &
+                                    member, tab4t, memberinall, sendtoproc1, recvfromproc1  &
+#endif
+    ) result(find_list_interp)
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_List_Interp_Loc),   pointer     :: list_interp
+    integer,                       intent(in)  :: nbdim
+    integer, dimension(nbdim),     intent(in)  :: pttab, petab, pttab_Child, pttab_Parent
+    integer, dimension(nbdim),     intent(out) :: indmin, indmax
+    integer, dimension(nbdim),     intent(out) :: indminglob, indmaxglob
+    integer, dimension(nbdim),     intent(out) :: pttruetab, cetruetab
+    logical,                       intent(out) :: memberin
+#if defined AGRIF_MPI
+    integer, dimension(nbdim),     intent(out) :: indminglob2, indmaxglob2
+    integer, dimension(nbdim,2,2), intent(out) :: parentarray
+    logical,                       intent(out) :: member
+    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab4t
+    logical, dimension(0:Agrif_Nbprocs-1),         intent(out) :: memberinall
+    logical, dimension(0:Agrif_Nbprocs-1),         intent(out) :: sendtoproc1, recvfromproc1
+#endif
+    logical :: find_list_interp
+!
+    integer :: i
+    type(Agrif_List_Interp_Loc), pointer :: parcours
+    type(Agrif_Interp_Loc),      pointer :: pil
+
+    find_list_interp = .false.
+
+    if ( .not. associated(list_interp) )    return
+
+    parcours => list_interp
+    find_loop : do while ( associated(parcours) )
+
+        pil => parcours % interp_loc
+
+        do i = 1,nbdim
+            if ( (pttab(i) /= pil % pttab(i)) .or. &
+                 (petab(i) /= pil % petab(i)) .or. &
+                 (pttab_child(i)  /= pil % pttab_child(i)) .or. &
+                 (pttab_parent(i) /= pil % pttab_parent(i)) ) then
+                parcours => parcours % suiv
+                cycle find_loop
+            endif
+        enddo
+
+        indmin = pil % indmin(1:nbdim)
+        indmax = pil % indmax(1:nbdim)
+
+        pttruetab = pil % pttruetab(1:nbdim)
+        cetruetab = pil % cetruetab(1:nbdim)
+
+#if !defined AGRIF_MPI
+        indminglob  = pil % indminglob(1:nbdim)
+        indmaxglob  = pil % indmaxglob(1:nbdim)
+#else
+        indminglob  = pil % indminglob2(1:nbdim)
+        indmaxglob  = pil % indmaxglob2(1:nbdim)
+        indminglob2 = pil % indminglob2(1:nbdim)
+        indmaxglob2 = pil % indmaxglob2(1:nbdim)
+        parentarray = pil % parentarray(1:nbdim,:,:)
+        member      = pil % member
+        tab4t         = pil % tab4t(1:nbdim, 0:Agrif_Nbprocs-1, 1:8)
+        memberinall   = pil % memberinall(0:Agrif_Nbprocs-1)
+        sendtoproc1   = pil % sendtoproc1(0:Agrif_Nbprocs-1)
+        recvfromproc1 = pil % recvfromproc1(0:Agrif_Nbprocs-1)
+#endif
+        memberin = pil % memberin
+        find_list_interp = .true.
+        exit find_loop
+    enddo find_loop
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Find_list_interp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_AddTo_list_interp
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_AddTo_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent,  &
+                                     indmin, indmax, indminglob, indmaxglob,                &
+                                     pttruetab, cetruetab,                                  &
+                                     memberin, nbdim                                        &
+#if defined AGRIF_MPI
+                                    ,indminglob2, indmaxglob2,                              &
+                                     parentarray,                                           &
+                                     member,                                                &
+                                     tab4t, memberinall, sendtoproc1, recvfromproc1         &
+#endif
+    )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_List_Interp_Loc), pointer    :: list_interp
+    integer                                 :: nbdim
+    integer, dimension(nbdim)               :: pttab, petab, pttab_Child, pttab_Parent
+    integer, dimension(nbdim)               :: indmin,indmax
+    integer, dimension(nbdim)               :: indminglob, indmaxglob
+    integer, dimension(nbdim)               :: pttruetab, cetruetab
+    logical                                 :: memberin
+#if defined AGRIF_MPI
+    integer, dimension(nbdim,2,2)           :: parentarray
+    logical                                 :: member
+    integer, dimension(nbdim)                       :: indminglob2,indmaxglob2
+    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8)   :: tab4t
+    logical, dimension(0:Agrif_Nbprocs-1)           :: memberinall
+    logical, dimension(0:Agrif_Nbprocs-1)           :: sendtoproc1
+    logical, dimension(0:Agrif_Nbprocs-1)           :: recvfromproc1
+#endif
+!
+    type(Agrif_List_Interp_Loc), pointer    :: parcours
+    type(Agrif_Interp_Loc),      pointer    :: pil
+!
+    allocate(parcours)
+    allocate(parcours % interp_loc)
+
+    pil => parcours % interp_loc
+
+    pil % pttab(1:nbdim) = pttab(1:nbdim)
+    pil % petab(1:nbdim) = petab(1:nbdim)
+    pil % pttab_child(1:nbdim) = pttab_child(1:nbdim)
+    pil % pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
+
+    pil % indmin(1:nbdim) = indmin(1:nbdim)
+    pil % indmax(1:nbdim) = indmax(1:nbdim)
+
+    pil % memberin = memberin
+#if !defined AGRIF_MPI
+    pil % indminglob(1:nbdim) = indminglob(1:nbdim)
+    pil % indmaxglob(1:nbdim) = indmaxglob(1:nbdim)
+#else
+    pil % indminglob2(1:nbdim) = indminglob2(1:nbdim)
+    pil % indmaxglob2(1:nbdim) = indmaxglob2(1:nbdim)
+    pil % parentarray(1:nbdim,:,:) = parentarray(1:nbdim,:,:)
+    pil % member = member
+    allocate(pil % tab4t(nbdim, 0:Agrif_Nbprocs-1, 8))
+    allocate(pil % memberinall(0:Agrif_Nbprocs-1))
+    allocate(pil % sendtoproc1(0:Agrif_Nbprocs-1))
+    allocate(pil % recvfromproc1(0:Agrif_Nbprocs-1))
+    pil % tab4t         = tab4t
+    pil % memberinall   = memberinall
+    pil % sendtoproc1   = sendtoproc1
+    pil % recvfromproc1 = recvfromproc1
+#endif
+
+    pil % pttruetab(1:nbdim) = pttruetab(1:nbdim)
+    pil % cetruetab(1:nbdim) = cetruetab(1:nbdim)
+
+    parcours % suiv => list_interp
+    list_interp => parcours
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Addto_list_interp
+!===================================================================================================
+!
+end module Agrif_Interpolation
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F	(revision 5659)
+++ 	(revision )
@@ -1,1706 +1,0 @@
-!
-! $Id$
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Interpbasic
-C
-      Module Agrif_Interpbasic
-C
-CCC   Description:
-CCC   Module containing different procedures of interpolation (linear,lagrange,
-CCC   spline,...) used in the Agrif_Interpolation module.
-C
-C     Modules used:
-      USE Agrif_types
-C
-      IMPLICIT NONE
-C             
-      Real,Dimension(Agrif_MaxRaff) :: tabdiff2, tabdiff3
-      Real,Dimension(5,Agrif_MaxRaff,3) :: tabppm
-      Real,Dimension(:),Allocatable::tabtest4   
-      Integer, Dimension(:,:), Allocatable :: indparent
-      Integer, Dimension(:,:), Allocatable :: 
-     &           indparentppm,indchildppm
-      Integer, Dimension(:), Allocatable :: 
-     &           indparentppm_1d,indchildppm_1d
-      Real, Dimension(:,:),Allocatable :: coeffparent   
-       
-      CONTAINS
-C     Define procedures contained in this module
-C  
-C     **************************************************************************  
-CCC   Subroutine Linear1d  
-C     ************************************************************************** 
-C 
-      Subroutine Linear1d(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
-CCC   its parent grid (vector x).  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C        
-C     Arguments
-      INTEGER             :: np,nc      
-      REAL,INTENT(IN), DIMENSION(np) :: x      
-      REAL,INTENT(OUT), DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      INTEGER :: i,coeffraf,locind_parent_left
-      REAL    :: ypos,globind_parent_left,globind_parent_right
-      REAL    :: invds, invds2
-      REAL :: ypos2,diff
-C
-C
-
-      coeffraf = nint(ds_parent/ds_child)
-C
-      if (coeffraf == 1) then
-C
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-C        
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-C
-          return
-C
-      endif                          
-C
-      ypos = s_child 
-
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-
-        globind_parent_left = s_parent 
-     &                        + (locind_parent_left - 1)*ds_parent
-
-        globind_parent_right = globind_parent_left + ds_parent
-
-C
-      invds = 1./ds_parent
-      invds2 = ds_child/ds_parent
-      
-      ypos2 = ypos*invds
-      globind_parent_right=globind_parent_right*invds
-      
-      do i = 1,nc-1
-C
-        if (ypos2 > globind_parent_right) then
-           locind_parent_left = locind_parent_left + 1.
-           globind_parent_right = globind_parent_right + 1.
-           ypos2 = ypos*invds+(i-1)*invds2           
-        endif
-        
-        diff=(globind_parent_right - ypos2)
-        y(i) = (diff*x(locind_parent_left)
-     &        + (1.-diff)*x(locind_parent_left+1))
-C
-        ypos2 = ypos2 + invds2
-C
-      enddo
-C
-      ypos = s_child + (nc-1)*ds_child
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-C
-      if (locind_parent_left == np) then
-C
-          y(nc) = x(np)
-C
-        else
-C
-          globind_parent_left = s_parent 
-     &                        + (locind_parent_left - 1)*ds_parent  
-C      
-          y(nc) = ((globind_parent_left + ds_parent - ypos)
-     &            *x(locind_parent_left)
-     &          + (ypos - globind_parent_left)
-     &            *x(locind_parent_left+1))*invds
-C
-      endif                                          
-C           
-      Return
-C
-C       
-      End Subroutine Linear1d   
-      
-      Subroutine Linear1dprecompute2d(np2, np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child,dir)
-C
-CCC   Description:
-CCC   Subroutine to compute 2D coefficient and index for a linear 1D interpolation
-CCC   on a child grid (vector y) from its parent grid (vector x).
-C
-CC    Method:
-C
-C     Declarations:
-C
-
-C        
-C     Arguments
-      INTEGER             :: np,nc,np2,dir
-      REAL                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      INTEGER :: i,j,coeffraf,locind_parent_left,inc,inc1,inc2,toto 
-      Integer, Dimension(:,:), Allocatable :: indparent_tmp
-      Real, Dimension(:,:), Allocatable :: coeffparent_tmp
-      REAL    :: ypos,globind_parent_left,globind_parent_right
-      REAL    :: invds, invds2, invds3
-      REAL :: ypos2,diff
-C
-C
-
-      coeffraf = nint(ds_parent/ds_child)
-C
-      ypos = s_child
-
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-
-        globind_parent_left = s_parent
-     &                        + (locind_parent_left - 1)*ds_parent
-
-        globind_parent_right = globind_parent_left + ds_parent
-
-C
-      invds = 1./ds_parent
-      invds2 = ds_child/ds_parent
-      invds3 = 0.5/real(coeffraf)
-
-      ypos2 = ypos*invds
-      globind_parent_right=globind_parent_right*invds
-
-      if (.not.allocated(indparent)) then
-      allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
-      else
-      if (size(indparent,1)<nc*np2) then
-      allocate(coeffparent_tmp(size(indparent,1),size(indparent,2)))
-      allocate(indparent_tmp(size(indparent,1),size(indparent,2)))
-      coeffparent_tmp=coeffparent 
-      indparent_tmp=indparent 
-      deallocate(indparent,coeffparent)
-      allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
-      coeffparent(1:size(coeffparent_tmp,1),1:size(coeffparent_tmp,2))
-     &  = coeffparent_tmp 
-      indparent(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
-     & = indparent_tmp
-      deallocate(indparent_tmp,coeffparent_tmp)
-      endif
-      endif
-
-      do i = 1,nc-1
-C
-        if (ypos2 > globind_parent_right) then
-           locind_parent_left = locind_parent_left + 1
-           globind_parent_right = globind_parent_right + 1.
-           ypos2 = ypos*invds+(i-1)*invds2
-        endif
-
-        diff=(globind_parent_right - ypos2)
-        diff = invds3*nint(2*coeffraf*diff)
-        indparent(i,dir) = locind_parent_left
-
-        coeffparent(i,dir) = diff
-        
-        ypos2 = ypos2 + invds2
-C
-      enddo
-C
-      ypos = s_child + (nc-1)*ds_child
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-
-      if (locind_parent_left == np) then
-      indparent(nc,dir) = locind_parent_left-1
-      coeffparent(nc,dir) = 0.
-        else
-C
-          globind_parent_left = s_parent
-     &                        + (locind_parent_left - 1)*ds_parent
-C      
-       indparent(nc,dir) = locind_parent_left
-       diff = (globind_parent_left + ds_parent - ypos)
-     &       * invds
-        diff = invds3*nint(2*coeffraf*diff)
-         coeffparent(nc,dir) = diff
-      endif                                           
-
-      do i=2, np2
-      inc  =  i*nc
-      inc1 = (i-1)*nc
-      inc2 = (i-2)*nc 
-!CDIR ALTCODE
-      indparent(1+inc1:inc,dir) = indparent(1+inc2:inc1,dir)+np
-!CDIR ALTCODE
-      coeffparent(1+inc1:inc,dir) =coeffparent(1:nc,dir)
-      enddo      
-
-      Return
-C
-C       
-      End Subroutine Linear1dprecompute2d
-
-
-
-      Subroutine Linear1dprecompute(np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to compute 1D coefficient and index for a linear 1D interpolation
-CCC   on a child grid (vector y) from its parent grid (vector x).
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C        
-C     Arguments
-      INTEGER             :: np,nc 
-      REAL                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      INTEGER :: i,coeffraf,locind_parent_left
-      REAL    :: ypos,globind_parent_left,globind_parent_right
-      REAL    :: invds, invds2, invds3
-      REAL :: ypos2,diff
-C
-C
-
-      coeffraf = nint(ds_parent/ds_child)
-C
-      if (coeffraf == 1) then
-C
-          return
-C
-      endif                          
-C
-      ypos = s_child 
-
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-
-        globind_parent_left = s_parent 
-     &                        + (locind_parent_left - 1)*ds_parent
-
-        globind_parent_right = globind_parent_left + ds_parent
-
-C
-      invds = 1./ds_parent
-      invds2 = ds_child/ds_parent
-      invds3 = 0.5/real(coeffraf)      
-      
-      ypos2 = ypos*invds
-      globind_parent_right=globind_parent_right*invds
-      
-      if (.not.allocated(indparent)) then
-      allocate(indparent(nc,1),coeffparent(nc,1))
-      else
-      if (size(indparent)<nc) then
-      deallocate(indparent,coeffparent)
-      allocate(indparent(nc,1),coeffparent(nc,1))
-      endif
-      endif
-      
-      do i = 1,nc-1
-C
-        if (ypos2 > globind_parent_right) then
-           locind_parent_left = locind_parent_left + 1
-           globind_parent_right = globind_parent_right + 1.
-           ypos2 = ypos*invds+(i-1)*invds2           
-        endif
-        
-        diff=(globind_parent_right - ypos2)
-        
-        diff = invds3*nint(2*coeffraf*diff)
-                
-        indparent(i,1) = locind_parent_left
-
-        coeffparent(i,1) = diff
-        ypos2 = ypos2 + invds2
-C
-      enddo
-C
-      ypos = s_child + (nc-1)*ds_child
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-      
-      if (locind_parent_left == np) then
-      indparent(nc,1) = locind_parent_left-1
-      coeffparent(nc,1) = 0.
-        else
-C
-          globind_parent_left = s_parent 
-     &                        + (locind_parent_left - 1)*ds_parent  
-C      
-       indparent(nc,1) = locind_parent_left
-       
-       diff = (globind_parent_left + ds_parent - ypos)
-     &       * invds
-        diff = invds3*nint(2*coeffraf*diff)
-         coeffparent(nc,1) = diff
-      endif                                          
-C           
-      Return
-C
-C       
-      End Subroutine Linear1dprecompute 
-      
-      Subroutine Linear1daftercompute(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child,dir) 
-C
-CCC   Description:
-CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
-CCC   its parent grid (vector x) using precomputed coefficient and index.  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C        
-C     Arguments
-      INTEGER             :: np,nc,dir      
-      REAL,INTENT(IN), DIMENSION(np) :: x      
-      REAL,INTENT(OUT), DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      INTEGER :: i,coeffraf,locind_parent_left
-      REAL    :: ypos,globind_parent_left,globind_parent_right
-      REAL    :: invds, invds2
-      REAL :: ypos2,diff
-C
-C
-
-!CDIR ALTCODE
-!CDIR NODEP
-      do i = 1,nc
-C
-       y(i)=coeffparent(i,dir)*x(MAX(indparent(i,dir),1))+
-     &      (1.-coeffparent(i,dir))*x(indparent(i,dir)+1)
-C
-      enddo                                     
-C           
-      Return
-C
-C       
-      End Subroutine Linear1daftercompute            
-       
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Lagrange1d  
-C     **************************************************************************
-C
-      Subroutine Lagrange1d(x,y,np,nc,
-     &                      s_parent,s_child,ds_parent,ds_child)
-C
-CCC   Description:
-CCC   Subroutine to do a lagrange 1D interpolation on a child grid (vector y) 
-CCC   from its parent grid (vector x).  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C             
-C     Arguments
-      INTEGER             :: np,nc      
-      REAL,INTENT(IN), DIMENSION(np) :: x      
-      REAL,INTENT(OUT), DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child,ds_parent,ds_child 
-C
-C     Local scalars
-      INTEGER :: i,coeffraf,locind_parent_left
-      REAL    :: ypos,globind_parent_left
-      REAL    :: X1,X2,X3 
-      real :: deltax,invdsparent
-      real t1,t2,t3,t4,t5,t6,t7,t8
-C
-C 
-      if (np <= 2) then
-C      
-          Call Linear1D(x,y,np,nc,
-     &                  s_parent,s_child,ds_parent,ds_child)
-C         
-         Return
-C 
-      endif
-C
-      coeffraf = nint(ds_parent/ds_child)
-C
-      if (coeffraf == 1) then
-C
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-C        
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-C
-          return
-C
-      endif
-      
-      invdsparent=1./ds_parent
-C
-      ypos = s_child      
-C
-      do i = 1,nc
-C
-        locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-C
-
-        globind_parent_left = s_parent 
-     &                        + (locind_parent_left - 1)*ds_parent 
-     
-C        deltax = invdsparent*(ypos-globind_parent_left)
-        deltax = nint(coeffraf*deltax)/real(coeffraf)
-        
-        ypos = ypos + ds_child
-         if (abs(deltax).LE.0.0001) then
-           y(i)=x(locind_parent_left)
-           
-           cycle
-         endif
-C           
-C
-        t2 = deltax - 2.
-        t3 = deltax - 1.
-        t4 = deltax + 1.
-        
-        t5 = -(1./6.)*deltax*t2*t3
-        t6 = 0.5*t2*t3*t4
-        t7 = -0.5*deltax*t2*t4
-        t8 = (1./6.)*deltax*t3*t4
-        
-        y(i)=t5*x(locind_parent_left-1)+t6*x(locind_parent_left)
-     &  +t7*x(locind_parent_left+1)+t8*x(locind_parent_left+2)
-C
-C
-      enddo
-C
-      return
-C
-C       
-      End Subroutine Lagrange1d 
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Constant1d  
-C     ************************************************************************** 
-C 
-      Subroutine constant1d(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
-CCC   its parent grid (vector x).  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C        
-C     Arguments
-      INTEGER             :: np,nc      
-      REAL,INTENT(IN), DIMENSION(np) :: x      
-      REAL,INTENT(OUT), DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      INTEGER :: i,coeffraf,locind_parent
-      REAL    :: ypos
-C
-C
-
-      coeffraf = nint(ds_parent/ds_child)
-C
-      if (coeffraf == 1) then
-C
-          locind_parent = 1 + nint((s_child - s_parent)/ds_parent)
-C        
-          y(1:nc) = x(locind_parent:locind_parent+nc-1)
-C
-          return
-C
-      endif                          
-C
-      ypos = s_child      
-C
-      do i = 1,nc
-C
-        locind_parent = 1 + nint((ypos - s_parent)/ds_parent)
-C
-        y(i) = x(locind_parent)
-C
-        ypos = ypos + ds_child
-C
-      enddo
-C           
-      Return
-C
-C       
-      End Subroutine constant1d   
-C
-C     **************************************************************************  
-CCC   Subroutine Linear1dconserv
-C     ************************************************************************** 
-C 
-      Subroutine Linear1dconserv(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
-CCC   its parent grid (vector x).  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc      
-      Real, Dimension(np) :: x      
-      Real, Dimension(nc) :: y
-      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Real    :: ypos
-      integer :: i1,i2,ii
-      real :: xpmin,xpmax,slope
-      INTEGER :: diffmod
-      REAL :: xdiffmod
-
-C
-C
-
-      coeffraf = nint(ds_parent/ds_child)
-C
-      If (coeffraf == 1) Then
-C
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-C        
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-C
-          return
-C
-      End If
-C              
-      diffmod = 0
-      IF (mod(coeffraf,2) == 0) diffmod = 1  
-
-      xdiffmod = real(diffmod)/2.
-                         
-      allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-C
-      ypos = s_child  
-C      
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
-
-      locind_parent_last = 1 +
-     &  agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
-     
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent 
-      xpmax = s_parent + (locind_parent_last-1)*ds_parent          
-      
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-      i2 = 1+agrif_int((xpmax-s_child)/ds_child)
-
-      i = i1
-      
-      if (locind_parent_left == 1) then
-        slope=
-     &   (x(locind_parent_left+1)-x(locind_parent_left))/(coeffraf)
-      else
-         slope=
-     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
-      endif
-      
-        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
-          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo 
-
-        locind_parent_left = locind_parent_left + 1
-                      
-      do i=i1 +  coeffraf, i2 - coeffraf,coeffraf
-        slope=
-     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
-        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
-          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo
-        locind_parent_left = locind_parent_left + 1
-      enddo
-      
-      i = i2
-      
-      if (locind_parent_left == np) then
-        slope=
-     &   (x(locind_parent_left)-x(locind_parent_left-1))/(coeffraf)
-      else
-         slope=
-     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
-      endif
-      
-        do ii=i-coeffraf/2+diffmod,nc
-          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo      
-C
-      y(1:nc)=ytemp(1:nc)                                   
-C           
-      deallocate(ytemp)
-      Return
-C       
-      End Subroutine Linear1dconserv
-      
-C
-C     **************************************************************************  
-CCC   Subroutine Linear1dconservlim
-C     ************************************************************************** 
-C 
-      Subroutine Linear1dconservlim(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
-CCC   its parent grid (vector x).  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc      
-      Real, Dimension(np) :: x      
-      Real, Dimension(nc) :: y
-      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Real    :: ypos
-      integer :: i1,i2,ii
-      real :: xpmin,xpmax,slope
-      INTEGER :: diffmod
-      real :: xdiffmod
-C
-C
-
-      coeffraf = nint(ds_parent/ds_child)
-C
-      If (coeffraf == 1) Then
-C
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-C        
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-C
-          return
-C
-      End If
-C
-      IF (coeffraf .NE.3) THEN
-      print *,'LINEARCONSERVLIM not ready for refinement ratio = ',
-     &   coeffraf
-      stop
-      ENDIF   
-      
-      diffmod = 0
-      IF (mod(coeffraf,2) == 0) diffmod = 1        
-
-      xdiffmod = real(diffmod)/2.
-                         
-      allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-C
-      ypos = s_child  
-C      
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
-
-      locind_parent_last = 1 +
-     &  agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
-     
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent 
-      xpmax = s_parent + (locind_parent_last-1)*ds_parent          
-      
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-      i2 = 1+agrif_int((xpmax-s_child)/ds_child)
-
-      i = i1
-      
-      if (locind_parent_left == 1) then
-        slope=0.       
-      else
-        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
-        slope = slope / coeffraf    
-      endif
-      
-        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
-          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo 
-
-        locind_parent_left = locind_parent_left + 1
-                      
-      do i=i1 +  coeffraf, i2 - coeffraf,coeffraf     
-        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
-        slope = slope / coeffraf
-
-        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
-          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo
-        locind_parent_left = locind_parent_left + 1
-      enddo
-      
-      i = i2
-      
-      if (locind_parent_left == np) then
-        slope=0.     
-      else
-        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
-        slope = slope / coeffraf      
-      endif
-      
-        do ii=i-coeffraf/2+diffmod,nc
-          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
-        enddo      
-C
-      y(1:nc)=ytemp(1:nc)                                   
-C           
-      deallocate(ytemp)
-      Return
-C       
-      End Subroutine Linear1dconservlim      
-C         
-
-C     **************************************************************************  
-CCC   Subroutine ppm1d
-C     ************************************************************************** 
-C 
-      Subroutine ppm1d(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
-CCC   using piecewise parabolic method  
-CCC   on a child grid (vector y) from its parent grid (vector x).
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc      
-      Real, INTENT(IN),Dimension(np) :: x      
-      Real, INTENT(OUT),Dimension(nc) :: y
-C      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
-      integer :: i1,jj
-      Real :: xpmin,a
-C      
-      Real :: xrmin,xrmax,am3,s2,s1  
-      Real, Dimension(np) :: xl,delta,a6,slope
-C      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
-      INTEGER :: diffmod
-      REAL :: invcoeffraf
-C      
-      coeffraf = nint(ds_parent/ds_child)
-C
-      If (coeffraf == 1) Then
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-          return
-      End If
-      invcoeffraf = ds_child/ds_parent
-C      
-
-      IF( .NOT. allocated(tabtest4) ) THEN    
-      Allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
-      ELSE
-         IF (size(tabtest4) .LT. nc+4*coeffraf+1)THEN
-         deallocate( tabtest4 )
-         Allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
-         ENDIF
-      ENDIF
-            
-      ypos = s_child  
-C
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
-      locind_parent_last = 1 +
-     &      agrif_ceiling((ypos +(nc - 1) 
-     &      *ds_child - s_parent)/ds_parent)  
-C
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
-C     
-C
-      
-!CDIR NOVECTOR
-      Do i=1,coeffraf
-        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
-      EndDo
-
-      a = invcoeffraf**2 
-      tabdiff3(1) = (1./3.)*a
-      a=2.*a
-!CDIR NOVECTOR
-      Do i=2,coeffraf
-        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
-      EndDo
-C
-      if( locind_parent_last+2 <= np ) then
-           nmax = locind_parent_last+2    
-      else if( locind_parent_last+1 <= np ) then
-           nmax = locind_parent_last+1
-      else
-           nmax = locind_parent_last 
-      endif     
-C      
-      if(locind_parent_left-1 >= 1) then
-          nmin = locind_parent_left-1
-      else 
-          nmin = locind_parent_left
-      endif    
-C 
-C
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-      Do i = nmin,nmax
-         slope(i) = x(i) - x(i-1)
-      Enddo
-
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-      Do i = nmin+1,nmax-1
-         xl(i)= 0.5*(x(i-1)+x(i))
-     &      -0.08333333333333*(slope(i+1)-slope(i-1)) 
-      Enddo
-C
-C apply parabolic monotonicity
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-       Do i = locind_parent_left,locind_parent_last
-          delta(i) = xl(i+1) - xl(i)
-          a6(i) = 6.*x(i)-3.*(xl(i) +xl(i+1))
-C
-       End do   
-C
-        diffmod = 0
-       IF (mod(coeffraf,2) == 0) diffmod = 1
-C
-        ipos = i1
-C               
-        Do iparent = locind_parent_left,locind_parent_last       
-             pos=1
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-C
-               tabtest4(jj) = xl(iparent)   
-     &             + tabdiff2(pos) *  (delta(iparent)+a6(iparent))
-     &             - tabdiff3(pos) *  a6(iparent)
-               pos = pos+1 
-             End do 
-             ipos = ipos + coeffraf
-C
-        End do
-C
-C
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-        y(1:nc)=tabtest4(1:nc)
-        
-      Return
-      End Subroutine ppm1d
-      
-
-      Subroutine ppm1dprecompute2d(np2,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child,dir)
-C
-CCC   Description:
-CCC   Subroutine to compute 2D coefficients and index for a 1D interpolation
-CCC   using piecewise parabolic method  
-CC    Method: 
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np2,np,nc,dir
-C      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer, Dimension(:,:), Allocatable :: indparent_tmp
-      Integer, Dimension(:,:), Allocatable :: indchild_tmp
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
-      integer :: i1,jj
-      Real :: xpmin,a
-C      
-      Real :: xrmin,xrmax,am3,s2,s1
-      Real, Dimension(np) :: xl,delta,a6,slope
-      INTEGER :: diffmod
-      REAL :: invcoeffraf
-C      
-      coeffraf = nint(ds_parent/ds_child)
-C
-      invcoeffraf = ds_child/ds_parent
-C 
-
-      if (.not.allocated(indparentppm)) then
-      allocate(
-     & indparentppm(np2*nc,3),
-     & indchildppm(np2*nc,3)
-     &        )
-      else
-      if (size(indparentppm,1)<np2*nc) then
-      allocate(
-     &  indparent_tmp(size(indparentppm,1),size(indparentppm,2)),
-     &  indchild_tmp(size(indparentppm,1),size(indparentppm,2)))
-      indparent_tmp = indparentppm 
-      indchild_tmp  = indchildppm 
-      deallocate(indparentppm,indchildppm)
-      allocate(
-     &indparentppm(np2*nc,3),
-     &indchildppm(np2*nc,3)
-     &        )
-      indparentppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
-     & = indparent_tmp
-      indchildppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
-     & = indchild_tmp
-      deallocate(indparent_tmp,indchild_tmp)
-      endif
-      endif
-
-      if (.not.allocated(indparentppm_1d)) then
-      allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),
-     &         indchildppm_1d(-2*coeffraf:nc+2*coeffraf))
-      else
-      if (size(indparentppm_1d)<nc+4*coeffraf+1) then
-      deallocate(indparentppm_1d,indchildppm_1d)
-      allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),
-     &         indchildppm_1d(-2*coeffraf:nc+2*coeffraf))
-      endif
-      endif
-
-
-      ypos = s_child
-C
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-      locind_parent_last = 1 +
-     &      agrif_ceiling((ypos +(nc - 1)
-     &      *ds_child - s_parent)/ds_parent)
-C
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-C     
-C
-
-      Do i=1,coeffraf
-        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
-      EndDo
-
-      a = invcoeffraf**2
-      tabdiff3(1) = (1./3.)*a
-      a=2.*a
-!CDIR ALTCODE
-      Do i=2,coeffraf
-        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
-      EndDo
-
-!CDIR ALTCODE
-      Do i=1,coeffraf
-      tabppm(1,i,dir) = 0.08333333333333*
-     &              (-1.+4*tabdiff2(i)-3*tabdiff3(i))
-      tabppm(2,i,dir) = 0.08333333333333*
-     &              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
-      tabppm(3,i,dir) = 0.08333333333333*
-     &              (7.+30*tabdiff2(i)-30*tabdiff3(i))
-      tabppm(4,i,dir) = 0.08333333333333*
-     &              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
-      tabppm(5,i,dir) = 0.08333333333333*
-     &              (2*tabdiff2(i)-3*tabdiff3(i))                   
-      End Do
-C 
-C
-        diffmod = 0
-       IF (mod(coeffraf,2) == 0) diffmod = 1
-C
-        ipos = i1
-C               
-        Do iparent = locind_parent_left,locind_parent_last
-             pos=1
-!CDIR ALTCODE
-             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-         indparentppm_1d(jj) = iparent-2
-         indchildppm_1d(jj) = pos
-               pos = pos+1
-             End do
-             ipos = ipos + coeffraf
-C
-        End do
-     
-       Do i=1,np2
-
-       indparentppm(1+(i-1)*nc:i*nc,dir) = 
-     &             indparentppm_1d(1:nc) + (i-1)*np
-       indchildppm (1+(i-1)*nc:i*nc,dir) = 
-     &             indchildppm_1d (1:nc) 
-
-       End do
-
-      Return
-      End Subroutine ppm1dprecompute2d
-
-
-      Subroutine ppm1dprecompute(np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to compute coefficient and index for  a 1D interpolation 
-CCC   using piecewise parabolic method  
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc
-C      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
-      integer :: i1,jj
-      Real :: xpmin,a
-C      
-      Real :: xrmin,xrmax,am3,s2,s1  
-      Real, Dimension(np) :: xl,delta,a6,slope
-C      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
-      INTEGER :: diffmod
-      REAL :: invcoeffraf
-C      
-      coeffraf = nint(ds_parent/ds_child)
-C
-      If (coeffraf == 1) Then
-          return
-      End If
-      invcoeffraf = ds_child/ds_parent
-C 
-      
-      if (.not.allocated(indparentppm)) then
-      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),
-     &         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
-      else
-      if (size(indparentppm,1)<nc+4*coeffraf+1) then
-      deallocate(indparentppm,indchildppm)
-      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),
-     &         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
-      endif
-      endif
-            
-      ypos = s_child  
-C
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
-      locind_parent_last = 1 +
-     &      agrif_ceiling((ypos +(nc - 1) 
-     &      *ds_child - s_parent)/ds_parent)  
-C
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
-C     
-C
-      
-      Do i=1,coeffraf
-        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
-      EndDo
-
-      a = invcoeffraf**2 
-      tabdiff3(1) = (1./3.)*a
-      a=2.*a
-!CDIR ALTCODE
-!!!CDIR SHORTLOOP
-      Do i=2,coeffraf
-        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
-      EndDo
-      
-!CDIR ALTCODE
-!!!CDIR SHORTLOOP
-      Do i=1,coeffraf
-      tabppm(1,i,1) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
-      tabppm(2,i,1) = 0.08333333333333*
-     &              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
-      tabppm(3,i,1) =0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
-      tabppm(4,i,1) = 0.08333333333333*
-     &              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))     
-      tabppm(5,i,1) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i)) 
-      End Do   
-C 
-C
-        diffmod = 0
-       IF (mod(coeffraf,2) == 0) diffmod = 1
-C
-        ipos = i1
-C               
-        Do iparent = locind_parent_left,locind_parent_last       
-             pos=1
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-         indparentppm(jj,1) = iparent-2
-         indchildppm(jj,1) = pos
-               pos = pos+1 
-             End do 
-             ipos = ipos + coeffraf
-C
-        End do
-        
-      Return
-      End Subroutine ppm1dprecompute
-      
-      Subroutine ppm1daftercompute(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child,dir) 
-C
-CCC   Description:
-CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
-CCC   using piecewise parabolic method  
-CCC   on a child grid (vector y) from its parent grid (vector x).
-CC    Method: Use precomputed coefficient and index
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc,dir
-      Real, INTENT(IN),Dimension(np) :: x      
-      Real, INTENT(OUT),Dimension(nc) :: y
-C      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
-      integer :: i1,jj
-      Real :: xpmin,a
-C      
-      Real :: xrmin,xrmax,am3,s2,s1  
-      Real, Dimension(np) :: xl,delta,a6,slope
-      INTEGER :: diffmod
-C      
-C
-      do i=1,nc
-      y(i)=tabppm(1,indchildppm(i,dir),dir)*x(indparentppm(i,dir))+
-     &        tabppm(2,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+1)+
-     &        tabppm(3,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+2)+
-     &        tabppm(4,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+3)+
-     &        tabppm(5,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+4)
-      enddo
-        
-      Return
-      End Subroutine ppm1daftercompute            
-      
-C     **************************************************************************  
-CCC   Subroutine weno1d
-C     ************************************************************************** 
-C 
-      Subroutine weno1dnew(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
-CCC   using piecewise parabolic method  
-CCC   on a child grid (vector y) from its parent grid (vector x).
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc
-      Real, Dimension(np) :: x
-      Real, Dimension(nc) :: y
-      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
-      integer :: i1,jj
-      Real :: xpmin,cavg,a,b
-C      
-      Real :: xrmin,xrmax,am3,s2,s1
-      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2,smooth
-      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
-      INTEGER :: diffmod
-      REAL :: invcoeffraf
-      integer :: s,l,k
-      integer :: etan, etap
-      real :: delta0, delta1, delta2
-      real :: epsilon
-      parameter (epsilon = 1.D-8)
-      real, dimension(:,:), allocatable :: ak, ck
-C      
-      coeffraf = nint(ds_parent/ds_child)
-C
-      If (coeffraf == 1) Then
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-          return
-      End If
-      invcoeffraf = ds_child/ds_parent
-      Allocate(ak(0:1,coeffraf))
-      Allocate(ck(0:1,coeffraf))
-            
-C      
-      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-      ypos = s_child
-C
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-      locind_parent_last = 1 +
-     &      agrif_ceiling((ypos +(nc - 1)
-     &      *ds_child - s_parent)/ds_parent)
-C
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-C     
-      Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) )
-C      
-      diff(1)=0.5*invcoeffraf
-      do i=2,coeffraf
-         diff(i) = diff(i-1)+invcoeffraf
-      enddo
-      
-      ak = 0.
-      ck = 0.
-      
-      do i=1,coeffraf
-         do k=0,1
-         do s=0,2
-         do l=0,2
-           if (l /= s) then
-            ak(k,i) = ak(k,i)+(diff(i)-(k-l+1.))
-           endif
-         enddo
-         enddo
-         enddo
-               
-         etap = 0
-         etan = 0
-         do k=0,1
-          if (ak(k,i) > 0) then
-            etap = etap+1
-          else if (ak(k,i) < 0) then
-            etan = etan + 1
-          endif
-         enddo
-               
-         do k=0,1
-           if (ak(k,i) == 0) then
-            Ck(k,i) = 1.
-           else if (ak(k,i) > 0) then
-            Ck(k,i) = 1./(etap * ak(k,i))
-           else
-            Ck(k,i) = -1./(etan * ak(k,i))
-           endif
-         enddo
-      enddo
-                     
-C      
-      a = 0.
-      b = invcoeffraf
-      Do i=1,coeffraf
-         diff2(i) = 0.5*(b*b - a*a)  
-         diff3(i) = (1./3.)*(b*b*b - a*a*a)
-         a = a + invcoeffraf
-         b = b + invcoeffraf
-      End do
-C
-      if( locind_parent_last+2 <= np ) then
-           nmax = locind_parent_last+2    
-      elseif( locind_parent_last+1 <= np ) then
-           nmax = locind_parent_last+1
-      else
-           nmax = locind_parent_last 
-      endif     
-C      
-      if(locind_parent_left-2 >= 1) then
-          nmin = locind_parent_left-2
-      elseif(locind_parent_left-1 >= 1) then
-          nmin = locind_parent_left-1
-      else 
-          nmin = locind_parent_left
-      endif    
-C 
-      Do i = nmin+1,nmax
-         slope(i) = (x(i) - x(i-1))
-      Enddo 
-      DO i=nmin+2,nmax
-        smooth(i) = 0.5*(slope(i)**2+slope(i-1)**2)
-     &       +(slope(i)-slope(i-1))**2
-      enddo
-C
-        diffmod = 0
-        IF (mod(coeffraf,2) == 0) diffmod = 1           
-C
-        ipos = i1
-C               
-        Do iparent = locind_parent_left,locind_parent_last       
-             pos=1
-             
-            delta0=1./(epsilon+smooth(iparent  ))**3
-            delta1=1./(epsilon+smooth(iparent+1))**3
-            delta2=1./(epsilon+smooth(iparent+2))**3   
-                      
-             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-C
-               pos = pos+1 
-             End do 
-             ipos = ipos + coeffraf
-C
-        End do     
-C
-C
-        y(1:nc)=ytemp(1:nc)                                 
-        deallocate(ytemp)                
-        deallocate(diff, diff2, diff3)
-        
-        deallocate(ak,ck)
-        
-      Return
-      End Subroutine weno1dnew
-      
-C     **************************************************************************  
-CCC   Subroutine weno1d
-C     ************************************************************************** 
-C 
-      Subroutine weno1d(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
-CCC   using piecewise parabolic method  
-CCC   on a child grid (vector y) from its parent grid (vector x).
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc
-      Real, Dimension(np) :: x
-      Real, Dimension(nc) :: y
-      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
-      integer :: i1,jj
-      Real :: xpmin,cavg,a,b
-C      
-      Real :: xrmin,xrmax,am3,s2,s1
-      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2
-      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
-      INTEGER :: diffmod
-      REAL :: invcoeffraf
-      integer :: s,l,k
-      integer :: etan, etap
-      real :: delta0, delta1,sumdelta
-      real :: epsilon
-      parameter (epsilon = 1.D-8)
-C      
-      coeffraf = nint(ds_parent/ds_child)
-C
-      If (coeffraf == 1) Then
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-          return
-      End If
-      invcoeffraf = ds_child/ds_parent
-            
-C      
-      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-      ypos = s_child
-C
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-      locind_parent_last = 1 +
-     &      agrif_ceiling((ypos +(nc - 1)
-     &      *ds_child - s_parent)/ds_parent)
-C
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-C     
-      Allocate( diff(coeffraf))
-C      
-      diff(1)=0.5*invcoeffraf
-      do i=2,coeffraf
-         diff(i) = diff(i-1)+invcoeffraf
-      enddo
-C
-      if( locind_parent_last+2 <= np ) then
-           nmax = locind_parent_last+2   
-      else if( locind_parent_last+1 <= np ) then
-           nmax = locind_parent_last+1
-      else
-           nmax = locind_parent_last 
-      endif     
-C      
-      if(locind_parent_left-1 >= 1) then
-          nmin = locind_parent_left-1
-      else 
-          nmin = locind_parent_left
-      endif    
-C 
-      Do i = nmin+1,nmax
-         slope(i) = (x(i) - x(i-1))
-      Enddo 
-C
-        diffmod = 0
-        IF (mod(coeffraf,2) == 0) diffmod = 1           
-C
-        ipos = i1
-C               
-        Do iparent = locind_parent_left,locind_parent_last       
-             pos=1
-            delta0=1./(epsilon+slope(iparent  )**2)**2
-            delta1=1./(epsilon+slope(iparent+1)**2)**2
-            sumdelta = 1./(delta0+delta1)             
-             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-C                              
-          ytemp(jj) = x(iparent)+(diff(pos)-0.5)*(
-     &                delta0*slope(iparent)+
-     &                delta1*slope(iparent+1))*sumdelta
-               pos = pos+1 
-             End do 
-             ipos = ipos + coeffraf
-C
-        End do     
-C
-C
-        y(1:nc)=ytemp(1:nc)                                 
-        deallocate(ytemp)                
-        deallocate(diff)
-        
-      Return
-      End Subroutine weno1d
-                 
-C                              
-C     **************************************************************************  
-CCC   Subroutine eno1d
-C     ************************************************************************** 
-C 
-      Subroutine eno1d(x,y,np,nc,
-     &                    s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   ---- p 163-164 Computational gasdynamics ----
-CCC   Subroutine to do a 1D interpolation 
-CCC   using piecewise polynomial ENO reconstruction technique  
-CCC   on a child grid (vector y) from its parent grid (vector x).
-CC    Method:
-C
-C     Declarations:
-C
-      Implicit none
-C        
-C     Arguments
-      Integer             :: np,nc      
-      Real, Dimension(np) :: x      
-      Real, Dimension(nc) :: y
-      Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
-C
-C     Local scalars
-      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
-      Integer :: ipos,pos
-      Real    :: ypos,xi
-      integer :: i1,jj
-      Real :: xpmin,cavg
-C 
-      Real, Dimension(3,np) :: dd,c
-      Integer :: left
-C           
-      Real, DImension(1:np+1) :: xhalf
-      Real, Dimension(:,:),Allocatable  :: Xbar 
-      INTEGER :: diffmod     
-C
-      coeffraf = nint(ds_parent/ds_child)
-C      
-      If (coeffraf == 1) Then
-          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
-          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
-          return
-      End If     
-      
-      diffmod = 0
-      IF (mod(coeffraf,2) == 0) diffmod = 1  
-C      
-      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
-      ypos = s_child  
-      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
-      locind_parent_last = 1 +
-     &      agrif_ceiling((ypos +(nc - 1) *ds_child - 
-     &      s_parent)/ds_parent)       
-      xpmin = s_parent + (locind_parent_left-1)*ds_parent      
-      i1 = 1+agrif_int((xpmin-s_child)/ds_child)           
-C      
-      xhalf(np+1) = np + 0.5
-      Do i = 1,np
-          xhalf(i) = i - 0.5
-      Enddo
-C
-C compute divided differences
-C
-      dd(1,1:np) = x(1:np)
-      dd(2,1:np-1) = 0.5*( dd(1,2:np) - dd(1,1:np-1) )
-      dd(3,1:np-2) = (1./3.)*( dd(2,2:np-1) - dd(2,1:np-2) )
-C
-      Allocate( Xbar( coeffraf,2 ) )
-      xi = 0.5
-      Do i = 1,coeffraf
-        Xbar(i,1) = (i-1)*ds_child/ds_parent - xi
-        Xbar(i,2) = i*ds_child/ds_parent - xi
-      Enddo
-C
-      ipos = i1
-C           
-      DO i = locind_parent_left,locind_parent_last           
-         left = i           
-         do jj = 2,3
-             If(abs(dd(jj,left)) .gt. abs(dd(jj,left-1)))
-     &               left = left-1            
-         enddo
-C           
-C  convert to Taylor series form
-C
-         Call Taylor(i,xhalf(left:left+2),dd(1:3,left),c(1:3,i))
-      ENDDO     
-C
-C evaluate the reconstruction on each cell
-C
-       DO i = locind_parent_left,locind_parent_last  
-C
-         cavg = 0.
-         pos = 1.            
-C         
-         Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-           ytemp(jj) =(c(1,i)*(Xbar(pos,2)-Xbar(pos,1))
-     &                +c(2,i)*(Xbar(pos,2)*Xbar(pos,2)-
-     &                         Xbar(pos,1)*Xbar(pos,1))
-     &                +c(3,i)*(Xbar(pos,2)*Xbar(pos,2)*Xbar(pos,2)-
-     &                         Xbar(pos,1)*Xbar(pos,1)*Xbar(pos,1)))
-     &                         *coeffraf
-           cavg = cavg + ytemp(jj)
-           pos = pos+1
-         Enddo                
-         ipos = ipos + coeffraf                 
-      ENDDO
-C
-      y(1:nc)=ytemp(1:nc)                                            
-      deallocate(ytemp,Xbar)                 
-C      
-      Return       
-      End Subroutine eno1d
-C 
-C      
-C     **************************************************************************  
-CCC   Subroutine taylor
-C     ************************************************************************** 
-C       
-      subroutine taylor(ind,xhalf,dd,c)      
-C      
-      Integer :: ind
-      real,dimension(3) :: dd,c     
-      real,dimension(0:3,0:3) :: d 
-      real,dimension(3) :: xhalf    
-      integer ::i,j
-C      
-C
-      d(0,0:3)=1.
-      do i = 1,3
-         d(i,0)=(ind-xhalf(i))*d(i-1,0)
-      enddo  
-C      
-      do i = 1,3
-         do j = 1,3-i
-           d(i,j) = d(i,j-1) + (ind-xhalf(i+j))*d(i-1,j)
-         enddo
-      enddo
-C         
-      do j = 1,3        
-         c(j) = 0.
-         do i=0,3-j
-            c(j) = c(j) + d(i,j)*dd(i+j)         
-         enddo
-      enddo
-C      
-      end subroutine taylor    
-      
-      
-      REAL FUNCTION vanleer(tab)
-      REAL, DIMENSION(3) :: tab
-       real res1
-       real p1,p2,p3
-       
-       p1=(tab(3)-tab(1))/2.
-       p2=2.*(tab(2)-tab(1))
-       p3=2.*(tab(3)-tab(2))
-       
-       if ((p1>0.).AND.(p2>0.).AND.(p3>0)) then
-          res1=minval((/p1,p2,p3/))
-       elseif ((p1<0.).AND.(p2<0.).AND.(p3<0)) then
-          res1=maxval((/p1,p2,p3/))
-       else
-          res1=0.
-       endif
-          
-          vanleer = res1   
-      
-      
-      END FUNCTION vanleer 
-
-C      
-      End Module Agrif_Interpbasic
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90	(revision 5682)
@@ -0,0 +1,1464 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_InterpBasic
+!>
+!> Contains different procedures of interpolation (linear,lagrange, spline,...) used in
+!! the Agrif_Interpolation module.
+!
+module Agrif_InterpBasic
+!
+    use Agrif_Types
+!
+    implicit none
+!
+    real, dimension(5,Agrif_MaxRaff,3)      :: tabppm
+    real, dimension(Agrif_MaxRaff)          :: tabdiff2, tabdiff3
+    real, dimension(:),   allocatable       :: tabtest4
+    real, dimension(:,:), allocatable       :: coeffparent
+    integer, dimension(:,:), allocatable    :: indparent
+    integer, dimension(:,:), allocatable    :: indparentppm, indchildppm
+    integer, dimension(:), allocatable      :: indparentppm_1d, indchildppm_1d
+!
+    private :: Agrif_limiter_vanleer
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_basicinterp_linear1D
+!
+!> Linear 1D interpolation on a child grid (vector y) from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicinterp_linear1D ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(in)     :: x            !< Coarse input data from parent
+    real, dimension(nc), intent(out)    :: y            !< Fine output data to child
+    integer,             intent(in)     :: np           !< Length of input array
+    integer,             intent(in)     :: nc           !< Length of output array
+    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
+    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
+    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
+    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
+!
+    integer :: i, coeffraf, locind_parent_left
+    real    :: globind_parent_left, globind_parent_right
+    real    :: invds, invds2, ypos, ypos2, diff
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if ( coeffraf == 1 ) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    ypos = s_child
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    globind_parent_left  = s_parent + (locind_parent_left - 1)*ds_parent
+    globind_parent_right = globind_parent_left + ds_parent
+!
+    invds  = 1./ds_parent
+    invds2 = ds_child/ds_parent
+    ypos2 = ypos*invds
+    globind_parent_right = globind_parent_right*invds
+!
+    do i = 1,nc-1
+!
+        if (ypos2 > globind_parent_right) then
+            locind_parent_left = locind_parent_left + 1
+            globind_parent_right = globind_parent_right + 1.
+            ypos2 = ypos*invds+(i-1)*invds2
+        endif
+!
+        diff = globind_parent_right - ypos2
+        y(i) = (diff*x(locind_parent_left) + (1.-diff)*x(locind_parent_left+1))
+        ypos2 = ypos2 + invds2
+!
+    enddo
+!
+    ypos = s_child + (nc-1)*ds_child
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+!
+    if (locind_parent_left == np) then
+        y(nc) = x(np)
+    else
+        globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
+        y(nc) = ((globind_parent_left + ds_parent - ypos)*x(locind_parent_left)  &
+                           + (ypos - globind_parent_left)*x(locind_parent_left+1))*invds
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicinterp_linear1D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Linear1dPrecompute2d
+!
+!> Computes 2D coefficients and index for a linear 1D interpolation on a child grid (vector y)
+!! from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Linear1dPrecompute2d ( np2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: np,nc,np2
+    real,    intent(in) :: s_parent, s_child
+    real,    intent(in) :: ds_parent, ds_child
+    integer, intent(in) :: dir
+!
+    integer :: i,coeffraf,locind_parent_left,inc,inc1,inc2
+    integer, dimension(:,:), allocatable :: indparent_tmp
+    real, dimension(:,:), allocatable :: coeffparent_tmp
+    real    :: ypos,globind_parent_left,globind_parent_right
+    real    :: invds, invds2, invds3
+    real :: ypos2,diff
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    ypos = s_child
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
+    globind_parent_right = globind_parent_left + ds_parent
+!
+    invds = 1./ds_parent
+    invds2 = ds_child/ds_parent
+    invds3 = 0.5/real(coeffraf)
+    ypos2 = ypos*invds
+    globind_parent_right=globind_parent_right*invds
+!
+    if (.not.allocated(indparent)) then
+        allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
+    else
+        if ( size(indparent,1) < nc*np2 ) then
+            allocate(coeffparent_tmp(size(indparent,1),size(indparent,2)))
+            allocate(  indparent_tmp(size(indparent,1),size(indparent,2)))
+            coeffparent_tmp = coeffparent
+            indparent_tmp   = indparent
+            deallocate(indparent,coeffparent)
+            allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
+            coeffparent(1:size(coeffparent_tmp,1),1:size(coeffparent_tmp,2)) = coeffparent_tmp
+            indparent(  1:size(indparent_tmp,  1),1:size(indparent_tmp,  2)) = indparent_tmp
+            deallocate(indparent_tmp,coeffparent_tmp)
+        endif
+    endif
+!
+    do i = 1,nc-1
+!
+        if (ypos2 > globind_parent_right) then
+            locind_parent_left = locind_parent_left + 1
+            globind_parent_right = globind_parent_right + 1.
+            ypos2 = ypos*invds+(i-1)*invds2
+        endif
+!
+        diff = globind_parent_right - ypos2
+        diff = invds3*nint(2*coeffraf*diff)
+        indparent(i,dir) = locind_parent_left
+        coeffparent(i,dir) = diff
+        ypos2 = ypos2 + invds2
+!
+    enddo
+!
+    ypos = s_child + (nc-1)*ds_child
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+    if (locind_parent_left == np) then
+        indparent(nc,dir) = locind_parent_left-1
+        coeffparent(nc,dir) = 0.
+    else
+        globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
+        indparent(nc,dir) = locind_parent_left
+        diff = (globind_parent_left + ds_parent - ypos) * invds
+        diff = invds3*nint(2*coeffraf*diff)
+        coeffparent(nc,dir) = diff
+    endif
+
+    do i=2, np2
+        inc  =  i*nc
+        inc1 = (i-1)*nc
+        inc2 = (i-2)*nc
+!CDIR ALTCODE
+        indparent(1+inc1:inc,dir) = indparent(1+inc2:inc1,dir)+np
+!CDIR ALTCODE
+        coeffparent(1+inc1:inc,dir) =coeffparent(1:nc,dir)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Linear1dPrecompute2d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Linear1dAfterCompute
+!
+!> Carries out a linear 1D interpolation on a child grid (vector y) from its parent grid (vector x)
+!! using precomputed coefficient and index.
+!---------------------------------------------------------------------------------------------------
+subroutine Linear1dAfterCompute ( x, y, np, nc, dir )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    integer,             intent(in)     :: dir
+!
+    integer :: i
+!
+!CDIR ALTCODE
+!CDIR NODEP
+    do i = 1,nc
+        y(i) = coeffparent(i,dir)  * x(MAX(indparent(i,dir),1)) + &
+           (1.-coeffparent(i,dir)) * x(indparent(i,dir)+1)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Linear1dAfterCompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Lagrange1d
+!
+!> Carries out a lagrange 1D interpolation on a child grid (vector y) from its parent grid
+!! (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Lagrange1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    integer :: i, coeffraf, locind_parent_left
+    real    :: ypos,globind_parent_left
+    real    :: deltax, invdsparent
+    real    :: t2,t3,t4,t5,t6,t7,t8
+!
+    if (np <= 2) then
+        call Agrif_basicinterp_linear1D(x,y,np,nc,s_parent,s_child,ds_parent,ds_child)
+        return
+    endif
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    invdsparent = 1./ds_parent
+    ypos = s_child
+!
+    do i = 1,nc
+!
+        locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+        globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
+
+        deltax = invdsparent*(ypos-globind_parent_left)
+        deltax = nint(coeffraf*deltax)/real(coeffraf)
+
+        ypos = ypos + ds_child
+        if (abs(deltax) <= 0.0001) then
+            y(i)=x(locind_parent_left)
+            cycle
+        endif
+!
+        t2 = deltax - 2.
+        t3 = deltax - 1.
+        t4 = deltax + 1.
+
+        t5 = -(1./6.)*deltax*t2*t3
+        t6 = 0.5*t2*t3*t4
+        t7 = -0.5*deltax*t2*t4
+        t8 = (1./6.)*deltax*t3*t4
+
+        y(i) = t5*x(locind_parent_left-1) + t6*x(locind_parent_left)    &
+              +t7*x(locind_parent_left+1) + t8*x(locind_parent_left+2)
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Lagrange1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Constant1d
+!
+!> Carries out a constant 1D interpolation on a child grid (vector y) from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Constant1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    integer :: i, coeffraf, locind_parent
+    real    :: ypos
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent:locind_parent+nc-1)
+        return
+    endif
+!
+    ypos = s_child
+!
+    do i = 1,nc
+!
+        locind_parent = 1 + nint((ypos - s_parent)/ds_parent)
+        y(i) = x(locind_parent)
+        ypos = ypos + ds_child
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Constant1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Linear1dConserv
+!
+!> Carries out a conservative linear 1D interpolation on a child grid (vector y) from its parent 
+!! grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Linear1dConserv ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    real, dimension(:), allocatable :: ytemp
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    real    :: ypos,xdiffmod,xpmin,xpmax,slope
+    integer :: i1,i2,ii
+    integer :: diffmod
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+
+    xdiffmod = real(diffmod)/2.
+
+    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+!
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    xpmax = s_parent + (locind_parent_last-1)*ds_parent
+
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+    i2 = 1+agrif_int((xpmax-s_child)/ds_child)
+
+    i = i1
+
+    if (locind_parent_left == 1) then
+        slope = (x(locind_parent_left+1)-x(locind_parent_left))/(coeffraf)
+    else
+        slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+    endif
+
+    do ii = i-coeffraf/2+diffmod,i+coeffraf/2
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+    enddo
+
+    locind_parent_left = locind_parent_left + 1
+
+    do i = i1+coeffraf, i2-coeffraf,coeffraf
+        slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+        do ii = i-coeffraf/2+diffmod,i+coeffraf/2
+            ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo
+        locind_parent_left = locind_parent_left + 1
+    enddo
+
+    i = i2
+
+    if (locind_parent_left == np) then
+        slope = (x(locind_parent_left)-x(locind_parent_left-1))/(coeffraf)
+    else
+        slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+    endif
+
+    do ii = i-coeffraf/2+diffmod,nc
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+    enddo
+!
+    y(1:nc)=ytemp(1:nc)
+!
+    deallocate(ytemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Linear1dConserv
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Linear1dConservLim
+!
+!> Carries out a limited conservative linear 1D interpolation on a child grid (vector y) from
+!! its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Linear1dConservLim ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    real, dimension(:), allocatable :: ytemp
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    real    :: ypos,xdiffmod,xpmin,xpmax,slope
+    integer :: i1,i2,ii
+    integer :: diffmod
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    if (coeffraf /= 3) then
+        print *,'Linear1dConservLim not ready for refinement ratio = ', coeffraf
+        stop
+    endif
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+
+    xdiffmod = real(diffmod)/2.
+
+    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+!
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    xpmax = s_parent + (locind_parent_last-1)*ds_parent
+
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+    i2 = 1+agrif_int((xpmax-s_child)/ds_child)
+
+    i = i1
+
+    if (locind_parent_left == 1) then
+        slope=0.
+    else
+        slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf
+    endif
+
+    do ii = i-coeffraf/2+diffmod,i+coeffraf/2
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+    enddo
+
+    locind_parent_left = locind_parent_left + 1
+
+    do i = i1+coeffraf, i2-coeffraf,coeffraf
+        slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+            ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo
+        locind_parent_left = locind_parent_left + 1
+    enddo
+
+    i = i2
+
+    if (locind_parent_left == np) then
+        slope=0.
+    else
+        slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf
+    endif
+
+    do ii=i-coeffraf/2+diffmod,nc
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+    enddo
+!
+    y(1:nc) = ytemp(1:nc)
+!
+    deallocate(ytemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Linear1dConservLim
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine PPM1d
+!
+!> Carries out a 1D interpolation and apply monotonicity constraints using piecewise parabolic
+!! method (PPM) on a child grid (vector y) from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine PPM1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    integer :: iparent,ipos,pos,nmin,nmax
+    real    :: ypos
+    integer :: i1,jj
+    real :: xpmin,a
+!
+    real, dimension(np) :: xl,delta,a6,slope
+    integer :: diffmod
+    real :: invcoeffraf
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    invcoeffraf = ds_child/ds_parent
+!
+    if( .not. allocated(tabtest4) ) then
+        allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
+    else
+        if (size(tabtest4) < nc+4*coeffraf+1) then
+            deallocate( tabtest4 )
+            allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
+        endif
+    endif
+!
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1)*ds_child - s_parent)/ds_parent)
+!
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+!CDIR NOVECTOR
+    do i=1,coeffraf
+        tabdiff2(i) = (real(i)-0.5)*invcoeffraf
+    enddo
+!
+    a = invcoeffraf**2
+    tabdiff3(1) = (1./3.)*a
+    a = 2.*a
+!CDIR NOVECTOR
+    do i=2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+    enddo
+!
+    if      ( locind_parent_last+2 <= np ) then
+        nmax = locind_parent_last+2
+    else if ( locind_parent_last+1 <= np ) then
+        nmax = locind_parent_last+1
+    else
+        nmax = locind_parent_last
+    endif
+!
+    if (locind_parent_left-1 >= 1) then
+        nmin = locind_parent_left-1
+    else
+        nmin = locind_parent_left
+    endif
+!
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+    do i = nmin,nmax
+        slope(i) = x(i) - x(i-1)
+    enddo
+!
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+    do i = nmin+1,nmax-1
+        xl(i)= 0.5*(x(i-1)+x(i))-0.08333333333333*(slope(i+1)-slope(i-1))
+    enddo
+!
+! apply parabolic monotonicity
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+    do i = locind_parent_left,locind_parent_last
+        delta(i) = xl(i+1) - xl(i)
+        a6(i) = 6.*x(i)-3.*(xl(i) +xl(i+1))
+    enddo
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+!
+    ipos = i1
+!
+    do iparent = locind_parent_left,locind_parent_last
+        pos=1
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+        do jj = ipos-coeffraf/2+diffmod,ipos+coeffraf/2
+!
+            tabtest4(jj) = xl(iparent) + tabdiff2(pos) *  (delta(iparent)+a6(iparent)) &
+                                       - tabdiff3(pos) *  a6(iparent)
+            pos = pos+1
+        enddo
+        ipos = ipos + coeffraf
+    enddo
+!
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+    y(1:nc) = tabtest4(1:nc)
+!---------------------------------------------------------------------------------------------------
+end subroutine PPM1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine PPM1dPrecompute2d
+!
+!> Computes 2D coefficients and index for a 1D interpolation using piecewise parabolic method
+!---------------------------------------------------------------------------------------------------
+subroutine PPM1dPrecompute2d ( np2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np2, np, nc
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+    integer,             intent(in)     :: dir
+!
+    integer, dimension(:,:), allocatable :: indparent_tmp
+    integer, dimension(:,:), allocatable :: indchild_tmp
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    integer :: iparent,ipos,pos
+    real    :: ypos
+    integer :: i1,jj
+    real :: xpmin,a
+!
+    integer :: diffmod
+    real :: invcoeffraf
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    invcoeffraf = ds_child/ds_parent
+!
+    if (.not.allocated(indparentppm)) then
+        allocate(indparentppm(np2*nc,3),indchildppm(np2*nc,3))
+    else
+        if (size(indparentppm,1) < np2*nc) then
+            allocate(   &
+                indparent_tmp(size(indparentppm,1),size(indparentppm,2)), &
+                indchild_tmp( size(indparentppm,1),size(indparentppm,2)))
+            indparent_tmp = indparentppm
+            indchild_tmp  = indchildppm
+            deallocate(indparentppm,indchildppm)
+            allocate(indparentppm(np2*nc,3),indchildppm(np2*nc,3))
+            indparentppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2)) = indparent_tmp
+            indchildppm( 1:size(indparent_tmp,1),1:size(indparent_tmp,2)) = indchild_tmp
+            deallocate(indparent_tmp,indchild_tmp)
+        endif
+    endif
+
+    if (.not.allocated(indparentppm_1d)) then
+        allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),    &
+                 indchildppm_1d( -2*coeffraf:nc+2*coeffraf))
+    else
+        if (size(indparentppm_1d) < nc+4*coeffraf+1) then
+            deallocate(indparentppm_1d,indchildppm_1d)
+            allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),&
+                     indchildppm_1d( -2*coeffraf:nc+2*coeffraf))
+        endif
+    endif
+!
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1)*ds_child - s_parent)/ds_parent)
+!
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+    do i = 1,coeffraf
+        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+    enddo
+!
+    a = invcoeffraf**2
+    tabdiff3(1) = (1./3.)*a
+    a = 2.*a
+!CDIR ALTCODE
+    do i = 2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+    enddo
+
+!CDIR ALTCODE
+    do i = 1,coeffraf
+        tabppm(1,i,dir) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
+        tabppm(2,i,dir) = 0.08333333333333*(7.-26.*tabdiff2(i)+18.*tabdiff3(i))
+        tabppm(3,i,dir) = 0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
+        tabppm(4,i,dir) = 0.08333333333333*(-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
+        tabppm(5,i,dir) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i))
+    enddo
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+!
+    ipos = i1
+!
+    do iparent = locind_parent_left,locind_parent_last
+        pos=1
+!CDIR ALTCODE
+        do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+            indparentppm_1d(jj) = iparent-2
+            indchildppm_1d(jj)  = pos
+            pos = pos+1
+        enddo
+        ipos = ipos + coeffraf
+    enddo
+!
+    do i = 1,np2
+        indparentppm(1+(i-1)*nc:i*nc,dir) = indparentppm_1d(1:nc) + (i-1)*np
+        indchildppm (1+(i-1)*nc:i*nc,dir) = indchildppm_1d (1:nc)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine PPM1dPrecompute2d
+!===================================================================================================
+!
+!===================================================================================================
+!subroutine PPM1dPrecompute(np,nc,&
+!                    s_parent,s_child,ds_parent,ds_child)
+!!
+!!CC   Description:
+!!CC   subroutine to compute coefficient and index for  a 1D interpolation
+!!CC   using piecewise parabolic method
+!!C    Method:
+!!
+!!     Declarations:
+!!
+!      Implicit none
+!!
+!!     Arguments
+!      Integer             :: np,nc
+!!      Real, Dimension(:),Allocatable :: ytemp
+!      Real                :: s_parent,s_child,ds_parent,ds_child
+!!
+!!     Local scalars
+!      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+!      Integer :: iparent,ipos,pos,nmin,nmax
+!      Real    :: ypos
+!      integer :: i1,jj
+!      Real :: xpmin,a
+!!
+!      Real :: xrmin,xrmax,am3,s2,s1
+!      Real, Dimension(np) :: xl,delta,a6,slope
+!!      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
+!      INTEGER :: diffmod
+!      REAL :: invcoeffraf
+!!
+!      coeffraf = nint(ds_parent/ds_child)
+!!
+!      If (coeffraf == 1) Then
+!          return
+!      End If
+!      invcoeffraf = ds_child/ds_parent
+!!
+!
+!      if (.not.allocated(indparentppm)) then
+!      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),&
+!         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
+!      else
+!      if (size(indparentppm,1)<nc+4*coeffraf+1) then
+!      deallocate(indparentppm,indchildppm)
+!      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),&
+!         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
+!      endif
+!      endif
+!
+!      ypos = s_child
+!!
+!      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+!      locind_parent_last = 1 +&
+!      agrif_ceiling((ypos +(nc - 1)&
+!      *ds_child - s_parent)/ds_parent)
+!!
+!      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+!      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!!
+!!
+!
+!      Do i=1,coeffraf
+!        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+!      EndDo
+!
+!      a = invcoeffraf**2
+!      tabdiff3(1) = (1./3.)*a
+!      a=2.*a
+!!CDIR ALTCODE
+!!!!CDIR SHORTLOOP
+!      Do i=2,coeffraf
+!        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+!      EndDo
+!
+!!CDIR ALTCODE
+!!!!CDIR SHORTLOOP
+!      Do i=1,coeffraf
+!      tabppm(1,i,1) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
+!      tabppm(2,i,1) = 0.08333333333333*&
+!              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
+!      tabppm(3,i,1) =0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
+!      tabppm(4,i,1) = 0.08333333333333*&
+!              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
+!      tabppm(5,i,1) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i))
+!      End Do
+!!
+!!
+!        diffmod = 0
+!       IF (mod(coeffraf,2) == 0) diffmod = 1
+!!
+!        ipos = i1
+!!
+!        Do iparent = locind_parent_left,locind_parent_last
+!             pos=1
+!!CDIR ALTCODE
+!!CDIR SHORTLOOP
+!             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+!         indparentppm(jj,1) = iparent-2
+!         indchildppm(jj,1) = pos
+!               pos = pos+1
+!             End do
+!             ipos = ipos + coeffraf
+!!
+!        End do
+!
+!      Return
+!      End subroutine ppm1dprecompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine PPM1dAfterCompute
+!
+! Carries out a 1D interpolation and apply monotonicity constraints using piecewise parabolic
+! method (PPM) on a child grid (vector y) from its parent grid (vector x).
+! Use precomputed coefficient and index.
+!---------------------------------------------------------------------------------------------------
+subroutine PPM1dAfterCompute ( x, y, np, nc, dir )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    integer,             intent(in)     :: np, nc
+    integer,             intent(in)     :: dir
+!
+    integer :: i
+!
+    do i = 1,nc
+        y(i) = tabppm(1,indchildppm(i,dir),dir) * x(indparentppm(i,dir)  ) + &
+               tabppm(2,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+1) + &
+               tabppm(3,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+2) + &
+               tabppm(4,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+3) + &
+               tabppm(5,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+4)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine PPM1dAfterCompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine weno1d
+!
+! Carries out a 1D interpolation and apply monotonicity constraints
+! using WENO method on a child grid (vector y) from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+!subroutine weno1dnew ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+!
+!CC   Description:
+!CC   subroutine to do a 1D interpolation and apply monotonicity constraints
+!CC   using piecewise parabolic method
+!CC   on a child grid (vector y) from its parent grid (vector x).
+!C    Method:
+!
+!     Declarations:
+!
+!      Implicit none
+!
+!     Arguments
+!      Integer             :: np,nc
+!      Real, Dimension(np) :: x
+!      Real, Dimension(nc) :: y
+!      Real, Dimension(:),Allocatable :: ytemp
+!      Real                :: s_parent,s_child,ds_parent,ds_child
+!
+!     Local scalars
+!      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+!      Integer :: iparent,ipos,pos,nmin,nmax
+!      Real    :: ypos
+!      integer :: i1,jj
+!      Real :: xpmin,cavg,a,b
+!
+!      Real :: xrmin,xrmax,am3,s2,s1
+!      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2,smooth
+!      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
+!      INTEGER :: diffmod
+!      REAL :: invcoeffraf
+!      integer :: s,l,k
+!      integer :: etan, etap
+!      real :: delta0, delta1, delta2
+!      real :: epsilon
+!      parameter (epsilon = 1.D-8)
+!      real, dimension(:,:), allocatable :: ak, ck
+!
+!      coeffraf = nint(ds_parent/ds_child)
+!
+!      If (coeffraf == 1) Then
+!          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+!          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+!          return
+!      End If
+!      invcoeffraf = ds_child/ds_parent
+!      Allocate(ak(0:1,coeffraf))
+!      Allocate(ck(0:1,coeffraf))
+!
+!
+!      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+!      ypos = s_child
+!
+!      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+!      locind_parent_last = 1 +&
+!      agrif_ceiling((ypos +(nc - 1)&
+!      *ds_child - s_parent)/ds_parent)
+!
+!      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+!      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+!      Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) )
+!
+!      diff(1)=0.5*invcoeffraf
+!      do i=2,coeffraf
+!         diff(i) = diff(i-1)+invcoeffraf
+!      enddo
+!
+!      ak = 0.
+!      ck = 0.
+!
+!      do i=1,coeffraf
+!         do k=0,1
+!         do s=0,2
+!         do l=0,2
+!           if (l /= s) then
+!            ak(k,i) = ak(k,i)+(diff(i)-(k-l+1.))
+!           endif
+!         enddo
+!         enddo
+!         enddo
+!
+!         etap = 0
+!         etan = 0
+!         do k=0,1
+!          if (ak(k,i) > 0) then
+!            etap = etap+1
+!          else if (ak(k,i) < 0) then
+!            etan = etan + 1
+!          endif
+!         enddo
+!
+!         do k=0,1
+!           if (ak(k,i) == 0) then
+!            Ck(k,i) = 1.
+!           else if (ak(k,i) > 0) then
+!            Ck(k,i) = 1./(etap * ak(k,i))
+!           else
+!            Ck(k,i) = -1./(etan * ak(k,i))
+!           endif
+!         enddo
+!      enddo
+!
+!
+!      a = 0.
+!      b = invcoeffraf
+!      Do i=1,coeffraf
+!         diff2(i) = 0.5*(b*b - a*a)
+!         diff3(i) = (1./3.)*(b*b*b - a*a*a)
+!         a = a + invcoeffraf
+!         b = b + invcoeffraf
+!      End do
+!
+!      if( locind_parent_last+2 <= np ) then
+!           nmax = locind_parent_last+2
+!      elseif( locind_parent_last+1 <= np ) then
+!           nmax = locind_parent_last+1
+!      else
+!           nmax = locind_parent_last
+!      endif
+!
+!      if(locind_parent_left-2 >= 1) then
+!          nmin = locind_parent_left-2
+!      elseif(locind_parent_left-1 >= 1) then
+!          nmin = locind_parent_left-1
+!      else
+!          nmin = locind_parent_left
+!      endif
+!
+!      Do i = nmin+1,nmax
+!         slope(i) = (x(i) - x(i-1))
+!      Enddo
+!      DO i=nmin+2,nmax
+!        smooth(i) = 0.5*(slope(i)**2+slope(i-1)**2)&
+!       +(slope(i)-slope(i-1))**2
+!      enddo
+!
+!        diffmod = 0
+!        IF (mod(coeffraf,2) == 0) diffmod = 1
+!
+!        ipos = i1
+!
+!        Do iparent = locind_parent_left,locind_parent_last
+!             pos=1
+!
+!            delta0=1./(epsilon+smooth(iparent  ))**3
+!            delta1=1./(epsilon+smooth(iparent+1))**3
+!            delta2=1./(epsilon+smooth(iparent+2))**3
+!
+!             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+!
+!               pos = pos+1
+!             End do
+!             ipos = ipos + coeffraf
+!
+!        End do
+!
+!
+!        y(1:nc)=ytemp(1:nc)
+!        deallocate(ytemp)
+!        deallocate(diff, diff2, diff3)
+!
+!        deallocate(ak,ck)
+!
+!      Return
+!      End subroutine weno1dnew
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine WENO1d
+!
+!> Carries out a a 1D interpolation using WENO method on a child grid (vector y) from its parent 
+!! grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine WENO1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    real, dimension(:), allocatable :: ytemp
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    integer :: iparent,ipos,pos,nmin,nmax
+    real    :: ypos
+    integer :: i1,jj
+    real :: xpmin
+!
+    real, dimension(np) :: slope
+    real, dimension(:), allocatable  :: diff
+    integer :: diffmod
+    real :: invcoeffraf
+    real :: delta0, delta1, sumdelta
+    real, parameter :: epsilon = 1.d-8
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    invcoeffraf = ds_child/ds_parent
+!
+    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+!
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+    allocate(diff(coeffraf))
+    diff(1) = 0.5*invcoeffraf
+    do i = 2,coeffraf
+        diff(i) = diff(i-1)+invcoeffraf
+    enddo
+!
+    if ( locind_parent_last+2 <= np ) then
+        nmax = locind_parent_last+2
+    else if ( locind_parent_last+1 <= np ) then
+        nmax = locind_parent_last+1
+      else
+        nmax = locind_parent_last
+    endif
+!
+    if(locind_parent_left-1 >= 1) then
+        nmin = locind_parent_left-1
+    else
+        nmin = locind_parent_left
+    endif
+!
+    do i = nmin+1,nmax
+        slope(i) = x(i) - x(i-1)
+    enddo
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+!
+    ipos = i1
+!
+    do iparent = locind_parent_left,locind_parent_last
+        pos=1
+        delta0 = 1./(epsilon+slope(iparent  )**2)**2
+        delta1 = 1./(epsilon+slope(iparent+1)**2)**2
+        sumdelta = 1./(delta0+delta1)
+        do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+            ytemp(jj) = x(iparent)+(diff(pos)-0.5)*( delta0*slope(iparent) + &
+                                                     delta1*slope(iparent+1))*sumdelta
+            pos = pos+1
+        enddo
+        ipos = ipos + coeffraf
+    enddo
+!
+    y(1:nc) = ytemp(1:nc)
+    deallocate(ytemp)
+    deallocate(diff)
+!---------------------------------------------------------------------------------------------------
+end subroutine WENO1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine ENO1d
+!
+!> Carries out a 1D interpolation using piecewise polynomial ENO reconstruction technique
+!! on a child grid (vector y) from its parent grid (vector x).
+!! \see ---- p 163-164 Computational gasdynamics ----
+!---------------------------------------------------------------------------------------------------
+subroutine ENO1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    integer :: ipos, pos
+    real    :: ypos,xi
+    integer :: i1,jj
+    real :: xpmin
+!
+    real, dimension(:),   allocatable  :: ytemp
+    real, dimension(:,:), allocatable  :: xbar
+    real, dimension(1:np+1)            :: xhalf
+    real, dimension(3,np)              :: dd, c
+    integer :: diffmod, left
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    end if
+
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+!
+    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+!
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+    do i = 1,np+1
+        xhalf(i) = i - 0.5
+    enddo
+!
+! Compute divided differences
+!
+    dd(1,1:np)   = x(1:np)
+    dd(2,1:np-1) = 0.5*( dd(1,2:np) - dd(1,1:np-1) )
+    dd(3,1:np-2) = (1./3.)*( dd(2,2:np-1) - dd(2,1:np-2) )
+!
+    allocate( xbar( coeffraf,2 ) )
+    xi = 0.5
+    do i = 1,coeffraf
+        xbar(i,1) = (i-1)*ds_child/ds_parent - xi
+        xbar(i,2) =  i   *ds_child/ds_parent - xi
+    enddo
+!
+    ipos = i1
+!
+    do i = locind_parent_left,locind_parent_last
+        left = i
+        do jj = 2,3
+            if(abs(dd(jj,left)) > abs(dd(jj,left-1))) left = left-1
+        enddo
+!
+!       convert to Taylor series form
+        call taylor(i,xhalf(left:left+2),dd(1:3,left),c(1:3,i))
+    enddo
+!
+! Evaluate the reconstruction on each cell
+!
+    do i = locind_parent_left,locind_parent_last
+!
+        pos = 1
+!
+        do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+            ytemp(jj) = ( c(1,i)*(xbar(pos,2)-xbar(pos,1))              &
+                        + c(2,i)*(xbar(pos,2)*xbar(pos,2) -             &
+                                  xbar(pos,1)*xbar(pos,1))              &
+                        + c(3,i)*(xbar(pos,2)*xbar(pos,2)*xbar(pos,2) - &
+                                  xbar(pos,1)*xbar(pos,1)*xbar(pos,1))  &
+                        ) * coeffraf
+            pos = pos+1
+        enddo
+        ipos = ipos + coeffraf
+!
+    enddo
+!
+    y(1:nc) = ytemp(1:nc)
+    deallocate(ytemp,xbar)
+!---------------------------------------------------------------------------------------------------
+end subroutine ENO1d
+!===================================================================================================
+!
+!     **************************************************************************  
+!CC   Subroutine ppm1d_lim
+!     ************************************************************************** 
+! 
+      Subroutine ppm1d_lim(x,y,np,nc,s_parent,s_child,ds_parent,ds_child) 
+!
+!CC   Description:
+!CC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+!CC   using piecewise parabolic method  
+!CC   on a child grid (vector y) from its parent grid (vector x).
+!C    Method:
+!
+!     Declarations:
+!
+      Implicit none
+!        
+!     Arguments
+      Integer             :: np,nc      
+      Real, Dimension(np) :: x      
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+!
+!     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,cavg,a,b
+!      
+      Real :: xrmin,xrmax,am3,s2,s1  
+      Real, Dimension(np) :: dela,xr,xl,delta,a6,slope,slope2
+      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
+      INTEGER :: diffmod
+!      
+      coeffraf = nint(ds_parent/ds_child)
+!
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If
+!      
+      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+      ypos = s_child  
+!
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+      locind_parent_last = 1 + &
+           agrif_ceiling((ypos +(nc - 1)  &
+           *ds_child - s_parent)/ds_parent)  
+!
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
+!     
+      Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) )
+!      
+         diff(:) = ds_child/ds_parent
+!      
+      Do i=1,coeffraf
+         a = real(i-1)*ds_child/ds_parent
+         b = real(i)*ds_child/ds_parent
+         diff2(i) = 0.5*(b*b - a*a)  
+         diff3(i) = (1./3.)*(b*b*b - a*a*a)
+      End do
+!
+      if( locind_parent_last+2 <= np ) then
+           nmax = locind_parent_last+2    
+      else if( locind_parent_last+1 <= np ) then
+           nmax = locind_parent_last+1
+      else
+           nmax = locind_parent_last 
+      endif     
+!      
+      if(locind_parent_left-1 >= 1) then
+          nmin = locind_parent_left-1
+      else 
+          nmin = locind_parent_left
+      endif    
+! 
+      Do i = nmin,nmax
+         slope(i) = x(i) - x(i-1)
+         slope2(i) = 2.*abs(slope(i))
+      Enddo
+!
+      Do i = nmin,nmax-1
+         dela(i) = 0.5 * ( slope(i) + slope(i+1) )
+! Van Leer slope limiter
+         dela(i) = min( abs(dela(i)),slope2(i), &
+                       slope2(i+1) )*sign(1.,dela(i))
+         IF( slope(i)*slope(i+1) <= 0. ) dela(i) = 0.
+      Enddo
+!
+      Do i = nmin,nmax-2
+         xr(i) = x(i) + (1./2.)*slope(i+1) + (-1./6.)*dela(i+1) &
+                                          + ( 1./6. )*dela(i)
+      Enddo
+!
+      Do i = nmin,nmax-2
+         xrmin = min(x(i),x(i+1))
+         xrmax = max(x(i),x(i+1))
+         xr(i) = min(xr(i),xrmax)
+         xr(i) = max(xr(i),xrmin)
+         xl(i+1) = xr(i)         
+      Enddo
+! apply parabolic monotonicity
+       Do i = locind_parent_left,locind_parent_last
+          If( ( (xr(i)-x(i))* (x(i)-xl(i)) ) .le. 0. ) then
+             xl(i) = x(i) 
+             xr(i) = x(i)
+          Endif          
+          delta(i) = xr(i) - xl(i)
+          am3 = 3. * x(i)
+          s1  = am3 - 2. * xr(i)
+          s2  = am3 - 2. * xl(i)
+          IF( delta(i) * (xl(i) - s1) .le. 0. ) xl(i) = s1
+          IF( delta(i) * (s2 - xr(i)) .le. 0. ) xr(i) = s2
+          delta(i) = xr(i) - xl(i)
+          a6(i) = 6.*x(i)-3.*(xl(i) +xr(i))
+!
+       End do   
+!
+        diffmod = 0
+       IF (mod(coeffraf,2) == 0) diffmod = 1           
+!
+        ipos = i1
+!               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+             cavg = 0.
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+!
+               ytemp(jj) = (diff(pos)*xl(iparent)   &
+                  + diff2(pos) &
+                  *  (delta(iparent)+a6(iparent)) &
+                  - diff3(pos)*a6(iparent))*coeffraf
+                              
+               cavg = cavg + ytemp(jj)
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+!
+        End do     
+!
+!
+        y(1:nc)=ytemp(1:nc)                                 
+        deallocate(ytemp)                
+        deallocate(diff, diff2, diff3)
+      Return
+      End Subroutine ppm1d_lim
+!===================================================================================================
+!  subroutine taylor
+!---------------------------------------------------------------------------------------------------
+subroutine taylor ( ind, xhalf, dd, c )
+!---------------------------------------------------------------------------------------------------
+    integer,            intent(in)  :: ind
+    real, dimension(3), intent(in)  :: xhalf
+    real, dimension(3), intent(in)  :: dd
+    real, dimension(3), intent(out) :: c
+!
+    real, dimension(0:3,0:3) :: d
+    integer                  :: i, j
+!
+    d(0,0:3) = 1.0
+    do i = 1,3
+        d(i,0) = (ind-xhalf(i))*d(i-1,0)
+    enddo
+!
+    do i = 1,3
+        do j = 1,3-i
+            d(i,j) = d(i,j-1) + (ind-xhalf(i+j))*d(i-1,j)
+        enddo
+    enddo
+!
+    do j = 1,3
+        c(j) = 0.
+        do i=0,3-j
+            c(j) = c(j) + d(i,j)*dd(i+j)
+        enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine taylor
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_limiter_vanleer
+!---------------------------------------------------------------------------------------------------
+real function Agrif_limiter_vanleer ( tab ) result(res)
+!---------------------------------------------------------------------------------------------------
+    real, dimension(3), intent(in) :: tab
+!
+    real :: p1, p2, p3
+
+    p1 =    (tab(3)-tab(1))/2.
+    p2 = 2.*(tab(2)-tab(1))
+    p3 = 2.*(tab(3)-tab(2))
+
+    if ((p1>0.).AND.(p2>0.).AND.(p3>0)) then
+        res = minval((/p1,p2,p3/))
+    elseif ((p1<0.).AND.(p2<0.).AND.(p3<0)) then
+        res = maxval((/p1,p2,p3/))
+    else
+        res=0.
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_limiter_vanleer
+!===================================================================================================
+!
+end module Agrif_InterpBasic
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F	(revision 5659)
+++ 	(revision )
@@ -1,186 +1,0 @@
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-      Module Agrif_link
-C
-CCC   Description:
-CCC   This module is used to link AGRIF files to the model
-C
-C     Modules used: 
-C
-c        external Agrif_InitValues
-c        external Agrif_detect
-C
-        external Agrif_InitWorkspace
-        external Agrif_probdim_modtype_def
-        external Agrif_clustering_def
-        external Agrif_comm_def
-C     Interface                       
-      INTERFACE
-      SUBROUTINE  Sub_Loop_Agrif_InvLoc(indloc,nprocloc,i,
-     &            indglob,njmppt,nimppt)
-      INTEGER :: indglob
-      INTEGER :: indloc
-      INTEGER :: nprocloc
-      INTEGER :: i
-
-      INTEGER, ALLOCATABLE, Dimension(:) :: njmppt
-      INTEGER, ALLOCATABLE, Dimension(:) :: nimppt
-      END SUBROUTINE
-      END INTERFACE
-      Interface
-         Subroutine Agrif_Set_numberofcells(Agrif_Gr)
-         Use Agrif_Types, Only : Agrif_grid
-         TYPE(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
-         End Subroutine Agrif_Set_numberofcells
-      End interface
-      Interface
-         Subroutine Agrif_Get_numberofcells(Agrif_Gr)
-         Use Agrif_Types, Only : Agrif_grid
-         TYPE(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
-         End Subroutine Agrif_Get_numberofcells
-      End interface
-      Interface
-         Subroutine Agrif_Allocationcalls(Agrif_Gr)
-         Use Agrif_Types, Only : Agrif_grid
-         TYPE(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
-         End Subroutine Agrif_Allocationcalls
-      End interface
-C   
-      End Module Agrif_link
-C     **************************************************************************
-CCC   Function Agrif_parent
-C        modify by conv. To use : un_parent = Agrif_Parent(un)
-C     **************************************************************************
-CCC   Function Agrif_Get_Coarse_Grid
-C        modify by conv. To use : un_Mygrid = Agrif_Get_Coarse_grid(un)
-C     **************************************************************************
-CCC   Function Agrif_Rhox
-C        modify by conv. To use : var = Agrif_Rhox()
-C                    REAL(Agrif_Curgrid % spaceref(1))
-C     **************************************************************************
-CCC   Function Agrif_Parent_Rhox
-C        modify by conv. To use : var = Agrif_Parent_Rhox()
-C                    REAL(Agrif_Curgrid % parent % spaceref(1))
-C     **************************************************************************
-CCC   Function Agrif_Irhox
-C        modify by conv. To use : var = Agrif_Parent_IRhox()
-C                    Agrif_Curgrid % spaceref(1)
-C     **************************************************************************
-CCC   Function Agrif_Parent_Irhox
-C        modify by conv. To use : var = Agrif_Parent_IRhox()
-C                    Agrif_Curgrid % parent % spaceref(1)
-C     **************************************************************************
-CCC   Function Agrif_Rhoy
-C        modify by conv. To use : var = Agrif_Rhoy()
-C                    REAL(Agrif_Curgrid % spaceref(2))
-C     **************************************************************************
-CCC   Function Agrif_Parent_Rhoy
-C        modify by conv. To use : var = Agrif_Parent_Rhoy()
-C                    REAL(Agrif_Curgrid % parent % spaceref(2))
-C     **************************************************************************
-CCC   Function Agrif_Irhoy
-C        modify by conv. To use : var = Agrif_Parent_IRhoy()
-C                    Agrif_Curgrid % spaceref(2)
-C     **************************************************************************
-CCC   Function Agrif_Parent_Irhoy
-C        modify by conv. To use : var = Agrif_Parent_IRhoy()
-C                    Agrif_Curgrid % parent % spaceref(2)
-C     **************************************************************************
-CCC   Function Agrif_Rhoz
-C        modify by conv. To use : var = Agrif_Rhoz()
-C                    REAL(Agrif_Curgrid % spaceref(3))
-C     **************************************************************************
-CCC   Function Agrif_Parent_Rhoz
-C        modify by conv. To use : var = Agrif_Parent_Rhoz()
-C                    REAL(Agrif_Curgrid % parent % spaceref(3))
-C     **************************************************************************
-CCC   Function Agrif_Irhoz
-C        modify by conv. To use : var = Agrif_Parent_IRhoz()
-C                    Agrif_Curgrid % spaceref(3)
-C     **************************************************************************
-CCC   Function Agrif_Parent_Irhoz
-C        modify by conv. To use : var = Agrif_Parent_IRhoz()
-C                    Agrif_Curgrid % parent % spaceref(3)
-C     **************************************************************************
-CCC   Function Agrif_NearCommonBorderX
-C        modify by conv. To use : var = Agrif_NearCommonBorderX()
-C                       AGRIF_CURGRID % NearRootBorder(1)
-C     **************************************************************************
-CCC   Function Agrif_NearCommonBorderY
-C        modify by conv. To use : var = Agrif_NearCommonBorderY()
-C                       AGRIF_CURGRID % NearRootBorder(2)
-C     **************************************************************************
-CCC   Function Agrif_NearCommonBorderZ
-C        modify by conv. To use : var = Agrif_NearCommonBorderZ()
-C                       AGRIF_CURGRID % NearRootBorder(3)
-C     **************************************************************************
-CCC   Function Agrif_DistantCommonBorderX
-C        modify by conv. To use : var = Agrif_DistantCommonBorderX()
-C                       AGRIF_CURGRID % DistantRootBorder(1)
-C     **************************************************************************
-CCC   Function Agrif_DistantCommonBorderY
-C        modify by conv. To use : var = Agrif_DistantCommonBorderY()
-C                       AGRIF_CURGRID % DistantRootBorder(2)
-C     **************************************************************************
-CCC   Function Agrif_DistantCommonBorderZ
-C        modify by conv. To use : var = Agrif_DistantCommonBorderZ()
-C                       AGRIF_CURGRID % DistantRootBorder(3)
-C     **************************************************************************
-CCC   Function Agrif_Nb_Step
-C        modify by conv. To use : var = Agrif_Nb_Step()
-C                          AGRIF_CURGRID % ngridstep
-C     **************************************************************************
-CCC   Function Agrif_Nb_Fine_Grids
-C        modify by conv. To use : var = Agrif_Nb_Fine_Grids()
-C                         Agrif_nbfixedgrids 
-C     **************************************************************************
-CCC   Function Agrif_Ix
-C        modify by conv. To use : var = Agrif_Ix()
-C                         Agrif_CURGRID % ix(1) 
-C     **************************************************************************
-CCC   Function Agrif_Parent_Ix
-C        modify by conv. To use : var = Agrif_Parent_Ix()
-C                        Agrif_CURGRID % parent % ix(1) 
-C     **************************************************************************
-CCC   Function Agrif_Iy
-C        modify by conv. To use : var = Agrif_Iy()
-C                        AGRIF_CURGRID % ix(2) 
-C     **************************************************************************
-CCC   Function Agrif_Parent_Iy
-C        modify by conv. To use : var = Agrif_Parent_Iy()
-C                       Agrif_CURGRID % parent % ix(2) 
-C     **************************************************************************
-CCC   Function Agrif_Iz
-C        modify by conv. To use : var = Agrif_Iz()
-C                      AGRIF_CURGRID % ix(3) 
-C     **************************************************************************
-CCC   Function Agrif_Parent_Iz
-C        modify by conv. To use : var = Agrif_Parent_Iz()
-C                     Agrif_CURGRID % parent % ix(3) 
-C     **************************************************************************
-CCC   Function Agrif_Get_grid_id
-C        modify by conv. To use : var = Agrif_Get_grid_id()
-C                    Agrif_CURGRID % grid_id
-C     **************************************************************************
-CCC   Function Agrif_Get_parent_id
-C        modify by conv. To use : var = Agrif_Get_parent_id()
-C                    Agrif_CURGRID % parent % grid_id
-C     **************************************************************************
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90	(revision 5682)
@@ -0,0 +1,181 @@
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Link
+!>
+!> This module is used to link AGRIF files to the model.
+!
+module Agrif_Link
+!
+    interface
+!
+        subroutine Agrif_clustering_def ( )
+!
+        end subroutine Agrif_clustering_def
+!
+        subroutine Agrif_Set_numberofcells ( Agrif_Gr )
+            use Agrif_Grids, only : Agrif_Grid
+            type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+        end subroutine Agrif_Set_numberofcells
+!
+        subroutine Agrif_Get_numberofcells ( Agrif_Gr )
+            use Agrif_Grids, only : Agrif_Grid
+            type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+        end subroutine Agrif_Get_numberofcells
+!
+    end interface
+!
+    abstract interface
+!
+        subroutine alloc_proc ( Agrif_Gr )
+            use Agrif_Grids, only : Agrif_Grid
+            type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+        end subroutine alloc_proc
+!
+        subroutine typedef_proc ( )
+            implicit none
+        end subroutine typedef_proc
+!
+    end interface
+    
+    procedure(alloc_proc)   :: Agrif_Allocationcalls
+    procedure(typedef_proc) :: Agrif_probdim_modtype_def
+!
+end module Agrif_Link
+!
+!===================================================================================================
+!  function Agrif_parent
+!        modify by conv. To use : un_parent = Agrif_Parent(un)
+!===================================================================================================
+!  function Agrif_Get_Coarse_Grid
+!        modify by conv. To use : un_Mygrid = Agrif_Get_Coarse_grid(un)
+!===================================================================================================
+!  function Agrif_Rhox
+!        modify by conv. To use : var = Agrif_Rhox()
+!                    REAL(Agrif_Curgrid % spaceref(1))
+!===================================================================================================
+!  function Agrif_Parent_Rhox
+!        modify by conv. To use : var = Agrif_Parent_Rhox()
+!                    REAL(Agrif_Curgrid % parent % spaceref(1))
+!===================================================================================================
+!  function Agrif_Irhox
+!        modify by conv. To use : var = Agrif_Parent_IRhox()
+!                    Agrif_Curgrid % spaceref(1)
+!===================================================================================================
+!  function Agrif_Parent_Irhox
+!        modify by conv. To use : var = Agrif_Parent_IRhox()
+!                    Agrif_Curgrid % parent % spaceref(1)
+!===================================================================================================
+!  function Agrif_Rhoy
+!        modify by conv. To use : var = Agrif_Rhoy()
+!                    REAL(Agrif_Curgrid % spaceref(2))
+!===================================================================================================
+!  function Agrif_Parent_Rhoy
+!        modify by conv. To use : var = Agrif_Parent_Rhoy()
+!                    REAL(Agrif_Curgrid % parent % spaceref(2))
+!===================================================================================================
+!  function Agrif_Irhoy
+!        modify by conv. To use : var = Agrif_Parent_IRhoy()
+!                    Agrif_Curgrid % spaceref(2)
+!===================================================================================================
+!  function Agrif_Parent_Irhoy
+!        modify by conv. To use : var = Agrif_Parent_IRhoy()
+!                    Agrif_Curgrid % parent % spaceref(2)
+!===================================================================================================
+!  function Agrif_Rhoz
+!        modify by conv. To use : var = Agrif_Rhoz()
+!                    REAL(Agrif_Curgrid % spaceref(3))
+!===================================================================================================
+!  function Agrif_Parent_Rhoz
+!        modify by conv. To use : var = Agrif_Parent_Rhoz()
+!                    REAL(Agrif_Curgrid % parent % spaceref(3))
+!===================================================================================================
+!  function Agrif_Irhoz
+!        modify by conv. To use : var = Agrif_Parent_IRhoz()
+!                    Agrif_Curgrid % spaceref(3)
+!===================================================================================================
+!  function Agrif_Parent_Irhoz
+!        modify by conv. To use : var = Agrif_Parent_IRhoz()
+!                    Agrif_Curgrid % parent % spaceref(3)
+!===================================================================================================
+!  function Agrif_NearCommonBorderX
+!        modify by conv. To use : var = Agrif_NearCommonBorderX()
+!                       Agrif_Curgrid % NearRootBorder(1)
+!===================================================================================================
+!  function Agrif_NearCommonBorderY
+!        modify by conv. To use : var = Agrif_NearCommonBorderY()
+!                       Agrif_Curgrid % NearRootBorder(2)
+!===================================================================================================
+!  function Agrif_NearCommonBorderZ
+!        modify by conv. To use : var = Agrif_NearCommonBorderZ()
+!                       Agrif_Curgrid % NearRootBorder(3)
+!===================================================================================================
+!  function Agrif_DistantCommonBorderX
+!        modify by conv. To use : var = Agrif_DistantCommonBorderX()
+!                       Agrif_Curgrid % DistantRootBorder(1)
+!===================================================================================================
+!  function Agrif_DistantCommonBorderY
+!        modify by conv. To use : var = Agrif_DistantCommonBorderY()
+!                       Agrif_Curgrid % DistantRootBorder(2)
+!===================================================================================================
+!  function Agrif_DistantCommonBorderZ
+!        modify by conv. To use : var = Agrif_DistantCommonBorderZ()
+!                       Agrif_Curgrid % DistantRootBorder(3)
+!===================================================================================================
+!  function Agrif_Nb_Step
+!        modify by conv. To use : var = Agrif_Nb_Step()
+!                          Agrif_Curgrid % ngridstep
+!===================================================================================================
+!  function Agrif_Nb_Fine_Grids
+!        modify by conv. To use : var = Agrif_Nb_Fine_Grids()
+!                         Agrif_nbfixedgrids
+!===================================================================================================
+!  function Agrif_Ix
+!        modify by conv. To use : var = Agrif_Ix()
+!                         Agrif_Curgrid % ix(1)
+!===================================================================================================
+!  function Agrif_Parent_Ix
+!        modify by conv. To use : var = Agrif_Parent_Ix()
+!                        Agrif_Curgrid % parent % ix(1)
+!===================================================================================================
+!  function Agrif_Iy
+!        modify by conv. To use : var = Agrif_Iy()
+!                        Agrif_Curgrid % ix(2)
+!===================================================================================================
+!  function Agrif_Parent_Iy
+!        modify by conv. To use : var = Agrif_Parent_Iy()
+!                       Agrif_Curgrid % parent % ix(2)
+!===================================================================================================
+!  function Agrif_Iz
+!        modify by conv. To use : var = Agrif_Iz()
+!                      Agrif_Curgrid % ix(3)
+!===================================================================================================
+!  function Agrif_Parent_Iz
+!        modify by conv. To use : var = Agrif_Parent_Iz()
+!                     Agrif_Curgrid % parent % ix(3)
+!===================================================================================================
+!  function Agrif_Get_grid_id
+!        modify by conv. To use : var = Agrif_Get_grid_id()
+!                    Agrif_Curgrid % grid_id
+!===================================================================================================
+!  function Agrif_Get_parent_id
+!        modify by conv. To use : var = Agrif_Get_parent_id()
+!                    Agrif_Curgrid % parent % grid_id
+!===================================================================================================
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F	(revision 5659)
+++ 	(revision )
@@ -1,688 +1,0 @@
-!
-! $Id$
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Mask
-C
-      Module Agrif_Mask
-C
-CCC   Description:
-CCC   Module for masks
-C
-C     Modules used: 
-C
-      Use Agrif_Types       
-C
-      IMPLICIT NONE
-C
-      CONTAINS
-C     Define procedures contained in this module
-C
-C     **************************************************************************
-C     Subroutine Agrif_CheckMasknD
-C     **************************************************************************
-C       
-      Subroutine Agrif_CheckMasknD(tempP,parent,pbtab,petab,ppbtab,
-     &               ppetab,noraftab,nbdim)
-C
-CCC   Description:
-CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
-CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
-C
-C     Declarations:
-C
-       
-C
-C     Arrays arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim) :: pbtab  ! Limits of the parent grid used  
-      INTEGER,DIMENSION(nbdim) :: petab  ! interpolation of the child grid
-      LOGICAL,DIMENSION(nbdim) :: noraftab
-      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
-C
-C     Pointer argument
-      TYPE(AGRIF_PVARIABLE) :: tempP  ! Part of the parent grid used for 
-                                      ! the interpolation of the child grid                     
-C     Data TYPE argument                                   
-      TYPE(AGRIF_PVARIABLE) :: parent      ! The parent grid
-C
-C     Local scalar
-      INTEGER                   :: i0,j0,k0,l0,m0,n0
-C      
-C     Local arrays
-C
-C      
-      SELECT CASE (nbdim)
-      CASE (1)
-         do i0 = pbtab(1),petab(1)
-         IF (tempP%var%array1(i0)
-     &                        == Agrif_SpecialValue) Then
-            Call CalculNewValTempP((/i0/),
-     &                             tempP,parent,
-     &                             ppbtab,ppetab,
-     &                             noraftab,nbdim)
-         ENDIF
-         enddo
-      CASE (2)
-         do j0 = pbtab(2),petab(2)
-         do i0 = pbtab(1),petab(1)
-         IF (tempP%var%array2(i0,j0)
-     &                        == Agrif_SpecialValue) Then
-            Call CalculNewValTempP((/i0,j0/),
-     &                             tempP,parent,
-     &                             ppbtab,ppetab,
-     &                             noraftab,nbdim)
-         ENDIF
-         enddo  
-         enddo
-      CASE (3)
-         do k0 = pbtab(3),petab(3)
-         do j0 = pbtab(2),petab(2)
-         do i0 = pbtab(1),petab(1)
-         IF (tempP%var%array3(i0,j0,k0)
-     &                        == Agrif_SpecialValue) Then
-!------CDIR NEXPAND
-            Call CalculNewValTempP3D((/i0,j0,k0/),
-     &      tempP%var%array3(ppbtab(1),ppbtab(2),ppbtab(3)),
-     &      parent%var%array3(ppbtab(1),ppbtab(2),ppbtab(3)),
-     &                           ppbtab,ppetab,
-     &                           noraftab,MaxSearch,Agrif_SpecialValue)
-     
-c            Call CalculNewValTempP((/i0,j0,k0/),
-c     &                             tempP,parent,
-c     &                             ppbtab,ppetab,
-c     &                             noraftab,nbdim)
-          
-         ENDIF
-         enddo
-         enddo  
-         enddo
-      CASE (4)
-         do l0 = pbtab(4),petab(4)
-         do k0 = pbtab(3),petab(3)
-         do j0 = pbtab(2),petab(2)
-         do i0 = pbtab(1),petab(1)
-         IF (tempP%var%array4(i0,j0,k0,l0) 
-     &                        == Agrif_SpecialValue) Then
-            Call CalculNewValTempP4D((/i0,j0,k0,l0/),
-     &      tempP%var%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),
-     &      parent%var%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),
-     &                           ppbtab,ppetab,
-     &                           noraftab,MaxSearch,Agrif_SpecialValue)
-         ENDIF
-         enddo
-         enddo
-         enddo  
-         enddo
-      CASE (5)
-         do m0 = pbtab(5),petab(5)
-         do l0 = pbtab(4),petab(4)
-         do k0 = pbtab(3),petab(3)
-         do j0 = pbtab(2),petab(2)
-         do i0 = pbtab(1),petab(1)
-         IF (tempP%var%array5(i0,j0,k0,l0,m0) 
-     &                       == Agrif_SpecialValue) Then
-            Call CalculNewValTempP((/i0,j0,k0,l0,m0/),
-     &                             tempP,parent,
-     &                             ppbtab,ppetab,
-     &                             noraftab,nbdim)
-         ENDIF
-         enddo
-         enddo
-         enddo  
-         enddo
-         enddo
-      CASE (6)
-         do n0 = pbtab(6),petab(6)
-         do m0 = pbtab(5),petab(5)
-         do l0 = pbtab(4),petab(4)
-         do k0 = pbtab(3),petab(3)
-         do j0 = pbtab(2),petab(2)
-         do i0 = pbtab(1),petab(1)
-         IF (tempP%var%array6(i0,j0,k0,l0,m0,n0) 
-     &                       == Agrif_SpecialValue) Then
-            Call CalculNewValTempP((/i0,j0,k0,l0,m0,n0/),
-     &                             tempP,parent,
-     &                             ppbtab,ppetab,
-     &                             noraftab,nbdim)
-         ENDIF
-         enddo
-         enddo
-         enddo
-         enddo  
-         enddo
-         enddo
-      END SELECT
-C
-C      
-C     
-      End Subroutine Agrif_CheckMasknD
-C
-C
-C     **************************************************************************
-C     Subroutine CalculNewValTempP
-C     **************************************************************************
-C       
-      Subroutine CalculNewValTempP(indic,
-     &               tempP,parent,ppbtab,
-     &               ppetab,noraftab,nbdim)
-C
-CCC   Description:
-CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
-CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
-C
-C     Declarations:
-C
-       
-C
-C     Arrays arguments      
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim) :: indic
-      LOGICAL,DIMENSION(nbdim) :: noraftab
-      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
-C
-C     Pointer argument
-      TYPE(AGRIF_PVARIABLE) :: tempP  ! Part of the parent grid used for 
-                                      ! the interpolation of the child grid                     
-C     Data TYPE argument                                   
-      TYPE(AGRIF_PVARIABLE) :: parent      ! The parent grid
-C
-C     Local scalar
-      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
-      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
-      INTEGER                  :: Nbvals
-      REAL                     :: Res
-      REAL                     :: ValParent
-      INTEGER                  :: ValMax
-      LOGICAL                  :: firsttest
-C      
-C     Local arrays      
-C
-      ValMax = 1
-      do iii = 1 , nbdim
-         IF (.NOT.noraftab(iii)) THEN
-         ValMax = max(ValMax,ppetab(iii)-indic(iii))
-         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
-         ENDIF
-      enddo
-C
-      Valmax = min(Valmax,MaxSearch)
-C
-!CDIR NOVECTOR
-      imin = indic
-!CDIR NOVECTOR
-      imax = indic
-C
-         i = 1
-         firsttest = .TRUE.
-C
-         do While(i <= ValMax)
-C
-         IF ((i == 1).AND.(firsttest)) i = Valmax
-
-            do iii = 1 , nbdim
-               if (.NOT.noraftab(iii)) then
-                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
-                  imax(iii) = min(indic(iii) + i,ppetab(iii))
-                  if (firsttest) then               
-                  if (indic(iii).GT.ppbtab(iii)) then
-
-!CDIR NOVECTOR
-                     idecal = indic
-                     idecal(iii) = idecal(iii)-1
-                     SELECT CASE(nbdim)
-                     CASE (1)
-                        if (tempP%var%array1(idecal(1)
-     &                            ) == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif                     
-                     CASE (2)
-                        if (tempP%var%array2(idecal(1),
-     &            idecal(2)) == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif
-                     CASE (3)
-                        if (tempP%var%array3(idecal(1),
-     &            idecal(2),idecal(3)) 
-     &                               == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif  
-                     CASE (4)
-                        if (tempP%var%array4(idecal(1),
-     &            idecal(2),idecal(3),idecal(4)) 
-     &                               == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif     
-                     CASE (5)
-                        if (tempP%var%array5(idecal(1),
-     &            idecal(2),idecal(3),idecal(4),idecal(5)) 
-     &                               == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif  
-                     CASE (6)
-                        if (tempP%var%array6(idecal(1),
-     &            idecal(2),idecal(3),idecal(4),idecal(5),idecal(6)) 
-     &                               == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif                                                                                           
-                     END SELECT
-                  endif
-                  endif
-               endif            
-            enddo
-C
-            Res = 0.
-            Nbvals = 0
-C
-            SELECT CASE(nbdim)
-            CASE (1)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-               do ii = imin(1),imax(1)
-                    ValParent = parent%var%array1(ii)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-               enddo
-C
-            CASE (2)
-               do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-               do ii = imin(1),imax(1)
-                    ValParent = parent%var%array2(ii,jj)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-               enddo  
-               enddo
-               
-            CASE (3)
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-               do ii = imin(1),imax(1)
-                    ValParent = parent%var%array3(ii,jj,kk)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-                        enddo
-                  enddo  
-               enddo
-
-            CASE (4)
-               do ll = imin(4),imax(4)
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-               do ii = imin(1),imax(1)
-                    ValParent = parent%var%array4(ii,jj,kk,ll)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-                              enddo
-                        enddo
-                  enddo  
-               enddo
-
-            CASE (5)
-               do mm = imin(5),imax(5)
-               do ll = imin(4),imax(4)
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-               do ii = imin(1),imax(1)
-                    ValParent = parent%var%array5(ii,jj,kk,ll,mm)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-                                    enddo
-                              enddo
-                        enddo
-                  enddo  
-               enddo
-
-            CASE (6)
-               do nn = imin(6),imax(6)
-               do mm = imin(5),imax(5)
-               do ll = imin(4),imax(4)
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-!CDIR ALTCODE
-!CDIR SHORTLOOP
-               do ii = imin(1),imax(1)
-                    ValParent = parent%var%array6(ii,jj,kk,ll,mm,nn)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-                                          enddo
-                                    enddo
-                              enddo
-                        enddo
-                  enddo  
-               enddo
-
-            END SELECT
-C
-C
-            
-            if (Nbvals.GT.0) then
-              if (firsttest) then
-                   firsttest = .FALSE.
-                   i=1
-                   cycle
-              endif
-            SELECT CASE(nbdim)
-            CASE (1)              
-              tempP%var%array1(indic(1)) 
-     &           = Res/Nbvals
-            CASE (2)
-              tempP%var%array2(indic(1),
-     &                            indic(2)) = Res/Nbvals
-            CASE (3)
-              tempP%var%array3(indic(1),
-     &                            indic(2),indic(3)) = Res/Nbvals
-            CASE (4)
-              tempP%var%array4(indic(1),
-     &                            indic(2),indic(3),indic(4))
-     &                = Res/Nbvals
-            CASE (5)
-              tempP%var%array5(indic(1),
-     &                            indic(2),indic(3),indic(4),
-     &                   indic(5)) = Res/Nbvals
-            CASE (6)
-              tempP%var%array6(indic(1),
-     &                            indic(2),indic(3),indic(4),
-     &                           indic(5),indic(6)) = Res/Nbvals
-            END SELECT
-              exit
-            else
-               if (firsttest) exit
-               i = i + 1                      
-            endif
-          enddo            
-C     
-      End Subroutine CalculNewValTempP
-C
-C
-      End Module Agrif_Mask     
-      
-      Subroutine CalculNewValTempP3D(indic,
-     &               tempP,parent,ppbtab,
-     &               ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
-C
-CCC   Description:
-CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
-CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
-C
-C     Declarations:
-C
-       
-C
-C     Arrays arguments      
-      INTEGER, PARAMETER :: nbdim = 3
-      INTEGER,DIMENSION(nbdim) :: indic
-      LOGICAL,DIMENSION(nbdim) :: noraftab
-      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
-      REAL :: Agrif_SpecialValue
-C
-C     Pointer argument
-      REAL,DIMENSION(ppbtab(1):ppetab(1),ppbtab(2):ppetab(2),
-     &    ppbtab(3):ppetab(3)) :: tempP, parent  ! Part of the parent grid used for 
-                                      ! the interpolation of the child grid                     
-C
-C     Local scalar
-      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
-      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
-      INTEGER                  :: Nbvals
-      REAL                     :: Res
-      REAL                     :: ValParent
-      INTEGER                  :: ValMax
-      INTEGER :: MaxSearch
-      LOGICAL :: Existunmasked
-C      
-C     Local arrays      
-C
-      ValMax = 1
-!CDIR NOVECTOR
-      do iii = 1 , nbdim
-         IF (.NOT.noraftab(iii)) THEN
-         ValMax = max(ValMax,ppetab(iii)-indic(iii))
-         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
-         ENDIF
-      enddo
-C
-      Valmax = min(Valmax,MaxSearch)
-C
-!CDIR NOVECTOR
-      imin = indic
-!CDIR NOVECTOR
-      imax = indic
-      
-!CDIR NOVECTOR
-         idecal = indic	 
-C
-         i = Valmax
-
-            do iii = 1 , nbdim
-               if (.NOT.noraftab(iii)) then
-                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
-                  imax(iii) = min(indic(iii) + i,ppetab(iii))
-         
-                  if (indic(iii).GT.ppbtab(iii)) then
-
-                     idecal(iii) = idecal(iii)-1
-
-                        if (tempP(idecal(1),idecal(2),idecal(3)) 
-     &                               == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                        endif
-
-                     idecal(iii) = idecal(iii)+1
-                  endif
-
-               endif            
-            enddo
-C
-            Existunmasked = .FALSE.
-C
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-!CDIR NOVECTOR
-               do ii = imin(1),imax(1)
-                    if ( parent(ii,jj,kk) .NE. Agrif_SpecialValue) then
-                        Existunmasked = .TRUE.
-                       exit
-                    endif 
-                        enddo
-                  enddo  
-               enddo
-C
-C
-          if (.Not.Existunmasked) return
-C
-         i = 1
-C
-         do While(i <= ValMax)
-C
-
-            do iii = 1 , nbdim
-               if (.NOT.noraftab(iii)) then
-                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
-                  imax(iii) = min(indic(iii) + i,ppetab(iii))
-               endif            
-            enddo
-C
-            Res = 0.
-            Nbvals = 0
-C
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-!CDIR NOVECTOR
-               do ii = imin(1),imax(1)
-                    ValParent = parent(ii,jj,kk)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-                        enddo
-                  enddo  
-               enddo
-C
-C
-            
-            if (Nbvals.GT.0) then
-              tempP(indic(1),indic(2),indic(3)) = Res/Nbvals
-              exit
-            else
-               i = i + 1                      
-            endif
-          enddo            
-C     
-      End Subroutine CalculNewValTempP3D        
-
-      Subroutine CalculNewValTempP4D(indic,
-     &               tempP,parent,ppbtab,
-     &               ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
-C
-CCC   Description:
-CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
-CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
-C
-C     Declarations:
-C
-       
-C
-C     Arrays arguments      
-      INTEGER, PARAMETER :: nbdim = 4
-      INTEGER,DIMENSION(nbdim) :: indic
-      LOGICAL,DIMENSION(nbdim) :: noraftab
-      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
-      INTEGER :: MaxSearch      
-      REAL :: Agrif_SpecialValue      
-C
-C     Pointer argument
-      REAL,DIMENSION(ppbtab(1):ppetab(1),ppbtab(2):ppetab(2),
-     &    ppbtab(3):ppetab(3),
-     &    ppbtab(4):ppetab(4)) :: tempP, parent  ! Part of the parent grid used for 
-                                      ! the interpolation of the child grid                     
-C
-C     Local scalar
-      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
-      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
-      INTEGER                  :: Nbvals
-      REAL                     :: Res
-      REAL                     :: ValParent
-      INTEGER                  :: ValMax
-      LOGICAL                  :: firsttest
-C      
-C     Local arrays      
-C
-      ValMax = 1
-      do iii = 1 , nbdim
-         IF (.NOT.noraftab(iii)) THEN
-         ValMax = max(ValMax,ppetab(iii)-indic(iii))
-         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
-         ENDIF
-      enddo
-C
-      Valmax = min(Valmax,MaxSearch)
-C
-      imin = indic
-      imax = indic
-C
-         i = 1
-         firsttest = .TRUE.
-         idecal = indic	 
-	 
-C
-         do While(i <= ValMax)
-C
-         IF ((i == 1).AND.(firsttest)) i = Valmax
-
-            do iii = 1 , nbdim
-               if (.NOT.noraftab(iii)) then
-                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
-                  imax(iii) = min(indic(iii) + i,ppetab(iii))
-                  if (firsttest) then               
-                  if (indic(iii).GT.ppbtab(iii)) then
-
-
-                     idecal(iii) = idecal(iii)-1
-		     
-                     if (tempP(idecal(1),idecal(2),idecal(3),idecal(4))
-     &                               == Agrif_SpecialValue) then
-                           imin(iii) = imax(iii)
-                     endif
-		     
-		     idecal(iii) = idecal(iii)+1
-                  endif
-                  endif
-               endif            
-            enddo
-C
-            Res = 0.
-            Nbvals = 0
-C
-               do ll = imin(4),imax(4)
-               do kk = imin(3),imax(3)
-               do jj = imin(2),imax(2)
-               do ii = imin(1),imax(1)
-                    ValParent = parent(ii,jj,kk,ll)
-                    if ( ValParent .NE. Agrif_SpecialValue) then
-                        Res = Res + ValParent
-                        Nbvals = Nbvals + 1
-                    endif 
-                              enddo
-                        enddo
-                  enddo  
-               enddo
-C
-C
-            
-            if (Nbvals.GT.0) then
-              if (firsttest) then
-                   firsttest = .FALSE.
-                   i=1
-                   cycle
-              endif
-	      
-              tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals
-	    
-              exit
-            else
-               if (firsttest) exit
-               i = i + 1                      
-            endif
-          enddo            
-C     
-      End Subroutine CalculNewValTempP4D        
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90	(revision 5682)
@@ -0,0 +1,586 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Mask.
+!>
+!> Module for masks.
+!
+module Agrif_Mask
+!
+    use Agrif_Types
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_CheckMasknD
+!
+!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
+!! when this one is equal to Agrif_SpecialValue.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, noraftab, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer   :: tempP  !< Part of the parent grid used for the interpolation of the child grid
+    type(Agrif_Variable), pointer   :: parent !< The parent grid
+    integer, dimension(nbdim)       :: pbtab  !< limits of the parent grid used
+    integer, dimension(nbdim)       :: petab  !< interpolation of the child grid
+    integer, dimension(nbdim)       :: ppbtab, ppetab
+    logical, dimension(nbdim)       :: noraftab
+    integer                         :: nbdim
+!
+    integer :: i0,j0,k0,l0,m0,n0
+!
+    select case (nbdim)
+    case (1)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array1(i0) == Agrif_SpecialValue) then
+                call CalculNewValTempP((/i0/),tempP,parent,ppbtab,ppetab,noraftab,nbdim)
+            endif
+        enddo
+    case (2)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array2(i0,j0) == Agrif_SpecialValue) then
+                call CalculNewValTempP((/i0,j0/),tempP,parent,ppbtab,ppetab, noraftab,nbdim)
+            endif
+        enddo
+        enddo
+    case (3)
+        do k0 = pbtab(3),petab(3)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array3(i0,j0,k0) == Agrif_SpecialValue) then
+!------CDIR NEXPAND
+                call CalculNewValTempP3D((/i0,j0,k0/), &
+                    tempP%array3(ppbtab(1),ppbtab(2),ppbtab(3)),  &
+                    parent%array3(ppbtab(1),ppbtab(2),ppbtab(3)), &
+                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+
+!            Call CalculNewValTempP((/i0,j0,k0/),
+!     &                             tempP,parent,
+!     &                             ppbtab,ppetab,
+!     &                             noraftab,nbdim)
+
+            endif
+        enddo
+        enddo
+        enddo
+    case (4)
+        do l0 = pbtab(4),petab(4)
+        do k0 = pbtab(3),petab(3)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then
+                call CalculNewValTempP4D((/i0,j0,k0,l0/), &
+                    tempP%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),  &
+                    parent%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)), &
+                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+    case (5)
+        do m0 = pbtab(5),petab(5)
+        do l0 = pbtab(4),petab(4)
+        do k0 = pbtab(3),petab(3)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array5(i0,j0,k0,l0,m0) == Agrif_SpecialValue) then
+                call CalculNewValTempP((/i0,j0,k0,l0,m0/), &
+                    tempP,parent,ppbtab,ppetab,noraftab,nbdim)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    case (6)
+        do n0 = pbtab(6),petab(6)
+        do m0 = pbtab(5),petab(5)
+        do l0 = pbtab(4),petab(4)
+        do k0 = pbtab(3),petab(3)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array6(i0,j0,k0,l0,m0,n0) == Agrif_SpecialValue) then
+                call CalculNewValTempP((/i0,j0,k0,l0,m0,n0/), &
+                    tempP,parent,ppbtab,ppetab,noraftab,nbdim)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CheckMasknD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine CalculNewValTempP
+!
+!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
+!! when this one is equal to Agrif_SpecialValue.
+!---------------------------------------------------------------------------------------------------
+subroutine CalculNewValTempP ( indic, tempP, parent, ppbtab, ppetab, noraftab, nbdim )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(nbdim)       :: indic
+    type(Agrif_Variable), pointer   :: tempP  !< Part of the parent grid used for the interpolation of the child grid
+    type(Agrif_Variable), pointer   :: parent !< The parent grid
+    integer, dimension(nbdim)       :: ppbtab, ppetab
+    logical, dimension(nbdim)       :: noraftab
+    integer                         :: nbdim
+!
+    integer                     :: i,ii,iii,jj,kk,ll,mm,nn
+    integer, dimension(nbdim)   :: imin,imax,idecal
+    integer                     :: nbvals
+    real                        :: res
+    real                        :: valparent
+    integer                     :: ValMax
+    logical                     :: firsttest
+!
+    ValMax = 1
+    do iii = 1,nbdim
+        if (.NOT.noraftab(iii)) then
+            ValMax = max(ValMax,ppetab(iii)-indic(iii))
+            ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+        endif
+    enddo
+!
+    Valmax = min(Valmax,MaxSearch)
+!
+!CDIR NOVECTOR
+    imin = indic
+!CDIR NOVECTOR
+    imax = indic
+!
+    i = 1
+    firsttest = .TRUE.
+!
+    do while (i <= ValMax)
+!
+        if ( (i == 1).AND.(firsttest) ) i = Valmax
+!
+        do iii = 1,nbdim
+            if (.NOT.noraftab(iii)) then
+                imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                imax(iii) = min(indic(iii) + i,ppetab(iii))
+                if (firsttest) then
+                    if (indic(iii) > ppbtab(iii)) then
+!CDIR NOVECTOR
+                        idecal = indic
+                        idecal(iii) = idecal(iii)-1
+                        SELECT CASE(nbdim)
+                        CASE (1)
+                            if (tempP%array1(idecal(1) &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (2)
+                            if (tempP%array2(idecal(1), idecal(2) &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (3)
+                            if (tempP%array3(idecal(1), &
+                                             idecal(2), idecal(3) &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (4)
+                            if (tempP%array4(idecal(1), idecal(2), &
+                                             idecal(3), idecal(4)  &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (5)
+                            if (tempP%array5(idecal(1), idecal(2), &
+                                             idecal(3), idecal(4), &
+                                             idecal(5)             &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (6)
+                            if (tempP%array6(idecal(1), idecal(2), &
+                                             idecal(3), idecal(4), &
+                                             idecal(5), idecal(6)  &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        END SELECT
+                    endif
+                endif
+            endif
+        enddo
+!
+        Res = 0.
+        Nbvals = 0
+!
+        SELECT CASE(nbdim)
+        CASE (1)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array1(ii)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+!
+        CASE (2)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array2(ii,jj)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+
+        CASE (3)
+            do kk = imin(3),imax(3)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array3(ii,jj,kk)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+            enddo
+
+        CASE (4)
+            do ll = imin(4),imax(4)
+            do kk = imin(3),imax(3)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array4(ii,jj,kk,ll)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+            enddo
+            enddo
+
+        CASE (5)
+            do mm = imin(5),imax(5)
+            do ll = imin(4),imax(4)
+            do kk = imin(3),imax(3)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array5(ii,jj,kk,ll,mm)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+            enddo
+            enddo
+            enddo
+
+        CASE (6)
+            do nn = imin(6),imax(6)
+            do mm = imin(5),imax(5)
+            do ll = imin(4),imax(4)
+            do kk = imin(3),imax(3)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array6(ii,jj,kk,ll,mm,nn)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+            enddo
+            enddo
+            enddo
+            enddo
+
+        END SELECT
+!
+        if (Nbvals > 0) then
+            if (firsttest) then
+                firsttest = .FALSE.
+                i=1
+                cycle
+            endif
+            SELECT CASE(nbdim)
+            CASE (1)
+                tempP%array1(indic(1))           = Res/Nbvals
+            CASE (2)
+                tempP%array2(indic(1), indic(2)) = Res/Nbvals
+            CASE (3)
+                tempP%array3(indic(1), indic(2), &
+                             indic(3))           = Res/Nbvals
+            CASE (4)
+                tempP%array4(indic(1), indic(2), &
+                             indic(3), indic(4)) = Res/Nbvals
+            CASE (5)
+                tempP%array5(indic(1), indic(2), &
+                             indic(3), indic(4), &
+                             indic(5))           = Res/Nbvals
+            CASE (6)
+                tempP%array6(indic(1), indic(2), &
+                             indic(3), indic(4), &
+                             indic(5), indic(6)) = Res/Nbvals
+            END SELECT
+            exit
+        else
+            if (firsttest) exit
+            i = i + 1
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine CalculNewValTempP
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine CalculNewValTempP3D
+!
+!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
+!! when this one is equal to Agrif_SpecialValue.
+!---------------------------------------------------------------------------------------------------
+subroutine CalculNewValTempP3D ( indic, tempP, parent, ppbtab, ppetab, noraftab, &
+                                 MaxSearch, Agrif_SpecialValue )
+!---------------------------------------------------------------------------------------------------
+    integer, parameter          :: nbdim = 3
+    integer, dimension(nbdim)   :: indic
+    integer, dimension(nbdim)   :: ppbtab, ppetab
+    logical, dimension(nbdim)   :: noraftab
+    integer                     :: MaxSearch
+    real                        :: Agrif_SpecialValue
+    real, dimension(ppbtab(1):ppetab(1), &
+                    ppbtab(2):ppetab(2), &
+                    ppbtab(3):ppetab(3)) &
+                                :: tempP, parent  !< Part of the parent grid used for
+                                                  !< the interpolation of the child grid
+!
+    integer                     :: i,ii,iii,jj,kk
+    integer, dimension(nbdim)   :: imin,imax,idecal
+    integer                     :: Nbvals
+    real                        :: Res
+    real                        :: ValParent
+    integer                     :: ValMax
+    logical                     :: Existunmasked
+!
+    ValMax = 1
+!CDIR NOVECTOR
+    do iii = 1,nbdim
+        if (.NOT.noraftab(iii)) then
+            ValMax = max(ValMax,ppetab(iii)-indic(iii))
+            ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+        endif
+    enddo
+!
+    Valmax = min(Valmax,MaxSearch)
+!
+!CDIR NOVECTOR
+    imin = indic
+!CDIR NOVECTOR
+    imax = indic
+
+!CDIR NOVECTOR
+    idecal = indic
+    i = Valmax
+!
+    do iii = 1,nbdim
+        if (.NOT.noraftab(iii)) then
+            imin(iii) = max(indic(iii) - i,ppbtab(iii))
+            imax(iii) = min(indic(iii) + i,ppetab(iii))
+
+            if (indic(iii) > ppbtab(iii)) then
+                idecal(iii) = idecal(iii)-1
+                if (tempP(idecal(1),idecal(2),idecal(3)) == Agrif_SpecialValue) then
+                    imin(iii) = imax(iii)
+                endif
+                idecal(iii) = idecal(iii)+1
+            endif
+        endif
+    enddo
+!
+    Existunmasked = .FALSE.
+!
+    do kk = imin(3),imax(3)
+    do jj = imin(2),imax(2)
+!CDIR NOVECTOR
+    do ii = imin(1),imax(1)
+        if ( parent(ii,jj,kk) /= Agrif_SpecialValue) then
+            Existunmasked = .TRUE.
+            exit
+        endif
+    enddo
+    enddo
+    enddo
+!
+    if (.Not.Existunmasked) return
+!
+    i = 1
+!
+    do while(i <= ValMax)
+!
+        do iii = 1 , nbdim
+            if (.NOT.noraftab(iii)) then
+                imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                imax(iii) = min(indic(iii) + i,ppetab(iii))
+            endif
+        enddo
+!
+        Res = 0.
+        Nbvals = 0
+!
+        do kk = imin(3),imax(3)
+        do jj = imin(2),imax(2)
+!CDIR NOVECTOR
+        do ii = imin(1),imax(1)
+            ValParent = parent(ii,jj,kk)
+            if ( ValParent /= Agrif_SpecialValue) then
+                Res = Res + ValParent
+                Nbvals = Nbvals + 1
+            endif
+        enddo
+        enddo
+        enddo
+!
+        if (Nbvals > 0) then
+            tempP(indic(1),indic(2),indic(3)) = Res/Nbvals
+            exit
+        else
+            i = i + 1
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine CalculNewValTempP3D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine CalculNewValTempP4D
+!
+!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
+!! when this one is equal to Agrif_SpecialValue.
+!---------------------------------------------------------------------------------------------------
+subroutine CalculNewValTempP4D ( indic, tempP, parent, ppbtab, ppetab, noraftab, &
+                                 MaxSearch, Agrif_SpecialValue )
+!---------------------------------------------------------------------------------------------------
+    integer, parameter          :: nbdim = 4
+    integer, dimension(nbdim)   :: indic
+    integer, dimension(nbdim)   :: ppbtab, ppetab
+    logical, dimension(nbdim)   :: noraftab
+    integer                     :: MaxSearch
+    real                        :: Agrif_SpecialValue
+    real, dimension(ppbtab(1):ppetab(1), &
+                    ppbtab(2):ppetab(2), &
+                    ppbtab(3):ppetab(3), &
+                    ppbtab(4):ppetab(4)) &
+                                :: tempP, parent  !< Part of the parent grid used for
+                                                  !< the interpolation of the child grid
+!
+    integer                     :: i,ii,iii,jj,kk,ll
+    integer, dimension(nbdim)   :: imin,imax,idecal
+    integer                     :: Nbvals
+    real                        :: Res
+    real                        :: ValParent
+    integer                     :: ValMax
+!
+    logical                     :: firsttest
+!
+    ValMax = 1
+    do iii = 1,nbdim
+        if (.NOT.noraftab(iii)) then
+            ValMax = max(ValMax,ppetab(iii)-indic(iii))
+            ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+        endif
+    enddo
+!
+    Valmax = min(Valmax,MaxSearch)
+!
+    imin = indic
+    imax = indic
+!
+    i = 1
+    firsttest = .TRUE.
+    idecal = indic
+!
+    do while (i <= ValMax)
+!
+        if ((i == 1).AND.(firsttest)) i = Valmax
+
+        do iii = 1,nbdim
+            if (.NOT.noraftab(iii)) then
+                imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                imax(iii) = min(indic(iii) + i,ppetab(iii))
+                if (firsttest) then
+                    if (indic(iii) > ppbtab(iii)) then
+                        idecal(iii) = idecal(iii)-1
+                        if (tempP(idecal(1),idecal(2),idecal(3),idecal(4)) == Agrif_SpecialValue) then
+                            imin(iii) = imax(iii)
+                        endif
+                        idecal(iii) = idecal(iii)+1
+                    endif
+                endif
+            endif
+        enddo
+!
+        Res = 0.
+        Nbvals = 0
+!
+        do ll = imin(4),imax(4)
+        do kk = imin(3),imax(3)
+        do jj = imin(2),imax(2)
+        do ii = imin(1),imax(1)
+            ValParent = parent(ii,jj,kk,ll)
+            if ( ValParent /= Agrif_SpecialValue) then
+                Res = Res + ValParent
+                Nbvals = Nbvals + 1
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+!
+        if (Nbvals > 0) then
+            if (firsttest) then
+                firsttest = .FALSE.
+                i=1
+                cycle
+            endif
+
+            tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals
+            exit
+        else
+            if (firsttest) exit
+            i = i + 1
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine CalculNewValTempP4D
+!===================================================================================================
+!
+end module Agrif_Mask
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F	(revision 5659)
+++ 	(revision )
@@ -1,1119 +1,0 @@
-!
-! $Id$
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_mpp
-C
-      Module Agrif_mpp
-      Use Agrif_Types
-      Use Agrif_Arrays
-
-      Contains
-#ifdef key_mpp_mpi
-      Subroutine Get_External_Data_first(pttruetab,
-     &   cetruetab,pttruetabwhole,cetruetabwhole,nbdim,memberin,
-     &   memberout,memberoutall1,sendtoproc,recvfromproc,imin,imax,
-     &   imin_recv,imax_recv)
-
-      IMPLICIT NONE
-      INCLUDE 'mpif.h'
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab,
-     &                                                 cetruetab
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetabwhole,
-     &                                                 cetruetabwhole
-      INTEGER :: k,i,k2
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc, recvfromproc
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1):: imin,imax,
-     &   imin_recv,imax_recv
-      LOGICAL :: memberin, memberout
-      INTEGER :: imintmp, imaxtmp,j,i1
-      INTEGER :: imin1,imax1
-      LOGICAL :: tochange,tochangebis
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,
-     &                                                 cetruetab2
-      LOGICAL :: memberout1(1),memberoutall(0:Agrif_Nbprocs-1)
-      LOGICAL, OPTIONAL :: memberoutall1(0:Agrif_Nbprocs-1)
-      INTEGER :: code
-      
-C pttruetab2 and cetruetab2 are modified arraysin order to always
-C send the most inner points
-
-        
-        IF (present(memberoutall1)) THEN
-        memberoutall = memberoutall1
-        ELSE
-         memberout1(1) = memberout
-
-         CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall,
-     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
-        ENDIF
-         pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
-         cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
-         do k2=0,Agrif_Nbprocs-1
-            do i=1,nbdim
-
-           tochangebis=.TRUE.
-           DO i1=1,nbdim
-            IF (i .NE. i1) THEN
-              IF ((pttruetab(i1,Agrif_Procrank).NE.pttruetab(i1,k2)).OR.
-     &          (cetruetab(i1,Agrif_Procrank).NE.cetruetab(i1,k2))) THEN
-                   tochangebis = .FALSE.
-               EXIT
-              ENDIF
-             ENDIF
-           ENDDO
-
-           IF (tochangebis) THEN
-
-
-          imin1 = max(pttruetab(i,Agrif_Procrank),
-     &                    pttruetab(i,k2))
-          imax1 = min(cetruetab(i,Agrif_Procrank),
-     &                    cetruetab(i,k2))
-
-C Always send the most interior points
-
-           tochange = .false.
-           IF (cetruetab(i,Agrif_Procrank)> cetruetab(i,k2)) THEN
-
-           DO j=imin1,imax1
-             IF ((cetruetab(i,k2)-j) >
-     &             (j-pttruetab(i,Agrif_Procrank))) THEN
-             imintmp = j+1
-             tochange = .TRUE.
-             ELSE
-              EXIT
-             ENDIF
-          ENDDO
-          ENDIF
-
-           if (tochange) then
-C
-              pttruetab2(i,Agrif_Procrank) = imintmp
-C
-          endif
-
-           tochange = .FALSE.
-           imaxtmp=0
-           IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k2)) THEN
-          DO j=imax1,imin1,-1
-            IF ((j-pttruetab(i,k2)) >
-     &             (cetruetab(i,Agrif_Procrank)-j)) THEN
-             imaxtmp = j-1
-             tochange = .TRUE.
-            ELSE
-             EXIT
-            ENDIF
-          ENDDO
-
-          ENDIF
-
-                    if (tochange) then
-C
-              cetruetab2(i,Agrif_Procrank) = imaxtmp
-C
-          endif
-C
-
-          ENDIF
-           enddo
-         enddo
-
-
-       do k = 0,Agrif_NbProcs-1
-C
-        sendtoproc(k) = .true.
-C
-!CDIR SHORTLOOP
-        do i = 1,nbdim
-C
-          imin(i,k) = max(pttruetab2(i,Agrif_Procrank),
-     &                    pttruetabwhole(i,k))
-          imax(i,k) = min(cetruetab2(i,Agrif_Procrank),
-     &                    cetruetabwhole(i,k))
-C
-          if (imin(i,k) > imax(i,k)) then
-C
-              sendtoproc(k) = .false.
-C
-          endif
-C
-        enddo
-        IF (.NOT.memberoutall(k)) THEN
-           sendtoproc(k) = .FALSE.
-        ENDIF
-C
-      enddo
-      
-      Call Exchangesamelevel_first(sendtoproc,nbdim,imin,imax,
-     &     recvfromproc,imin_recv,imax_recv)
-      
-      End Subroutine Get_External_Data_first
-C
-      Subroutine Get_External_Data(tempC,tempCextend,pttruetab,
-     &   cetruetab,pttruetabwhole,cetruetabwhole,nbdim,memberin,
-     &   memberout,memberoutall1)
-
-      IMPLICIT NONE
-      INCLUDE 'mpif.h'
-      INTEGER :: nbdim
-      TYPE(Agrif_PVariable) :: tempC, tempCextend
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab,
-     &                                                 cetruetab
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetabwhole,
-     &                                                 cetruetabwhole
-      INTEGER :: k,i,k2
-      LOGICAL :: sendtoproc(0:Agrif_Nbprocs-1)
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: imin,imax
-      LOGICAL :: memberin, memberout
-      INTEGER :: imintmp, imaxtmp,j,i1
-      INTEGER :: imin1,imax1
-      LOGICAL :: tochange,tochangebis
-      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,
-     &                                                 cetruetab2
-      LOGICAL :: memberout1(1),memberoutall(0:Agrif_Nbprocs-1)
-      LOGICAL, OPTIONAL :: memberoutall1(0:Agrif_Nbprocs-1)
-      INTEGER :: code
-
-C pttruetab2 and cetruetab2 are modified arraysin order to always
-C send the most inner points
-
-        
-        IF (present(memberoutall1)) THEN
-        memberoutall = memberoutall1
-        ELSE
-         memberout1(1) = memberout
-
-         CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall,
-     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
-        ENDIF
-         pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
-         cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
-         do k2=0,Agrif_Nbprocs-1
-            do i=1,nbdim
-
-           tochangebis=.TRUE.
-           DO i1=1,nbdim
-            IF (i .NE. i1) THEN
-              IF ((pttruetab(i1,Agrif_Procrank).NE.pttruetab(i1,k2)).OR.
-     &          (cetruetab(i1,Agrif_Procrank).NE.cetruetab(i1,k2))) THEN
-                   tochangebis = .FALSE.
-               EXIT
-              ENDIF
-             ENDIF
-           ENDDO
-
-           IF (tochangebis) THEN
-
-
-          imin1 = max(pttruetab(i,Agrif_Procrank),
-     &                    pttruetab(i,k2))
-          imax1 = min(cetruetab(i,Agrif_Procrank),
-     &                    cetruetab(i,k2))
-
-C Always send the most interior points
-
-           tochange = .false.
-           IF (cetruetab(i,Agrif_Procrank)> cetruetab(i,k2)) THEN
-
-           DO j=imin1,imax1
-             IF ((cetruetab(i,k2)-j) >
-     &             (j-pttruetab(i,Agrif_Procrank))) THEN
-             imintmp = j+1
-             tochange = .TRUE.
-             ELSE
-              EXIT
-             ENDIF
-          ENDDO
-          ENDIF
-
-           if (tochange) then
-C
-              pttruetab2(i,Agrif_Procrank) = imintmp
-C
-          endif
-
-           tochange = .FALSE.
-           imaxtmp=0
-           IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k2)) THEN
-          DO j=imax1,imin1,-1
-            IF ((j-pttruetab(i,k2)) >
-     &             (cetruetab(i,Agrif_Procrank)-j)) THEN
-             imaxtmp = j-1
-             tochange = .TRUE.
-            ELSE
-             EXIT
-            ENDIF
-          ENDDO
-
-          ENDIF
-
-                    if (tochange) then
-C
-              cetruetab2(i,Agrif_Procrank) = imaxtmp
-C
-          endif
-C
-
-          ENDIF
-           enddo
-         enddo
-
-
-       do k = 0,Agrif_NbProcs-1
-C
-        sendtoproc(k) = .true.
-C
-!CDIR SHORTLOOP
-        do i = 1,nbdim
-C
-          imin(i,k) = max(pttruetab2(i,Agrif_Procrank),
-     &                    pttruetabwhole(i,k))
-          imax(i,k) = min(cetruetab2(i,Agrif_Procrank),
-     &                    cetruetabwhole(i,k))
-C
-          if (imin(i,k) > imax(i,k)) then
-C
-              sendtoproc(k) = .false.
-C
-          endif
-C
-        enddo
-        IF (.NOT.memberoutall(k)) THEN
-           sendtoproc(k) = .FALSE.
-        ENDIF
-C
-      enddo
-
-
-c       IF (.NOT.memberin) sendtoproc = .FALSE.
-
-      IF (memberout) THEN
-      Call Agrif_nbdim_allocation(tempCextend%var,
-     &                 pttruetabwhole(:,Agrif_ProcRank),
-     &                 cetruetabwhole(:,Agrif_ProcRank),nbdim)
-      call Agrif_nbdim_Full_VarEQreal(tempCextend%var,0.,nbdim)
-      ENDIF
-
-      IF (sendtoproc(Agrif_ProcRank)) THEN
-           Call Agrif_nbdim_VarEQvar(tempCextend%var,
-     &                               imin(:,Agrif_Procrank),
-     &                               imax(:,Agrif_Procrank),
-     &                               tempC%var,
-     &                               imin(:,Agrif_Procrank),
-     &                               imax(:,Agrif_Procrank),
-     &                               nbdim)
-      ENDIF
-
-      Call Exchangesamelevel(sendtoproc,nbdim,imin,imax,tempC,
-     &     tempCextend)
-
-      End Subroutine Get_External_Data
-
-       Subroutine ExchangeSameLevel(sendtoproc,nbdim,imin,imax,
-     &          tempC,tempCextend)
-      Implicit None
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
-      INTEGER,DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: iminmax_temp
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
-      TYPE(Agrif_PVARIABLE) :: tempC,tempCextend
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
-      LOGICAL                                    :: res
-      TYPE(AGRIF_PVARIABLE), SAVE                      :: temprecv
-
-      INCLUDE 'mpif.h'
-          INTEGER :: i,k
-          INTEGER :: etiquette = 100
-          INTEGER :: code, datasize
-          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
-
-
-      do k = 0,Agrif_ProcRank-1
-C
-C
-            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,code)
-C
-            if (sendtoproc(k)) then
-C
-                iminmax_temp(:,1,k) = imin(:,k)
-                iminmax_temp(:,2,k) = imax(:,k)
-
-                Call MPI_SEND(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-C
-                datasize = 1
-C
-!CDIR SHORTLOOP
-                do i = 1,nbdim
-C
-                  datasize = datasize * (imax(i,k)-imin(i,k)+1)
-C
-                enddo
-C
-                SELECT CASE(nbdim)
-                CASE(1)
-                   Call MPI_SEND(tempC%var%array1(
-     &                        imin(1,k):imax(1,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(2)
-                   Call MPI_SEND(tempC%var%array2(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(3)
-                
-                  Call Agrif_Send_3Darray(tempC%var%array3,
-     &             lbound(tempC%var%array3),imin(:,k),imax(:,k),k)
-                CASE(4)
-                   Call MPI_SEND(tempC%var%array4(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(5)
-                   Call MPI_SEND(tempC%var%array5(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(6)
-                   Call MPI_SEND(tempC%var%array6(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k),
-     &                        imin(6,k):imax(6,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                END SELECT
-C
-            endif
-
-C
-      enddo
-C
-C
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-C
-C
-            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,statut,code)
-C
-            recvfromproc(k) = res
-
-C
-            if (recvfromproc(k)) then
-C
-                Call MPI_RECV(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,statut,code)
-
-                imin_recv(:,k) = iminmax_temp(:,1,k)
-                imax_recv(:,k) = iminmax_temp(:,2,k)
-
-                datasize = 1
-C
-!CDIR SHORTLOOP
-                do i = 1,nbdim
-C
-                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
-C
-                enddo
-
-             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
-             call Agrif_nbdim_allocation(temprecv%var,imin_recv(:,k),
-     &   imax_recv(:,k),nbdim)
-            SELECT CASE(nbdim)
-            CASE(1)
-              Call MPI_RECV(temprecv%var%array1,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(2)
-              Call MPI_RECV(temprecv%var%array2,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(3)
-              Call MPI_RECV(temprecv%var%array3,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-
-            CASE(4)
-              Call MPI_RECV(temprecv%var%array4,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(5)
-              Call MPI_RECV(temprecv%var%array5,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(6)
-              Call MPI_RECV(temprecv%var%array6,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-       END SELECT
-                        
-            Call where_valtabtotab_mpi(tempCextend%var,
-     &             temprecv%var,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
-     
-                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
-C                deallocate(temprecv%var)
-
-            endif
-
-C
-      enddo
-
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-C
-C
-            
-            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,code)
-C
-            if (sendtoproc(k)) then
-C
-                iminmax_temp(:,1,k) = imin(:,k)
-                iminmax_temp(:,2,k) = imax(:,k)
-
-                Call MPI_SEND(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-C
-                SELECT CASE(nbdim)
-                CASE(1)
-                datasize=SIZE(tempC%var%array1(
-     &                        imin(1,k):imax(1,k)))
-                   Call MPI_SEND(tempC%var%array1(
-     &                        imin(1,k):imax(1,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(2)
-                datasize=SIZE(tempC%var%array2(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k)))
-                   Call MPI_SEND(tempC%var%array2(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(3)
-                datasize=SIZE(tempC%var%array3(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k)))
-                   Call MPI_SEND(tempC%var%array3(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(4)
-                datasize=SIZE(tempC%var%array4(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k)))
-                   Call MPI_SEND(tempC%var%array4(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(5)
-                datasize=SIZE(tempC%var%array5(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k)))
-                   Call MPI_SEND(tempC%var%array5(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(6)
-                datasize=SIZE(tempC%var%array6(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k),
-     &                        imin(6,k):imax(6,k)))
-                   Call MPI_SEND(tempC%var%array6(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k),
-     &                        imin(6,k):imax(6,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                END SELECT
-C
-            endif
-
-C
-      enddo
-C
-C
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank-1,0,-1
-C
-C
-            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,statut,code)
-C
-            recvfromproc(k) = res
-
-C
-            if (recvfromproc(k)) then
-C
-                Call MPI_RECV(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,statut,code)
-
-C                imin_recv(:,k) = iminmax_temp(:,1,k)
-C                imax_recv(:,k) = iminmax_temp(:,2,k)
-
-C                datasize = 1
-C
-C                do i = 1,nbdim
-C
-C                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
-C
-C                enddo
-             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
-             call Agrif_nbdim_allocation(temprecv%var,
-     &   iminmax_temp(:,1,k),iminmax_temp(:,2,k),nbdim)
-            SELECT CASE(nbdim)
-            CASE(1)
-              datasize=SIZE(temprecv%var%array1)
-              Call MPI_RECV(temprecv%var%array1,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(2)
-              datasize=SIZE(temprecv%var%array2)
-              Call MPI_RECV(temprecv%var%array2,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(3)
-              datasize=SIZE(temprecv%var%array3)
-              Call MPI_RECV(temprecv%var%array3,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-
-            CASE(4)
-              datasize=SIZE(temprecv%var%array4)
-              Call MPI_RECV(temprecv%var%array4,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(5)
-              datasize=SIZE(temprecv%var%array5)
-              Call MPI_RECV(temprecv%var%array5,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(6)
-              datasize=SIZE(temprecv%var%array6)
-              Call MPI_RECV(temprecv%var%array6,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-          END SELECT
-            
-            Call where_valtabtotab_mpi(tempCextend%var,
-     &             temprecv%var,iminmax_temp(:,1,k),iminmax_temp(:,2,k)
-     &            ,0.,nbdim)
-     
-                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
-C                deallocate(temprecv%var)
-            endif
-
-C
-      enddo
-
-          End Subroutine ExchangeSamelevel
-          
-       Subroutine ExchangeSameLevel_first(sendtoproc,nbdim,imin,imax,
-     &          recvfromproc,imin_recv,imax_recv)
-      Implicit None
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
-      INTEGER,DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: iminmax_temp
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
-      LOGICAL                                    :: res
-
-      INCLUDE 'mpif.h'
-          INTEGER :: i,k
-          INTEGER :: etiquette = 100
-          INTEGER :: code, datasize
-          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
-
-     
-      do k = 0,Agrif_ProcRank-1
-C
-C
-            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,code)
-C
-            if (sendtoproc(k)) then
-C
-                iminmax_temp(:,1,k) = imin(:,k)
-                iminmax_temp(:,2,k) = imax(:,k)
-
-                Call MPI_SEND(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-C
-            endif
-
-C
-      enddo
-C
-C
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-C
-C
-            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,statut,code)
-C
-            recvfromproc(k) = res
-
-C
-            if (recvfromproc(k)) then
-C
-                Call MPI_RECV(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,statut,code)
-
-                imin_recv(:,k) = iminmax_temp(:,1,k)
-                imax_recv(:,k) = iminmax_temp(:,2,k)
-            endif
-
-C
-      enddo
-
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-C
-C
-            
-            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,code)
-C
-            if (sendtoproc(k)) then
-C
-                iminmax_temp(:,1,k) = imin(:,k)
-                iminmax_temp(:,2,k) = imax(:,k)
-
-                Call MPI_SEND(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-C
-            endif
-
-C
-      enddo
-C
-C
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank-1,0,-1
-C
-C
-            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
-     &                    MPI_COMM_AGRIF,statut,code)
-C
-            recvfromproc(k) = res
-
-C
-            if (recvfromproc(k)) then
-C
-                Call MPI_RECV(iminmax_temp(:,:,k),
-     &                        2*nbdim,MPI_INTEGER,k,etiquette,
-     &                        MPI_COMM_AGRIF,statut,code)
-
-                imin_recv(:,k) = iminmax_temp(:,1,k)
-                imax_recv(:,k) = iminmax_temp(:,2,k)
-            endif
-
-C
-      enddo
-
-          End Subroutine ExchangeSamelevel_first          
-
-       Subroutine ExchangeSameLevel2(sendtoproc,recvfromproc,
-     &   nbdim,
-     &          pttruetabwhole,cetruetabwhole,imin,imax,
-     &          imin_recv,imax_recv,memberout,tempC,tempCextend)
-      Implicit None
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: pttruetabwhole,
-     &     cetruetabwhole
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
-      TYPE(Agrif_PVARIABLE) :: tempC,tempCextend
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
-      LOGICAL                                    :: res
-      LOGICAL :: memberout
-      TYPE(AGRIF_PVARIABLE), SAVE                      :: temprecv
-
-      INCLUDE 'mpif.h'
-          INTEGER :: i,k
-          INTEGER :: etiquette = 100
-          INTEGER :: code, datasize
-          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
-
-      IF (memberout) THEN
-      Call Agrif_nbdim_allocation(tempCextend%var,
-     &                 pttruetabwhole(:,Agrif_ProcRank),
-     &                 cetruetabwhole(:,Agrif_ProcRank),nbdim)
-      call Agrif_nbdim_Full_VarEQreal(tempCextend%var,0.,nbdim)
-      ENDIF
-
-      IF (sendtoproc(Agrif_ProcRank)) THEN
-           Call Agrif_nbdim_VarEQvar(tempCextend%var,
-     &                               imin(:,Agrif_Procrank),
-     &                               imax(:,Agrif_Procrank),
-     &                               tempC%var,
-     &                               imin(:,Agrif_Procrank),
-     &                               imax(:,Agrif_Procrank),
-     &                               nbdim)
-      ENDIF
-
-      do k = 0,Agrif_ProcRank-1
-C
-C
-C
-            if (sendtoproc(k)) then
-C
-                datasize = 1
-C
-!CDIR SHORTLOOP
-                do i = 1,nbdim
-C
-                  datasize = datasize * (imax(i,k)-imin(i,k)+1)
-C
-                enddo
-C
-
-                SELECT CASE(nbdim)
-                CASE(1)
-                   Call MPI_SEND(tempC%var%array1(
-     &                        imin(1,k):imax(1,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(2)               
-                   Call MPI_SEND(tempC%var%array2(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(3)
-     
-                  Call Agrif_Send_3Darray(tempC%var%array3,
-     &             lbound(tempC%var%array3),imin(:,k),imax(:,k),k)
-                CASE(4)
-                   Call MPI_SEND(tempC%var%array4(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(5)
-                   Call MPI_SEND(tempC%var%array5(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(6)
-                   Call MPI_SEND(tempC%var%array6(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k),
-     &                        imin(6,k):imax(6,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                END SELECT
-C
-            endif
-
-C
-      enddo
-C
-C
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-
-C
-            if (recvfromproc(k)) then
-
-                datasize = 1
-C
-!CDIR SHORTLOOP
-                do i = 1,nbdim
-C
-                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
-C
-                enddo
-
-             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
-             call Agrif_nbdim_allocation(temprecv%var,imin_recv(:,k),
-     &   imax_recv(:,k),nbdim)
-            SELECT CASE(nbdim)
-            CASE(1)
-              Call MPI_RECV(temprecv%var%array1,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(2)           
-              Call MPI_RECV(temprecv%var%array2,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(3)       
-              Call MPI_RECV(temprecv%var%array3,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-
-            CASE(4)
-              Call MPI_RECV(temprecv%var%array4,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(5)
-              Call MPI_RECV(temprecv%var%array5,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(6)
-              Call MPI_RECV(temprecv%var%array6,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-       END SELECT
-                        
-            Call where_valtabtotab_mpi(tempCextend%var,
-     &             temprecv%var,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
-     
-                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
-C                deallocate(temprecv%var)
-
-            endif
-
-C
-      enddo
-
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
-C
-C
-            if (sendtoproc(k)) then
-C
-                SELECT CASE(nbdim)
-                CASE(1)
-                datasize=SIZE(tempC%var%array1(
-     &                        imin(1,k):imax(1,k)))
-                   Call MPI_SEND(tempC%var%array1(
-     &                        imin(1,k):imax(1,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(2)                
-                datasize=SIZE(tempC%var%array2(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k)))
-                   Call MPI_SEND(tempC%var%array2(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(3)
-                datasize=SIZE(tempC%var%array3(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k)))
-                   Call MPI_SEND(tempC%var%array3(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(4)
-                datasize=SIZE(tempC%var%array4(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k)))
-                   Call MPI_SEND(tempC%var%array4(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(5)
-                datasize=SIZE(tempC%var%array5(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k)))
-                   Call MPI_SEND(tempC%var%array5(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                CASE(6)
-                datasize=SIZE(tempC%var%array6(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k),
-     &                        imin(6,k):imax(6,k)))
-                   Call MPI_SEND(tempC%var%array6(
-     &                        imin(1,k):imax(1,k),
-     &                        imin(2,k):imax(2,k),
-     &                        imin(3,k):imax(3,k),
-     &                        imin(4,k):imax(4,k),
-     &                        imin(5,k):imax(5,k),
-     &                        imin(6,k):imax(6,k)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-                END SELECT
-C
-            endif
-
-C
-      enddo
-C
-C
-C     Reception from others processors of the necessary part of the parent grid
-      do k = Agrif_ProcRank-1,0,-1
-C
-
-C
-            if (recvfromproc(k)) then
-C
-             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
-             call Agrif_nbdim_allocation(temprecv%var,
-     &   imin_recv(:,k),imax_recv(:,k),nbdim)
-            SELECT CASE(nbdim)
-            CASE(1)
-              datasize=SIZE(temprecv%var%array1)
-              Call MPI_RECV(temprecv%var%array1,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(2)           
-              datasize=SIZE(temprecv%var%array2)
-              Call MPI_RECV(temprecv%var%array2,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(3)           
-              datasize=SIZE(temprecv%var%array3)
-              Call MPI_RECV(temprecv%var%array3,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-
-            CASE(4)
-              datasize=SIZE(temprecv%var%array4)
-              Call MPI_RECV(temprecv%var%array4,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(5)
-              datasize=SIZE(temprecv%var%array5)
-              Call MPI_RECV(temprecv%var%array5,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-            CASE(6)
-              datasize=SIZE(temprecv%var%array6)
-              Call MPI_RECV(temprecv%var%array6,
-     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &               MPI_COMM_AGRIF,statut,code)
-          END SELECT
-            
-            Call where_valtabtotab_mpi(tempCextend%var,
-     &             temprecv%var,imin_recv(:,k),imax_recv(:,k)
-     &            ,0.,nbdim)
-     
-                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
-C                deallocate(temprecv%var)
-            endif
-
-C
-      enddo
-                  
-          End Subroutine ExchangeSamelevel2
-          
-          Subroutine Agrif_Send_3Darray(tab3D,bounds,imin,imax,k)
-          integer, dimension(3) :: bounds, imin, imax
-          real,dimension(bounds(1):,bounds(2):,bounds(3):),target
-     &                             :: tab3D
-          integer :: k
-          integer :: etiquette = 100
-          integer :: datasize, code
-        INCLUDE 'mpif.h'
-
-          datasize = SIZE(tab3D(
-     &                       imin(1):imax(1),
-     &                        imin(2):imax(2),
-     &                        imin(3):imax(3)))
-       
-                   Call MPI_SEND(tab3D(
-     &                        imin(1):imax(1),
-     &                        imin(2):imax(2),
-     &                        imin(3):imax(3)),
-     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
-     &                        MPI_COMM_AGRIF,code)
-     
-         End Subroutine Agrif_Send_3Darray
-
-#else
-      Subroutine Agrif_mpp_empty()
-      End Subroutine Agrif_mpp_empty
-#endif
-
-      End Module Agrif_mpp
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90	(revision 5682)
@@ -0,0 +1,634 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+module Agrif_Mpp
+!
+    use Agrif_Arrays
+    use Agrif_Grids
+!
+    implicit none
+!
+    interface
+        subroutine Agrif_get_proc_info ( imin, imax, jmin, jmax )
+            integer, intent(out) :: imin, imax
+            integer, intent(out) :: jmin, jmax
+        end subroutine Agrif_get_proc_info
+    end interface
+!
+    integer, private :: Agrif_MPI_prec
+!
+    private :: Agrif_get_proc_info
+!
+contains
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!  subroutine Agrif_MPI_Init
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_MPI_Init ( comm )
+!---------------------------------------------------------------------------------------------------
+    integer, optional, intent(in) :: comm    !< MPI communicator to be attached to the root grid.
+!
+    include 'mpif.h'
+    integer :: code, ierr
+    logical :: mpi_was_called
+    integer :: current_mpi_prec
+!
+    call MPI_INITIALIZED( mpi_was_called, code )
+    if( code /= MPI_SUCCESS ) then
+        write(*,*) ': Error in routine mpi_initialized'
+        call MPI_ABORT( MPI_COMM_WORLD, code, ierr )
+    endif
+    if( .not. mpi_was_called ) then
+        write(*,*) '### AGRIF Error : you should call Agrif_MPI_Init *after* MPI_Init.'
+        stop
+    endif
+
+    current_mpi_prec = KIND(1.0)
+    if (current_mpi_prec == 4) then
+      Agrif_MPI_prec = MPI_REAL4
+    else
+      Agrif_MPI_prec = MPI_REAL8
+    endif
+!
+    if ( present(comm) ) then
+        call Agrif_MPI_switch_comm(comm)
+    else
+        call Agrif_MPI_switch_comm(MPI_COMM_WORLD)
+    endif
+!
+    Agrif_Mygrid % communicator = Agrif_mpi_comm
+!
+    if ( Agrif_Parallel_sisters ) then
+        call Agrif_Init_ProcList( Agrif_Mygrid % proc_def_list, Agrif_Nbprocs )
+        call Agrif_pl_copy( Agrif_Mygrid % proc_def_list, Agrif_Mygrid % required_proc_list )
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_MPI_Init
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_MPI_switch_comm ( comm )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: comm    !< MPI communicator you want to switch to.
+!
+    include 'mpif.h'
+    integer :: code
+    logical :: mpi_was_called
+!
+    call MPI_INITIALIZED( mpi_was_called, code )
+    if ( .not. mpi_was_called ) return
+!
+    call MPI_COMM_SIZE(comm, Agrif_Nbprocs, code)
+    call MPI_COMM_RANK(comm, Agrif_ProcRank, code)
+    Agrif_mpi_comm = comm
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_MPI_switch_comm
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_MPI_get_grid_comm ( ) result ( comm )
+!---------------------------------------------------------------------------------------------------
+    integer :: comm
+    comm = Agrif_Curgrid % communicator
+!---------------------------------------------------------------------------------------------------
+end function Agrif_MPI_get_grid_comm
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_MPI_set_grid_comm ( comm )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: comm
+    Agrif_Curgrid % communicator = comm
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_MPI_set_grid_comm
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_Init_ProcList ( proclist, nbprocs )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(inout) :: proclist
+    integer,               intent(in)    :: nbprocs
+!
+    include 'mpif.h'
+    type(Agrif_Proc), pointer     :: new_proc
+    integer                       :: p, ierr
+    integer                       :: imin, imax, jmin, jmax
+    integer, dimension(5)         :: local_proc_grid_info
+    integer, dimension(5,nbprocs) :: all_procs_grid_info
+!
+    call Agrif_get_proc_info(imin, imax, jmin, jmax)
+!
+    local_proc_grid_info(:) = (/Agrif_Procrank, imin, jmin, imax, jmax/)
+!
+    call MPI_ALLGATHER(local_proc_grid_info, 5, MPI_INTEGER, &
+                       all_procs_grid_info,  5, MPI_INTEGER, Agrif_mpi_comm, ierr)
+!
+    do p = 1,nbprocs
+!
+        allocate(new_proc)
+        new_proc % pn = all_procs_grid_info(1,p)
+        new_proc % imin(1) = all_procs_grid_info(2,p)
+        new_proc % imin(2) = all_procs_grid_info(3,p)
+        new_proc % imax(1) = all_procs_grid_info(4,p)
+        new_proc % imax(2) = all_procs_grid_info(5,p)
+        call Agrif_pl_append( proclist, new_proc )
+!
+    enddo
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_ProcList
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Get_External_Data_first
+!---------------------------------------------------------------------------------------------------
+subroutine Get_External_Data_first ( pttruetab, cetruetab, pttruetabwhole, cetruetabwhole,  &
+                                     nbdim, memberoutall, coords, sendtoproc, recvfromproc, &
+                                     imin, imax, imin_recv, imax_recv )
+!---------------------------------------------------------------------------------------------------
+    include 'mpif.h'
+!
+    integer,                                     intent(in)  :: nbdim
+    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(in)  :: pttruetab,     cetruetab
+    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(in)  :: pttruetabwhole,cetruetabwhole
+    logical, dimension(0:Agrif_Nbprocs-1),       intent(in)  :: memberoutall
+    integer, dimension(nbdim),                   intent(in)  :: coords
+    logical, dimension(0:Agrif_Nbprocs-1),       intent(out) :: sendtoproc
+    logical, dimension(0:Agrif_Nbprocs-1),       intent(out) :: recvfromproc
+    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(out) :: imin,imax
+    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(out) :: imin_recv,imax_recv
+!
+    integer :: imintmp, imaxtmp, i, j, k, i1
+    integer :: imin1,imax1
+    logical :: tochange,tochangebis
+    integer, dimension(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,cetruetab2
+!
+! pttruetab2 and cetruetab2 are modified arrays in order to always
+! send the most inner points
+!
+    pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
+    cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
+!
+    do k = 0,Agrif_Nbprocs-1
+    do i = 1,nbdim
+        tochangebis = .TRUE.
+        DO i1 = 1,nbdim
+            IF (i /= i1) THEN
+                IF ( (pttruetab(i1,Agrif_Procrank) /= pttruetab(i1,k))  .OR. &
+                     (cetruetab(i1,Agrif_Procrank) /= cetruetab(i1,k))) THEN
+                    tochangebis = .FALSE.
+                    EXIT
+                ENDIF
+            ENDIF
+        ENDDO
+        IF (tochangebis) THEN
+            imin1 = max(pttruetab(i,Agrif_Procrank), pttruetab(i,k))
+            imax1 = min(cetruetab(i,Agrif_Procrank), cetruetab(i,k))
+! Always send the most interior points
+
+            tochange = .false.
+            IF (cetruetab(i,Agrif_Procrank) > cetruetab(i,k)) THEN
+                DO j=imin1,imax1
+                    IF ((cetruetab(i,k)-j) > (j-pttruetab(i,Agrif_Procrank))) THEN
+                        imintmp = j+1
+                        tochange = .TRUE.
+                    ELSE
+                        EXIT
+                    ENDIF
+                ENDDO
+            ENDIF
+
+            if (tochange) then
+                pttruetab2(i,Agrif_Procrank) = imintmp
+            endif
+
+            tochange = .FALSE.
+            imaxtmp=0
+            IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k)) THEN
+                DO j=imax1,imin1,-1
+                    IF ((j-pttruetab(i,k)) > (cetruetab(i,Agrif_Procrank)-j)) THEN
+                        imaxtmp = j-1
+                        tochange = .TRUE.
+                    ELSE
+                        EXIT
+                    ENDIF
+                ENDDO
+            ENDIF
+
+            if (tochange) then
+                cetruetab2(i,Agrif_Procrank) = imaxtmp
+            endif
+        ENDIF
+    enddo
+    enddo
+
+    do k = 0,Agrif_NbProcs-1
+!
+        sendtoproc(k) = .true.
+!
+!CDIR SHORTLOOP
+        do i = 1,nbdim
+            imin(i,k) = max(pttruetab2(i,Agrif_Procrank), pttruetabwhole(i,k))
+            imax(i,k) = min(cetruetab2(i,Agrif_Procrank), cetruetabwhole(i,k))
+!
+            if ( (imin(i,k) > imax(i,k)) .and. (coords(i) /= 0) ) then
+                sendtoproc(k) = .false.
+            endif
+        enddo
+        IF ( .not. memberoutall(k) ) THEN
+            sendtoproc(k) = .false.
+        ENDIF
+    enddo
+!
+    call Exchangesamelevel_first(sendtoproc,nbdim,imin,imax,recvfromproc,imin_recv,imax_recv)
+!---------------------------------------------------------------------------------------------------
+end subroutine Get_External_Data_first
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine ExchangeSameLevel_first
+!---------------------------------------------------------------------------------------------------
+subroutine ExchangeSameLevel_first ( sendtoproc, nbdim, imin, imax, recvfromproc, &
+                                     imin_recv, imax_recv )
+!---------------------------------------------------------------------------------------------------
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(in)  :: sendtoproc
+    INTEGER,                                     intent(in)  :: nbdim
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)  :: imin
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)  :: imax
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(out) :: recvfromproc
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(out) :: imin_recv
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(out) :: imax_recv
+!
+    include 'mpif.h'
+    INTEGER :: k
+    INTEGER :: etiquette = 100
+    INTEGER :: code
+    LOGICAL :: res
+    INTEGER, DIMENSION(MPI_STATUS_SIZE)   :: statut
+    INTEGER, DIMENSION(nbdim,2,0:Agrif_Nbprocs-1)    :: iminmax_temp
+
+    do k = 0,Agrif_ProcRank-1
+!
+        call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,code)
+!
+        if (sendtoproc(k)) then
+            iminmax_temp(:,1,k) = imin(:,k)
+            iminmax_temp(:,2,k) = imax(:,k)
+            call MPI_SEND(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette,Agrif_mpi_comm,code)
+        endif
+!
+    enddo
+!
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+!
+        call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,statut,code)
+        recvfromproc(k) = res
+!
+        if (recvfromproc(k)) then
+            call MPI_RECV(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, &
+                    Agrif_mpi_comm,statut,code)
+            imin_recv(:,k) = iminmax_temp(:,1,k)
+            imax_recv(:,k) = iminmax_temp(:,2,k)
+        endif
+!
+    enddo
+
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+!
+        call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,code)
+!
+        if (sendtoproc(k)) then
+!
+            iminmax_temp(:,1,k) = imin(:,k)
+            iminmax_temp(:,2,k) = imax(:,k)
+
+            call MPI_SEND(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, &
+                    Agrif_mpi_comm,code)
+        endif
+!
+    enddo
+!
+!
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank-1,0,-1
+!
+        call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,statut,code)
+        recvfromproc(k) = res
+!
+        if (recvfromproc(k)) then
+!
+            call MPI_RECV(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, &
+                    Agrif_mpi_comm,statut,code)
+
+            imin_recv(:,k) = iminmax_temp(:,1,k)
+            imax_recv(:,k) = iminmax_temp(:,2,k)
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine ExchangeSamelevel_first
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine ExchangeSameLevel
+!---------------------------------------------------------------------------------------------------
+subroutine ExchangeSameLevel ( sendtoproc, recvfromproc, nbdim,    &
+                               pttruetabwhole, cetruetabwhole,     &
+                               imin, imax, imin_recv, imax_recv,   &
+                               memberout, tempC, tempCextend )
+!---------------------------------------------------------------------------------------------------
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(in)    :: sendtoproc
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(in)    :: recvfromproc
+    INTEGER,                                     intent(in)    :: nbdim
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: pttruetabwhole
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: cetruetabwhole
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: imin,      imax
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: imin_recv, imax_recv
+    LOGICAL,                                     intent(in)    :: memberout
+    TYPE(Agrif_Variable), pointer,               intent(inout) :: tempC, tempCextend
+!
+    include 'mpif.h'
+    INTEGER :: i,k
+    INTEGER :: etiquette = 100
+    INTEGER :: code, datasize
+    INTEGER, DIMENSION(MPI_STATUS_SIZE)   :: statut
+    TYPE(Agrif_Variable), pointer, SAVE   :: temprecv
+!
+    IF (memberout) THEN
+        call Agrif_array_allocate(tempCextend, pttruetabwhole(:,Agrif_ProcRank),  &
+                                               cetruetabwhole(:,Agrif_ProcRank),nbdim)
+        call Agrif_var_set_array_tozero(tempCextend,nbdim)
+    ENDIF
+!
+    IF (sendtoproc(Agrif_ProcRank)) THEN
+        call Agrif_var_copy_array(tempCextend,imin(:,Agrif_Procrank),imax(:,Agrif_Procrank), &
+                                  tempC,      imin(:,Agrif_Procrank),imax(:,Agrif_Procrank), &
+                                  nbdim)
+    ENDIF
+!
+    do k = 0,Agrif_ProcRank-1
+!
+        if (sendtoproc(k)) then
+!
+            datasize = 1
+!
+!CDIR SHORTLOOP
+            do i = 1,nbdim
+                datasize = datasize * (imax(i,k)-imin(i,k)+1)
+            enddo
+!
+            SELECT CASE(nbdim)
+            CASE(1)
+                call MPI_SEND(tempC%array1(imin(1,k):imax(1,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(2)
+                call MPI_SEND(tempC%array2(imin(1,k):imax(1,k),     &
+                                           imin(2,k):imax(2,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(3)
+                call Agrif_Send_3Darray(tempC%array3,lbound(tempC%array3),imin(:,k),imax(:,k),k)
+            CASE(4)
+                call MPI_SEND(tempC%array4(imin(1,k):imax(1,k),     &
+                                           imin(2,k):imax(2,k),     &
+                                           imin(3,k):imax(3,k),     &
+                                           imin(4,k):imax(4,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(5)
+                call MPI_SEND(tempC%array5(imin(1,k):imax(1,k),     &
+                                           imin(2,k):imax(2,k),     &
+                                           imin(3,k):imax(3,k),     &
+                                           imin(4,k):imax(4,k),     &
+                                           imin(5,k):imax(5,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(6)
+                call MPI_SEND(tempC%array6(imin(1,k):imax(1,k),     &
+                                           imin(2,k):imax(2,k),     &
+                                           imin(3,k):imax(3,k),     &
+                                           imin(4,k):imax(4,k),     &
+                                           imin(5,k):imax(5,k),     &
+                                           imin(6,k):imax(6,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            END SELECT
+!
+        endif
+    enddo
+!
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+!
+        if (recvfromproc(k)) then
+!
+            datasize = 1
+!
+!CDIR SHORTLOOP
+            do i = 1,nbdim
+                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
+            enddo
+
+            if (.not.associated(temprecv)) allocate(temprecv)
+            call Agrif_array_allocate(temprecv,imin_recv(:,k),imax_recv(:,k),nbdim)
+
+            SELECT CASE(nbdim)
+            CASE(1)
+                call MPI_RECV(temprecv%array1,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(2)
+                call MPI_RECV(temprecv%array2,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(3)
+                call MPI_RECV(temprecv%array3,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(4)
+                call MPI_RECV(temprecv%array4,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(5)
+                call MPI_RECV(temprecv%array5,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(6)
+                call MPI_RECV(temprecv%array6,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            END SELECT
+
+            call Agrif_var_replace_value(tempCextend,temprecv,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
+            call Agrif_array_deallocate(temprecv,nbdim)
+!
+        endif
+    enddo
+
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+!
+        if (sendtoproc(k)) then
+!
+            SELECT CASE(nbdim)
+            CASE(1)
+                datasize=SIZE(tempC%array1(imin(1,k):imax(1,k)))
+                call MPI_SEND(tempC%array1(imin(1,k):imax(1,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(2)
+                datasize=SIZE(tempC%array2(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k)))
+                call MPI_SEND(tempC%array2(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(3)
+                datasize=SIZE(tempC%array3(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k)))
+                call MPI_SEND(tempC%array3(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(4)
+                datasize=SIZE(tempC%array4(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k)))
+                call MPI_SEND(tempC%array4(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(5)
+                datasize=SIZE(tempC%array5(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k),     &
+                                               imin(5,k):imax(5,k)))
+                call MPI_SEND(tempC%array5(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k),     &
+                                               imin(5,k):imax(5,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(6)
+                datasize=SIZE(tempC%array6(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k),     &
+                                               imin(5,k):imax(5,k),     &
+                                               imin(6,k):imax(6,k)))
+                call MPI_SEND(tempC%array6(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k),     &
+                                               imin(5,k):imax(5,k),     &
+                                               imin(6,k):imax(6,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            END SELECT
+!
+        endif
+!
+    enddo
+!
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank-1,0,-1
+!
+        if (recvfromproc(k)) then
+!
+            if (.not.associated(temprecv)) allocate(temprecv)
+            call Agrif_array_allocate(temprecv,imin_recv(:,k),imax_recv(:,k),nbdim)
+
+            SELECT CASE(nbdim)
+            CASE(1)
+                datasize=SIZE(temprecv%array1)
+                call MPI_RECV(temprecv%array1,datasize,Agrif_MPI_prec,k,etiquette,&
+                        Agrif_mpi_comm,statut,code)
+            CASE(2)
+                datasize=SIZE(temprecv%array2)
+                call MPI_RECV(temprecv%array2,datasize,Agrif_MPI_prec,k,etiquette,&
+                        Agrif_mpi_comm,statut,code)
+            CASE(3)
+                datasize=SIZE(temprecv%array3)
+                call MPI_RECV(temprecv%array3,datasize,Agrif_MPI_prec,k,etiquette,&
+                        Agrif_mpi_comm,statut,code)
+            CASE(4)
+                datasize=SIZE(temprecv%array4)
+                call MPI_RECV(temprecv%array4,datasize,Agrif_MPI_prec,k,etiquette,&
+                          Agrif_mpi_comm,statut,code)
+            CASE(5)
+                datasize=SIZE(temprecv%array5)
+                call MPI_RECV(temprecv%array5,datasize,Agrif_MPI_prec,k,etiquette,&
+                         Agrif_mpi_comm,statut,code)
+            CASE(6)
+                datasize=SIZE(temprecv%array6)
+                call MPI_RECV(temprecv%array6,datasize,Agrif_MPI_prec,k,etiquette,&
+                        Agrif_mpi_comm,statut,code)
+            END SELECT
+
+            call Agrif_var_replace_value(tempCextend,temprecv,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
+            call Agrif_array_deallocate(temprecv,nbdim)
+!
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine ExchangeSamelevel
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Send_3Darray
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Send_3Darray ( tab3D, bounds, imin, imax, k )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(3),                                     intent(in) :: bounds
+    real, dimension(bounds(1):,bounds(2):,bounds(3):), target, intent(in) :: tab3D
+    integer, dimension(3),                                     intent(in) :: imin, imax
+    integer,                                                   intent(in) :: k
+!
+    integer :: etiquette = 100
+    integer :: datasize, code
+    include 'mpif.h'
+
+    datasize = SIZE(tab3D(imin(1):imax(1),  &
+                          imin(2):imax(2),  &
+                          imin(3):imax(3)))
+
+    call MPI_SEND( tab3D( imin(1):imax(1),  &
+                          imin(2):imax(2),  &
+                          imin(3):imax(3)), &
+                          datasize,Agrif_MPI_prec,k,etiquette,Agrif_mpi_comm,code)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Send_3Darray
+!===================================================================================================
+!
+#else
+    subroutine dummy_Agrif_Mpp ()
+    end subroutine dummy_Agrif_Mpp
+#endif
+!
+end Module Agrif_Mpp
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90	(revision 5682)
@@ -0,0 +1,208 @@
+module Agrif_Procs
+!
+    implicit none
+!
+    type Agrif_Proc
+        integer               :: pn       !< Proc index in coarse grid
+        integer               :: pi       !< Proc index in x-direction (informative only, could be removed)
+        integer               :: pj       !< Proc index in y-direction (informative only, could be removed)
+        integer, dimension(3) :: imin
+        integer, dimension(3) :: imax
+        integer               :: nb_seqs = 0  !< Number of integration sequences the proc is attached to.
+        integer               :: grid_id = 0  !< Grid id the proc is attached to.
+    end type Agrif_Proc
+!
+    type Agrif_Proc_p
+        type(Agrif_Proc),   pointer   :: proc => NULL()  !< Pointer to the actual proc structure
+        type(Agrif_Proc_p), pointer   :: next => NULL()  !< Next proc in the list
+    end type Agrif_Proc_p
+!
+    type Agrif_Proc_List
+        integer                       :: nitems = 0      !< Number of elements in the list
+        type(Agrif_Proc_p), pointer   :: first => NULL() !< First proc in the list
+        type(Agrif_Proc_p), pointer   :: last  => NULL() !< Last proc inserted in the list
+    end type Agrif_Proc_List
+!
+contains
+!
+!===================================================================================================
+subroutine Agrif_pl_append ( proclist, proc )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List),     intent(inout)  :: proclist
+    type(Agrif_Proc), pointer, intent(in)     :: proc
+!
+    type(Agrif_Proc_p), pointer   :: new_pp
+!
+    allocate( new_pp )
+!
+    new_pp % proc => proc
+    new_pp % next => NULL()
+!
+    if ( associated(proclist % last) ) then
+        ! the list is not empty, let 'proc' be the next after the last (ie. the last one).
+        proclist % last % next => new_pp
+    else
+        ! the list has just been initialized. Let 'proc' be the first one.
+        proclist % first => new_pp
+    endif
+    ! anyway, for next time 'proc' will be the last one. 
+    proclist % last => new_pp
+    proclist % nitems = proclist % nitems + 1
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_append
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_print_array ( proclist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in) :: proclist
+!
+    type(Agrif_Proc_p), pointer :: pp
+    type(Agrif_Proc),   pointer :: proc
+!
+    pp => proclist % first
+!
+    write(*,'("/-------+-----+-----+------+------+------+------+------\")')
+    write(*,'("| iproc | ipx | ipy | imin | imax | jmin | jmax | grid |")')
+    write(*,'("|-------+-----+-----+------+------+------+------+------|")')
+    do while ( associated(pp) )
+        proc => pp % proc
+        write(*,'("|",i6," |",i4," |",i4," |",i5," :",i5," |",i5," :",i5," | ",i4," |")') &
+            proc % pn, proc % pi, proc % pj, proc % imin(1), proc % imax(1), proc % imin(2), proc % imax(2), &
+            proc % grid_id
+        pp => pp % next
+    enddo
+    write(*,'("\-------+-----+-----+------+------+------+------+------/")')
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_print_array
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_print ( proclist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in) :: proclist
+!
+    type(Agrif_Proc_p), pointer :: pp
+!
+    pp => proclist % first
+    do while ( associated(pp) )
+        write(*,'(i0,",")',advance='no') pp % proc % pn
+        pp => pp % next
+    enddo
+    write(*,*)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_print
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_copy ( proclist, copy )
+!
+!< Carries out a copy of 'proclist' into 'copy'
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in)    :: proclist
+    type(Agrif_Proc_List), intent(out)   :: copy
+!
+    type(Agrif_Proc_p),    pointer    :: pp
+!
+    call Agrif_pl_clear(copy)
+!
+    pp => proclist % first
+    do while ( associated(pp) )
+        call Agrif_pl_append( copy, pp % proc )
+        pp => pp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_copy
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_deep_copy ( proclist, copy )
+!
+!< Carries out a deep copy of 'proclist' into 'copy'
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in)    :: proclist
+    type(Agrif_Proc_List), intent(out)   :: copy
+!
+    type(Agrif_Proc_p), pointer :: pp
+    type(Agrif_Proc),   pointer :: new_proc
+!
+    call Agrif_pl_clear(copy)
+!
+    pp => proclist % first
+    do while ( associated(pp) )
+        allocate( new_proc )
+        new_proc = pp % proc
+        call Agrif_pl_append( copy, new_proc )
+        pp => pp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_deep_copy
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_clear ( proclist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(inout)  :: proclist
+!
+    type(Agrif_Proc_p), pointer    :: pp, ppd
+!
+    pp => proclist % first
+!    
+    do while( associated(pp) )
+        ppd => pp
+        pp  => pp % next
+        deallocate(ppd)
+    enddo
+    
+    proclist % first => NULL()
+    proclist % last  => NULL()
+    proclist % nitems = 0
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_clear
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_to_array ( proclist, procarray )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List),                       intent(in)   :: proclist
+    type(Agrif_Proc), dimension(:), allocatable, intent(out)  :: procarray
+!
+    type(Agrif_Proc_p), pointer   :: pp
+!
+    allocate( procarray(1:proclist % nitems) )
+!
+    pp => proclist % first
+    do while ( associated(pp) )
+        procarray(pp%proc%pn+1) = pp % proc
+        pp => pp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_to_array
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_pl_search_proc ( proclist, rank ) result ( proc )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in)   :: proclist
+    integer,               intent(in)   :: rank
+!
+    type(Agrif_Proc_p), pointer :: pp
+    type(Agrif_Proc),   pointer :: proc
+    logical :: found
+!
+    found = .false.
+    proc => NULL()
+    pp => proclist % first
+    do while ( .not.found .and. associated(pp) )
+        if ( pp % proc % pn == rank ) then
+            proc => pp % proc
+            return
+        else
+            pp => pp % next
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_pl_search_proc
+!===================================================================================================
+!
+end module Agrif_Procs
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F	(revision 5659)
+++ 	(revision )
@@ -1,937 +1,0 @@
-!
-! $Id$
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Save  
-C
-      Module Agrif_Save 
-C
-CCC   Description:   
-CCC   Module for the initialization by copy of the grids created by clustering.
-C
-C     Modules used:
-C      
-      Use Agrif_Types
-      Use Agrif_Link
-      Use Agrif_Arrays
-      Use Agrif_Variables
-C
-      IMPLICIT NONE
-C
-      Contains
-C     Definition of procedures contained in this module.
-C
-C
-      Subroutine Agrif_Deallocate_Arrays(Var)
-      type(Agrif_Variable), pointer :: Var
-      
-            if (ALLOCATED(var%array1)) then
-               Deallocate(var%array1)
-            endif
-            if (ALLOCATED(var%array2)) then
-               Deallocate(var%array2)
-            endif
-            if (ALLOCATED(var%array3)) then
-               Deallocate(var%array3)
-            endif
-            if (ALLOCATED(var%array4)) then
-               Deallocate(var%array4)
-            endif
-            if (ALLOCATED(var%array5)) then
-               Deallocate(var%array5)
-            endif
-            if (ALLOCATED(var%array6)) then
-               Deallocate(var%array6)
-            endif
-C
-            if (ALLOCATED(var%darray1)) then
-               Deallocate(var%darray1)
-            endif
-            if (ALLOCATED(var%darray2)) then
-               Deallocate(var%darray2)
-            endif
-            if (ALLOCATED(var%darray3)) then
-               Deallocate(var%darray3)
-            endif
-            if (ALLOCATED(var%darray4)) then
-               Deallocate(var%darray4)
-            endif
-            if (ALLOCATED(var%darray5)) then
-               Deallocate(var%darray5)
-            endif
-            if (ALLOCATED(var%darray6)) then
-               Deallocate(var%darray6)
-            endif
-C
-            if (ALLOCATED(var%larray1)) then
-               Deallocate(var%larray1)
-            endif
-            if (ALLOCATED(var%larray2)) then
-               Deallocate(var%larray2)
-            endif
-            if (ALLOCATED(var%larray3)) then
-               Deallocate(var%larray3)
-            endif
-            if (ALLOCATED(var%larray4)) then
-               Deallocate(var%larray4)
-            endif
-            if (ALLOCATED(var%larray5)) then
-               Deallocate(var%larray5)
-            endif
-            if (ALLOCATED(var%larray6)) then
-               Deallocate(var%larray6)
-            endif
-C
-            if (ALLOCATED(var%iarray1)) then
-               Deallocate(var%iarray1)
-            endif
-            if (ALLOCATED(var%iarray2)) then
-               Deallocate(var%iarray2)
-            endif
-            if (ALLOCATED(var%iarray3)) then
-               Deallocate(var%iarray3)
-            endif
-            if (ALLOCATED(var%iarray4)) then
-               Deallocate(var%iarray4)
-            endif
-            if (ALLOCATED(var%iarray5)) then
-               Deallocate(var%iarray5)
-            endif
-            if (ALLOCATED(var%iarray6)) then
-               Deallocate(var%iarray6)
-            endif
-C
-            if (ALLOCATED(var%carray1)) then
-               Deallocate(var%carray1)
-            endif
-            if (ALLOCATED(var%carray2)) then
-               Deallocate(var%carray2)
-            endif
-C
-            if (associated(var%oldvalues2D)) then
-               Deallocate(var%oldvalues2D)
-            endif
-            if (associated(var%interpIndex)) then
-               Deallocate(var%interpIndex)
-            endif
-            
-            if (associated(var%posvar)) then
-               Deallocate(var%posvar)
-            endif     
-            
-            if (associated(var%interptab)) then
-               Deallocate(var%interptab)
-            endif
-            
-      Return
-      End Subroutine Agrif_Deallocate_Arrays    
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Free_data_before
-C     **************************************************************************
-C
-      Subroutine Agrif_Free_data_before(Agrif_Gr)
-C
-CCC   Description:
-CCC   
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      TYPE(Agrif_Grid),pointer   :: Agrif_Gr ! Pointer on the current grid
-      INTEGER i 
-      Type(Agrif_List_Variables), pointer :: parcours      
-C
-C   
-      do i = 1 , AGRIF_NbVariables
-         if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then
-C 
-            call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var)
-            
-       endif
-           
-C
-       if (associated(Agrif_Gr%tabvars(i)%var%list_interp)) then
-         Call Agrif_Free_list_interp
-     &                          (Agrif_Gr%tabvars(i)%var%list_interp)
-       endif                             
-C
-       if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then
-            Deallocate(Agrif_Gr%tabvars(i)%var)
-C 
-        endif
-      enddo
-      
-      parcours => Agrif_Gr%variables
-    
-      do i=1,Agrif_Gr%NbVariables
-       if (.NOT. parcours%pvar%var%root_var%restaure) then
-        call Agrif_Deallocate_Arrays(parcours%pvar%var)
-       endif
-        if (associated(parcours%pvar%var%list_interp)) then
-           Call Agrif_Free_list_interp
-     &                          (parcours%pvar%var%list_interp)
-         endif                             
-C
-       if ( .NOT. parcours%pvar%var%root_var % restaure) then
-            Deallocate(parcours%pvar%var)
-C 
-        endif
-        parcours => parcours%nextvariable
-      enddo
-C
-C 
-C
-      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
-         if ( Agrif_Probdim .EQ. 1 ) Deallocate(Agrif_Gr%tabpoint1D)
-         if ( Agrif_Probdim .EQ. 2 ) Deallocate(Agrif_Gr%tabpoint2D)
-         if ( Agrif_Probdim .EQ. 3 ) Deallocate(Agrif_Gr%tabpoint3D)
-      endif
-C          
-      Return
-C
-C
-      End Subroutine Agrif_Free_data_before
-C
-C
-      Recursive Subroutine Agrif_Free_list_interp(list_interp)
-      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
-      
-      if (associated(list_interp%suiv))
-     &      Call Agrif_Free_list_interp(list_interp%suiv)
-     
-#ifdef key_mpp_mpi
-       Deallocate(list_interp%interp_loc%tab4t)
-       Deallocate(list_interp%interp_loc%memberinall)
-       Deallocate(list_interp%interp_loc%sendtoproc1)
-       Deallocate(list_interp%interp_loc%recvfromproc1)
-#endif
-       Deallocate(list_interp%interp_loc)
-       Deallocate(list_interp)
-       Nullify(list_interp)
-
-      End Subroutine Agrif_Free_list_interp      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Free_data_after
-C     **************************************************************************
-C      
-      Subroutine Agrif_Free_data_after(Agrif_Gr)
-C
-CCC   Description:
-CCC   
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-C
-      
-C
-C     Pointer argument    
-      TYPE(Agrif_Grid),pointer   :: Agrif_Gr  ! Pointer on the current grid
-      INTEGER i
-      Type(Agrif_List_Variables), pointer :: parcours, rootparcours
-C
-C      
-      do i = 1 , AGRIF_NbVariables
-         if ( Agrif_Mygrid % tabvars(i) % var % restaure) then
-            
-         call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var)
-         !
-            Deallocate(Agrif_Gr%tabvars(i)%var)
-! 
-         endif
-      enddo
-      
-      parcours => Agrif_Gr%variables
-      rootparcours=>Agrif_Mygrid%variables
-    
-      do i=1,Agrif_Gr%NbVariables
-       if (rootparcours%pvar%var%restaure) then
-        call Agrif_Deallocate_Arrays(parcours%pvar%var)
-      
-            Deallocate(parcours%pvar%var)
-C 
-        endif
-        parcours => parcours%nextvariable
-        rootparcours => rootparcours%nextvariable        
-      enddo
-            
-C
-C      
-      Return
-C
-C
-      End Subroutine Agrif_Free_data_after      
-C
-C
-CC    **************************************************************************
-CCC   Subroutine AGRIF_CopyFromold_All
-C     **************************************************************************
-C
-      Recursive Subroutine AGRIF_CopyFromold_All(g,oldchildgrids)
-C
-CCC   Description:
-CCC   Routine called in the Agrif_Init_Hierarchy procedure 
-C       (Agrif_Clustering module). 
-C
-CC    Method:        
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      TYPE(AGRIF_grid),pointer   :: g ! Pointer on the current grid
-      TYPE(AGRIF_pgrid),pointer   :: oldchildgrids
-C
-C     Local pointer
-      TYPE(AGRIF_pgrid),pointer  :: parcours ! Pointer for the recursive 
-                                             ! procedure 
-      REAL g_eps,eps,oldgrid_eps
-      INTEGER :: out
-      INTEGER :: iii
-C
-      out = 0
-C                                                                           
-      parcours => oldchildgrids  
-C
-      do while (associated(parcours))
-C 
-        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
-C        
-            g_eps = huge(1.)
-            oldgrid_eps = huge(1.)
-            do iii = 1 , Agrif_Probdim
-               g_eps = min(g_eps,g % Agrif_d(iii))
-               oldgrid_eps = min(oldgrid_eps,
-     &                       parcours % gr % Agrif_d(iii))
-            enddo
-C
-            eps = min(g_eps,oldgrid_eps)/100.                  
-C
-            do iii = 1 , Agrif_Probdim
-
-               if (g % Agrif_d(iii) .LT. 
-     &             (parcours % gr % Agrif_d(iii) - eps)) then
-C            
-                   parcours => parcours % next
-C            
-                   out = 1
-C   
-                   Exit
-C             
-               endif
-C      
-            enddo
-        if ( out .EQ. 1 ) Cycle
-C
-            Call AGRIF_CopyFromOld(g,parcours%gr)
-C
-        endif
-C                     
-        Call Agrif_CopyFromold_All
-     &             (g, parcours % gr % child_grids)
-C        
-        parcours => parcours % next
-C        
-      enddo
-C
-C     
-      Return      
-C
-C
-      End Subroutine AGRIF_CopyFromold_All
-C
-C
-C      
-C     **************************************************************************
-CCC   Subroutine Agrif_CopyFromold
-C     **************************************************************************
-C      
-      Subroutine Agrif_CopyFromold(Agrif_New_Gr,Agrif_Old_Gr)
-C
-CCC   Description:
-CCC   Call to the Agrif_Copy procedure.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr  ! Pointer on the current grid
-      TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
-      INTEGER :: i
-C
-C      
-      do i = 1 , AGRIF_NbVariables
-         if ( Agrif_Mygrid % tabvars(i) % var % restaure ) then
-C
-            Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,
-     &           Agrif_New_Gr % tabvars(i),
-     &           Agrif_Old_Gr % tabvars(i))
-C
-        endif
-      enddo
-
-C      
-C            
-      Return
-C
-C      
-      End Subroutine Agrif_CopyFromold
-      
-CC    **************************************************************************
-CCC   Subroutine AGRIF_CopyFromold_AllOneVar
-C     **************************************************************************
-C
-      Recursive Subroutine AGRIF_CopyFromold_AllOneVar(g,oldchildgrids,
-     &   indic)
-C
-CCC   Description:
-CCC   Routine called in the Agrif_Init_Hierarchy procedure 
-C       (Agrif_Clustering module). 
-C
-CC    Method:        
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      TYPE(AGRIF_grid),pointer   :: g ! Pointer on the current grid
-      TYPE(AGRIF_pgrid),pointer   :: oldchildgrids
-      integer :: indic
-C
-C     Local pointer
-      TYPE(AGRIF_pgrid),pointer  :: parcours ! Pointer for the recursive 
-                                             ! procedure 
-      REAL g_eps,eps,oldgrid_eps
-      INTEGER :: out
-      INTEGER :: iii
-C
-      out = 0
-C                                                                           
-      parcours => oldchildgrids  
-C
-      do while (associated(parcours))
-C 
-        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
-C        
-            g_eps = huge(1.)
-            oldgrid_eps = huge(1.)
-            do iii = 1 , Agrif_Probdim
-               g_eps = min(g_eps,g % Agrif_d(iii))
-               oldgrid_eps = min(oldgrid_eps,
-     &                       parcours % gr % Agrif_d(iii))
-            enddo
-C
-            eps = min(g_eps,oldgrid_eps)/100.                  
-C
-            do iii = 1 , Agrif_Probdim
-
-               if (g % Agrif_d(iii) .LT. 
-     &             (parcours % gr % Agrif_d(iii) - eps)) then
-C            
-                   parcours => parcours % next
-C            
-                   out = 1
-C   
-                   Exit
-C             
-               endif
-C      
-            enddo
-        if ( out .EQ. 1 ) Cycle
-C
-            Call AGRIF_CopyFromOldOneVar(g,parcours%gr,indic)
-C
-        endif
-C                     
-        Call Agrif_CopyFromold_AllOneVar
-     &             (g, parcours % gr % child_grids,indic)
-C        
-        parcours => parcours % next
-C        
-      enddo
-C
-C     
-      Return      
-C
-C
-      End Subroutine AGRIF_CopyFromold_AllOneVar
-C
-C
-C      
-C     **************************************************************************
-CCC   Subroutine Agrif_CopyFromoldOneVar
-C     **************************************************************************
-C      
-      Subroutine Agrif_CopyFromoldOneVar(Agrif_New_Gr,Agrif_Old_Gr,
-     &    indic)
-C
-CCC   Description:
-CCC   Call to the Agrif_Copy procedure.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr  ! Pointer on the current grid
-      TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
-      INTEGER :: indic
-      INTEGER :: i
-      TYPE(Agrif_PVariable),Pointer ::tabvars,oldtabvars      
-C
-C      
-      tabvars => Agrif_Search_Variable(Agrif_New_Gr,-indic)
-      oldtabvars => Agrif_Search_Variable(Agrif_Old_Gr,-indic)
-
-      Call Agrif_Nbdim_Allocation(tabvars%var,
-     &  tabvars%var%lb,tabvars%var%ub,
-     &  tabvars%var%nbdim)
-     
-      Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,
-     &           tabvars,oldtabvars)
-
-
-C      
-C            
-      Return
-C
-C      
-      End Subroutine Agrif_CopyFromoldOneVar      
-      
-C
-C
-CC
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Copy
-C     **************************************************************************
-C      
-      Subroutine Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,New_Var,Old_Var)
-C     
-CCC   Description:
-CCC   Sets arguments of the Agrif_UpdatenD procedures, n being the number of 
-CCC   DIMENSION of the grid variable.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-      
-C
-C     Pointer argument    
-      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr   ! Pointer on the current grid
-      TYPE(Agrif_Grid), Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
-      TYPE(Agrif_Pvariable) :: New_Var, Old_Var
-      INTEGER :: nbdim                  ! Number of dimensions of the current 
-                                        ! grid      
-      INTEGER,DIMENSION(6) :: pttabnew  ! Indexes of the first point in the 
-                                        ! domain
-      INTEGER,DIMENSION(6) :: petabnew  ! Indexes of the first point in the 
-                                        ! domain
-      INTEGER,DIMENSION(6) :: pttabold  ! Indexes of the first point in the 
-                                        ! domain
-      INTEGER,DIMENSION(6) :: petabold  ! Indexes of the first point in the 
-                                        ! domain
-      INTEGER,DIMENSION(6) :: nbtabold  ! Number of cells in each direction
-      
-      INTEGER,DIMENSION(6) :: nbtabnew  ! Number of cells in each direction   
-      TYPE(AGRIF_Variable), Pointer :: root ! Pointer on the variable of the 
-                                            ! root grid
-      REAL, DIMENSION(6) :: snew,sold
-      REAL, DIMENSION(6) :: dsnew,dsold                              
-      REAL :: eps
-      INTEGER :: n
-C
-C  
-      root => New_Var % var % root_var 
-C      
-      nbdim = root % nbdim
-C         
-      do n=1,nbdim
-C  
-        select case(root % interptab(n))
-C        
-        case('x')                
-C
-          pttabnew(n) = root % point(1)
-C        
-          pttabold(n) = root % point(1)
-C        
-          snew(n) = Agrif_New_Gr % Agrif_x(1)
-C
-          sold(n) = Agrif_Old_Gr % Agrif_x(1) 
-C        
-          dsnew(n) = Agrif_New_Gr % Agrif_d(1)
-C
-          dsold(n) = Agrif_Old_Gr % Agrif_d(1)
-C                      
-          if (root % posvar(n) .EQ. 1) then
-C          
-              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(1)
-C          
-              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(1)         
-C        
-            else
-C          
-              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(1) - 1
-C          
-              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(1) - 1
-C
-              snew(n) = snew(n) + dsnew(n)/2.
-C
-              sold(n) = sold(n) + dsold(n)/2.
-C        
-          endif           
-C        
-        case('y')
-C        
-          pttabnew(n) = root % point(2)
-C        
-          pttabold(n) = root % point(2)
-C        
-          snew(n) = Agrif_New_Gr % Agrif_x(2)
-C        
-          sold(n) = Agrif_Old_Gr % Agrif_x(2)
-C        
-          dsnew(n) = Agrif_New_Gr % Agrif_d(2)
-C        
-          dsold(n) = Agrif_Old_Gr % Agrif_d(2)
-C                
-          if (root % posvar(n) .EQ. 1) then
-C        
-              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(2)
-C          
-              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(2)         
-C        
-            else
-C          
-              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(2) - 1
-C          
-              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(2) - 1
-C
-              snew(n) = snew(n) + dsnew(n)/2.
-C
-              sold(n) = sold(n) + dsold(n)/2.                    
-C        
-          endif 
-C        
-        case('z')
-C        
-          pttabnew(n) = root % point(3)
-C        
-          pttabold(n) = root % point(3)
-C        
-          snew(n) = Agrif_New_Gr % Agrif_x(3)
-C        
-          sold(n) = Agrif_Old_Gr % Agrif_x(3)
-C        
-          dsnew(n) = Agrif_New_Gr % Agrif_d(3)
-C        
-          dsold(n) = Agrif_Old_Gr % Agrif_d(3)
-C                
-          if (root % posvar(n) .EQ. 1) then
-C        
-              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(3)
-C          
-              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(3)         
-C        
-            else
-C          
-             petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(3) - 1
-C          
-             petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(3) - 1
-C
-             snew(n) = snew(n) + dsnew(n)/2.
-C
-             sold(n) = sold(n) + dsold(n)/2.                   
-C        
-          endif
-C          
-        case('N')
-C        
-          Call Agrif_nbdim_Get_bound(New_Var%var,
-     &                           pttabnew(n),petabnew(n),
-     &                           n,nbdim)
-C        
-          pttabold(n) = pttabnew(n)
-C      
-          petabold(n) = petabnew(n)
-C              
-          snew(n) = 0.
-C      
-          sold(n) = 0. 
-C      
-          dsnew(n) = 1.
-C      
-          dsold(n) = 1.
-C        
-        end select
-C      
-      enddo
-C      
-      do n = 1,nbdim
-C      
-        nbtabnew(n) = petabnew(n) - pttabnew(n)
-C      
-        nbtabold(n) = petabold(n) - pttabold(n)      
-C 
-      enddo      
-C
-      eps = min(minval(dsnew(1:nbdim)),minval(dsold(1:nbdim)))
-C     
-      eps = eps/100.      
-C      
-      do n = 1,nbdim
-C      
-        if (snew(n) .GT. (sold(n)+dsold(n)*nbtabold(n)+eps)) Return
-C      
-        if ((snew(n)+dsnew(n)*nbtabnew(n)-eps) .LT. sold(n)) Return
-C      
-      enddo
-C            
-C
-      Call AGRIF_CopynD
-     &        (New_Var,Old_Var,pttabold,petabold,pttabnew,petabnew,
-     &         sold,snew,dsold,dsnew,nbdim) 
-C      
-C 
-      Return
-C      
-C
-      End Subroutine Agrif_Copy
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_CopynD
-C     **************************************************************************
-C      
-      Subroutine Agrif_CopynD(New_Var,Old_Var,pttabold,petabold,
-     &                        pttabnew,petabnew,sold,snew,dsold,
-     &                        dsnew,nbdim)
-C     
-CCC   Description:
-CCC   Copy of the nD New_Var variable from the nD Old_Var variable.
-C
-CC    Method:
-CC            
-C
-C     Declarations:
-C
-      
-C
-      INTEGER :: nbdim
-      TYPE(Agrif_Pvariable) :: New_Var, Old_Var     
-      INTEGER,DIMENSION(nbdim) :: pttabnew 
-      INTEGER,DIMENSION(nbdim) :: petabnew
-      INTEGER,DIMENSION(nbdim) :: pttabold
-      INTEGER,DIMENSION(nbdim) :: petabold      
-      REAL, DIMENSION(nbdim) :: snew,sold
-      REAL, DIMENSION(nbdim) :: dsnew,dsold 
-C
-      INTEGER :: i,j,k,l,m,n,i0,j0,k0,l0,m0,n0
-C
-      REAL, DIMENSION(nbdim) :: dim_gmin,dim_gmax
-      REAL, DIMENSION(nbdim) :: dim_newmin,dim_newmax
-      REAL, DIMENSION(nbdim) :: dim_min
-      INTEGER, DIMENSION(nbdim) :: ind_gmin,ind_newmin
-      INTEGER, DIMENSION(nbdim) ::  ind_newmax
-C               
-C
-      do i = 1,nbdim
-C      
-        dim_gmin(i) = sold(i)
-        dim_gmax(i) = sold(i) + (petabold(i)-pttabold(i)) * dsold(i)
-C 
-        dim_newmin(i) = snew(i)
-        dim_newmax(i) = snew(i) + (petabnew(i)-pttabnew(i)) * dsnew(i)
-C
-      enddo         
-C
-      do i = 1,nbdim
-C  
-        if (dim_gmax(i) .LT. dim_newmin(i)) Return
-C      
-        if (dim_gmin(i) .GT. dim_newmax(i)) Return
-C
-      enddo
-C
-C
-      do i = 1,nbdim
-C 
-        ind_newmin(i) = pttabnew(i) - floor(-(max(dim_gmin(i),
-     &                      dim_newmin(i))-dim_newmin(i))/dsnew(i)) 
-C      
-        dim_min(i) = snew(i) + (ind_newmin(i)-pttabnew(i))*dsnew(i)
-C      
-        ind_gmin(i) = pttabold(i) + nint((dim_min(i)-
-     &                dim_gmin(i))/dsold(i))      
-C
-        ind_newmax(i) = pttabnew(i) 
-     &                  + int((min(dim_gmax(i),dim_newmax(i))
-     &                         -dim_newmin(i))/dsnew(i))
-C
-      enddo 
-C
-C
-C
-      SELECT CASE (nbdim)
-      CASE (1)
-         i0 = ind_gmin(1)
-         do i = ind_newmin(1),ind_newmax(1)
-            New_Var % var % array1(i) =
-     &      Old_Var % var % array1(i0)
-            New_Var % var % restore1D(i) = 1   
-         i0 = i0 + int(dsnew(1)/dsold(1))
-         enddo
-      CASE (2)
-
-        i0 = ind_gmin(1)
-        do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2)
-        do j = ind_newmin(2),ind_newmax(2)
-           New_Var % var % array2(i,j) =
-     &            Old_Var % var % array2(i0,j0)
-           New_Var % var % restore2D(i,j) = 1
-               j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-      CASE (3)
-        i0 = ind_gmin(1)
-        do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2)
-        do j = ind_newmin(2),ind_newmax(2)
-        k0 = ind_gmin(3)
-        do k = ind_newmin(3),ind_newmax(3)
-           New_Var % var % array3(i,j,k) =
-     &                  Old_Var % var % array3(i0,j0,k0)
-           New_Var % var % restore3D(i,j,k) = 1   
-                     k0 = k0 + int(dsnew(3)/dsold(3))
-        enddo
-        j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-      CASE (4)
-        i0 = ind_gmin(1)
-        do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2)
-        do j = ind_newmin(2),ind_newmax(2)
-        k0 = ind_gmin(3)
-        do k = ind_newmin(3),ind_newmax(3)
-        l0 = ind_gmin(4)
-        do l = ind_newmin(4),ind_newmax(4) 
-           New_Var % var % array4(i,j,k,l) =
-     &                        Old_Var % var % array4(i0,j0,k0,l0)
-           New_Var % var % restore4D(i,j,k,l) = 1   
-        l0 = l0 + int(dsnew(4)/dsold(4))
-        enddo
-        k0 = k0 + int(dsnew(3)/dsold(3))
-        enddo
-        j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-      CASE (5)
-        i0 = ind_gmin(1)
-        do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2)
-        do j = ind_newmin(2),ind_newmax(2)
-        k0 = ind_gmin(3)
-        do k = ind_newmin(3),ind_newmax(3)
-        l0 = ind_gmin(4)
-        do l = ind_newmin(4),ind_newmax(4) 
-        m0 = ind_gmin(5)
-        do m = ind_newmin(5),ind_newmax(5)
-           New_Var % var % array5(i,j,k,l,m) =
-     &                        Old_Var % var % array5(i0,j0,k0,l0,m0)
-           New_Var % var % restore5D(i,j,k,l,m) = 1
-        m0 = m0 + int(dsnew(5)/dsold(5)) 
-        enddo
-        l0 = l0 + int(dsnew(4)/dsold(4))
-        enddo
-        k0 = k0 + int(dsnew(3)/dsold(3))
-        enddo
-        j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-      CASE (6)
-        i0 = ind_gmin(1)
-        do i = ind_newmin(1),ind_newmax(1)
-        j0 = ind_gmin(2)
-        do j = ind_newmin(2),ind_newmax(2)
-        k0 = ind_gmin(3)
-        do k = ind_newmin(3),ind_newmax(3)
-        l0 = ind_gmin(4)
-        do l = ind_newmin(4),ind_newmax(4) 
-        m0 = ind_gmin(5)
-        do m = ind_newmin(5),ind_newmax(5)
-        n0 = ind_gmin(6)
-        do n = ind_newmin(6),ind_newmax(6)
-           New_Var % var % array6(i,j,k,l,m,n) =
-     &                        Old_Var % var % array6(i0,j0,k0,l0,m0,n0)
-           New_Var % var % restore6D(i,j,k,l,m,n) = 1
-        n0 = n0 + int(dsnew(6)/dsold(6)) 
-        enddo
-        m0 = m0 + int(dsnew(5)/dsold(5)) 
-        enddo
-        l0 = l0 + int(dsnew(4)/dsold(4))
-        enddo
-        k0 = k0 + int(dsnew(3)/dsold(3))
-        enddo
-        j0 = j0 + int(dsnew(2)/dsold(2))
-        enddo
-        i0 = i0 + int(dsnew(1)/dsold(1))
-        enddo
-      END SELECT
-C           
-      Return
-C
-C
-      End Subroutine Agrif_CopynD                    
-C
-C
-C
-      End module Agrif_Save
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90	(revision 5682)
@@ -0,0 +1,663 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Save
+!!
+!! Module for the initialization by copy of the grids created by clustering.
+!
+module Agrif_Save
+!
+    use Agrif_Types
+    use Agrif_Link
+    use Agrif_Arrays
+    use Agrif_Variables
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+! subroutine Agrif_deallocate_Arrays
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_deallocate_Arrays ( var )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer :: var
+!
+    if (allocated(var%array1))  deallocate(var%array1)
+    if (allocated(var%array2))  deallocate(var%array2)
+    if (allocated(var%array3))  deallocate(var%array3)
+    if (allocated(var%array4))  deallocate(var%array4)
+    if (allocated(var%array5))  deallocate(var%array5)
+    if (allocated(var%array6))  deallocate(var%array6)
+!
+    if (allocated(var%darray1)) deallocate(var%darray1)
+    if (allocated(var%darray2)) deallocate(var%darray2)
+    if (allocated(var%darray3)) deallocate(var%darray3)
+    if (allocated(var%darray4)) deallocate(var%darray4)
+    if (allocated(var%darray5)) deallocate(var%darray5)
+    if (allocated(var%darray6)) deallocate(var%darray6)
+!
+    if (allocated(var%sarray1)) deallocate(var%sarray1)
+    if (allocated(var%sarray2)) deallocate(var%sarray2)
+    if (allocated(var%sarray3)) deallocate(var%sarray3)
+    if (allocated(var%sarray4)) deallocate(var%sarray4)
+    if (allocated(var%sarray5)) deallocate(var%sarray5)
+    if (allocated(var%sarray6)) deallocate(var%sarray6)
+!
+!
+    if (associated(var%oldvalues2D))    deallocate(var%oldvalues2D)
+    if (allocated(var%posvar))          deallocate(var%posvar)
+    if (allocated(var%interptab))       deallocate(var%interptab)
+    if (allocated(var%coords))          deallocate(var%coords)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_deallocate_Arrays
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_deallocate_Arrays_c ( var_c )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable_c), pointer :: var_c
+!
+    if (allocated(var_c%carray1)) deallocate(var_c%carray1)
+    if (allocated(var_C%carray2)) deallocate(var_c%carray2)
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_deallocate_Arrays_c
+!===================================================================================================
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_deallocate_Arrays_l ( var_l )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable_l), pointer :: var_l
+!
+!
+    if (allocated(var_l%larray1)) deallocate(var_l%larray1)
+    if (allocated(var_l%larray2)) deallocate(var_l%larray2)
+    if (allocated(var_l%larray3)) deallocate(var_l%larray3)
+    if (allocated(var_l%larray4)) deallocate(var_l%larray4)
+    if (allocated(var_l%larray5)) deallocate(var_l%larray5)
+    if (allocated(var_l%larray6)) deallocate(var_l%larray6)
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_deallocate_Arrays_l
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_deallocate_Arrays_i ( var_i )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable_i), pointer :: var_i
+!
+!
+    if (allocated(var_i%iarray1)) deallocate(var_i%iarray1)
+    if (allocated(var_i%iarray2)) deallocate(var_i%iarray2)
+    if (allocated(var_i%iarray3)) deallocate(var_i%iarray3)
+    if (allocated(var_i%iarray4)) deallocate(var_i%iarray4)
+    if (allocated(var_i%iarray5)) deallocate(var_i%iarray5)
+    if (allocated(var_i%iarray6)) deallocate(var_i%iarray6)
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_deallocate_Arrays_i
+!
+!===================================================================================================
+!  subroutine Agrif_Free_data_before
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Free_data_before ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: Agrif_Gr ! Pointer on the current grid
+!
+    integer :: i
+    type(Agrif_Variables_List), pointer :: parcours
+    type(Agrif_Variable),       pointer :: var
+    type(Agrif_Variable_c),     pointer :: var_c
+    type(Agrif_Variable_r),     pointer :: var_r
+    type(Agrif_Variable_l),     pointer :: var_l
+    type(Agrif_Variable_i),     pointer :: var_i
+!
+    do i = 1,Agrif_NbVariables(0)
+!
+        var => Agrif_Gr % tabvars(i)
+!
+        if ( .NOT. Agrif_Mygrid % tabvars(i) % restore ) then
+            call Agrif_deallocate_Arrays(var)
+        endif
+!
+        if (associated(var%list_interp)) then
+            call Agrif_Free_list_interp(var%list_interp)
+        endif
+!
+    enddo
+    do i=1,Agrif_NbVariables(1)
+        var_c => Agrif_Gr % tabvars_c(i)
+        call Agrif_deallocate_Arrays_c(var_c)
+    enddo
+    do i=1,Agrif_NbVariables(3)
+        var_l => Agrif_Gr % tabvars_l(i)
+        call Agrif_deallocate_Arrays_l(var_l)
+    enddo
+    do i=1,Agrif_NbVariables(4)
+        var_i => Agrif_Gr % tabvars_i(i)
+        call Agrif_deallocate_Arrays_i(var_i)
+    enddo
+
+    parcours => Agrif_Gr % variables
+
+    do i = 1,Agrif_Gr%NbVariables
+!
+        if ( .NOT. parcours%var%root_var % restore ) then
+            call Agrif_deallocate_Arrays(parcours%var)
+        endif
+!
+        if (associated(parcours%var%list_interp)) then
+            call Agrif_Free_list_interp(parcours%var%list_interp)
+        endif
+!
+        if ( .NOT. parcours%var%root_var % restore ) then
+            deallocate(parcours%var)
+        endif
+!
+        parcours => parcours % next
+!
+    enddo
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+        if ( Agrif_Probdim == 1 ) deallocate(Agrif_Gr%tabpoint1D)
+        if ( Agrif_Probdim == 2 ) deallocate(Agrif_Gr%tabpoint2D)
+        if ( Agrif_Probdim == 3 ) deallocate(Agrif_Gr%tabpoint3D)
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_data_before
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_list_interp
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Free_list_interp ( list_interp )
+!---------------------------------------------------------------------------------------------------
+      type(Agrif_List_Interp_Loc), pointer :: list_interp
+!
+      if (associated(list_interp%suiv)) call Agrif_Free_list_interp(list_interp%suiv)
+
+#if defined AGRIF_MPI
+       deallocate(list_interp%interp_loc%tab4t)
+       deallocate(list_interp%interp_loc%memberinall)
+       deallocate(list_interp%interp_loc%sendtoproc1)
+       deallocate(list_interp%interp_loc%recvfromproc1)
+#endif
+       deallocate(list_interp%interp_loc)
+       deallocate(list_interp)
+       nullify(list_interp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_list_interp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_data_after
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Free_data_after ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: Agrif_Gr  !< Pointer on the current grid
+!
+    integer :: i
+    type(Agrif_Variables_List), pointer :: parcours, rootparcours
+    type(Agrif_Variable),       pointer :: var
+!
+    do i = 1,Agrif_NbVariables(0)
+        if ( Agrif_Mygrid % tabvars(i) % restore ) then
+            var => Agrif_Gr%tabvars(i)
+            call Agrif_deallocate_Arrays(var)
+        endif
+    enddo
+!
+    parcours => Agrif_Gr%variables
+    rootparcours => Agrif_Mygrid%variables
+!
+    do i = 1,Agrif_Gr%NbVariables
+        if (rootparcours%var % restore ) then
+            call Agrif_deallocate_Arrays(parcours%var)
+            deallocate(parcours%var)
+        endif
+        parcours => parcours % next
+        rootparcours => rootparcours % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_data_after
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopyFromOld_All
+!
+!> Called in Agrif_Clustering#Agrif_Init_Hierarchy.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_CopyFromOld_All ( g, oldchildlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(inout) :: g   !< Pointer on the current grid
+    type(Agrif_Grid_List),     intent(in)    :: oldchildlist
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    real    :: g_eps, eps, oldgrid_eps
+    integer :: out
+    integer :: iii
+!
+    out = 0
+!
+    parcours => oldchildlist % first
+!
+    do while (associated(parcours))
+!
+        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
+!
+            g_eps = huge(1.)
+            oldgrid_eps = huge(1.)
+            do iii = 1,Agrif_Probdim
+                g_eps = min(g_eps,g % Agrif_dx(iii))
+                oldgrid_eps = min(oldgrid_eps, parcours % gr % Agrif_dx(iii))
+            enddo
+!
+            eps = min(g_eps,oldgrid_eps)/100.
+!
+            do iii = 1,Agrif_Probdim
+                if (g % Agrif_dx(iii) < (parcours % gr % Agrif_dx(iii) - eps)) then
+                    parcours => parcours % next
+                    out = 1
+                    exit
+                endif
+            enddo
+!
+            if ( out == 1 ) cycle
+!
+            call Agrif_CopyFromOld(g,parcours%gr)
+!
+        endif
+!
+        call Agrif_CopyFromOld_All(g,parcours % gr % child_list)
+!
+        parcours => parcours % next
+!
+      enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopyFromOld_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopyFromOld
+!
+!> Call to the Agrif_Copy procedure.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CopyFromOld ( new_gr, old_gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(inout) :: new_gr  !< Pointer on the current grid
+    type(Agrif_Grid), pointer, intent(inout) :: old_gr  !< Pointer on an old grid
+!
+    type(Agrif_Variable), pointer   :: new_var
+    type(Agrif_Variable), pointer   :: old_var
+    integer :: i
+!
+    do i = 1,Agrif_NbVariables(0)
+        if ( Agrif_Mygrid % tabvars(i) % restore ) then
+            old_var => old_gr % tabvars(i)
+            new_var => new_gr % tabvars(i)
+            call Agrif_Copy(new_gr, old_gr, new_var, old_var )
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopyFromOld
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopyFromOld_AllOneVar
+!
+!> Called in Agrif_Clustering#Agrif_Init_Hierarchy.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_CopyFromOld_AllOneVar ( g, oldchildlist, indic )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(inout) :: g            !< Pointer on the current grid
+    type(Agrif_Grid_List),     intent(in)    :: oldchildlist
+    integer,                   intent(in)    :: indic
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    real    :: g_eps,eps,oldgrid_eps
+    integer :: out
+    integer :: iii
+!
+    out = 0
+!
+    parcours => oldchildlist % first
+!
+    do while (associated(parcours))
+!
+        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
+!
+            g_eps = huge(1.)
+            oldgrid_eps = huge(1.)
+            do iii = 1,Agrif_Probdim
+                g_eps = min(g_eps,g % Agrif_dx(iii))
+                oldgrid_eps = min(oldgrid_eps,parcours % gr % Agrif_dx(iii))
+            enddo
+!
+            eps = min(g_eps,oldgrid_eps)/100.
+!
+            do iii = 1,Agrif_Probdim
+                if (g % Agrif_dx(iii) < (parcours % gr % Agrif_dx(iii) - eps)) then
+                    parcours => parcours % next
+                    out = 1
+                    exit
+                endif
+            enddo
+
+            if ( out == 1 ) cycle
+!
+            call Agrif_CopyFromOldOneVar(g,parcours%gr,indic)
+!
+        endif
+!
+        call Agrif_CopyFromOld_AllOneVar(g,parcours%gr % child_list,indic)
+!
+        parcours => parcours % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopyFromOld_AllOneVar
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopyFromOldOneVar
+!
+!> Call to Agrif_Copy
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CopyFromOldOneVar ( new_gr, old_gr, indic )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(inout) :: new_gr     !< Pointer on the current grid
+    type(Agrif_Grid), pointer, intent(in)    :: old_gr     !< Pointer on an old grid
+    integer,                   intent(in)    :: indic
+!
+    type(Agrif_Variable),  pointer  :: new_var, old_var
+!
+    new_var => Agrif_Search_Variable(new_gr, -indic)
+    old_var => Agrif_Search_Variable(old_gr, -indic)
+!
+    call Agrif_array_allocate(new_var,new_var%lb,new_var%ub,new_var%nbdim)
+    call Agrif_Copy(new_gr, old_gr, new_var,old_var)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopyFromOldOneVar
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Copy
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Copy ( new_gr, old_gr, new_var, old_var )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid),     pointer, intent(in)       :: new_gr !< Pointer on the current grid
+    type(Agrif_Grid),     pointer, intent(in)       :: old_gr !< Pointer on an old grid
+    type(Agrif_Variable), pointer, intent(inout)    :: new_var
+    type(Agrif_Variable), pointer, intent(in)       :: old_var
+!
+    type(Agrif_Variable), pointer :: root ! Pointer on the variable of the root grid
+    integer               :: nbdim     ! Number of dimensions of the current grid
+    integer, dimension(6) :: pttabnew  ! Indexes of the first point in the domain
+    integer, dimension(6) :: petabnew  ! Indexes of the first point in the domain
+    integer, dimension(6) :: pttabold  ! Indexes of the first point in the domain
+    integer, dimension(6) :: petabold  ! Indexes of the first point in the domain
+    integer, dimension(6) :: nbtabold  ! Number of cells in each direction
+    integer, dimension(6) :: nbtabnew  ! Number of cells in each direction
+    real,    dimension(6) :: snew,sold
+    real,    dimension(6) :: dsnew,dsold
+    real    :: eps
+    integer :: n
+!
+    root => new_var % root_var
+    nbdim = root % nbdim
+!
+    do n = 1,nbdim
+!
+        select case(root % interptab(n))
+!
+        case('x')
+!
+            pttabnew(n) = root % point(n)
+            pttabold(n) = root % point(n)
+            snew(n)  = new_gr % Agrif_x(1)
+            sold(n)  = old_gr % Agrif_x(1)
+            dsnew(n) = new_gr % Agrif_dx(1)
+            dsold(n) = old_gr % Agrif_dx(1)
+!
+            if (root % posvar(n) == 1) then
+                petabnew(n) = pttabnew(n) + new_gr % nb(1)
+                petabold(n) = pttabold(n) + old_gr % nb(1)
+            else
+                petabnew(n) = pttabnew(n) + new_gr % nb(1) - 1
+                petabold(n) = pttabold(n) + old_gr % nb(1) - 1
+                snew(n) = snew(n) + dsnew(n)/2.
+                sold(n) = sold(n) + dsold(n)/2.
+            endif
+!
+        case('y')
+!
+            pttabnew(n) = root % point(n)
+            pttabold(n) = root % point(n)
+            snew(n) = new_gr % Agrif_x(2)
+            sold(n) = old_gr % Agrif_x(2)
+            dsnew(n) = new_gr % Agrif_dx(2)
+            dsold(n) = old_gr % Agrif_dx(2)
+!
+            if (root % posvar(n) == 1) then
+                petabnew(n) = pttabnew(n) + new_gr % nb(2)
+                petabold(n) = pttabold(n) + old_gr % nb(2)
+            else
+                petabnew(n) = pttabnew(n) + new_gr % nb(2) - 1
+                petabold(n) = pttabold(n) + old_gr % nb(2) - 1
+                snew(n) = snew(n) + dsnew(n)/2.
+                sold(n) = sold(n) + dsold(n)/2.
+            endif
+!
+        case('z')
+!
+            pttabnew(n) = root % point(n)
+            pttabold(n) = root % point(n)
+            snew(n)  = new_gr % Agrif_x(3)
+            sold(n)  = old_gr % Agrif_x(3)
+            dsnew(n) = new_gr % Agrif_dx(3)
+            dsold(n) = old_gr % Agrif_dx(3)
+!
+            if (root % posvar(n) == 1) then
+                petabnew(n) = pttabnew(n) + new_gr % nb(3)
+                petabold(n) = pttabold(n) + old_gr % nb(3)
+            else
+                petabnew(n) = pttabnew(n) + new_gr % nb(3) - 1
+                petabold(n) = pttabold(n) + old_gr % nb(3) - 1
+                snew(n) = snew(n) + dsnew(n)/2.
+                sold(n) = sold(n) + dsold(n)/2.
+            endif
+!
+        case('N')
+!
+            call Agrif_get_var_bounds(new_var,pttabnew(n),petabnew(n),n)
+!
+            pttabold(n) = pttabnew(n)
+            petabold(n) = petabnew(n)
+            snew(n) = 0.
+            sold(n) = 0.
+            dsnew(n) = 1.
+            dsold(n) = 1.
+!
+        end select
+!
+    enddo
+!
+    do n = 1,nbdim
+        nbtabnew(n) = petabnew(n) - pttabnew(n)
+        nbtabold(n) = petabold(n) - pttabold(n)
+    enddo
+!
+    eps = min(minval(dsnew(1:nbdim)),minval(dsold(1:nbdim))) / 100.
+!
+    do n = 1,nbdim
+        if (snew(n) > (sold(n)+dsold(n)*nbtabold(n)+eps)) return
+        if ((snew(n)+dsnew(n)*nbtabnew(n)-eps) < sold(n)) return
+    enddo
+!
+    call Agrif_CopynD(new_var,old_var,pttabold,petabold,pttabnew,petabnew,  &
+                      sold,snew,dsold,dsnew,nbdim)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Copy
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopynD
+!
+!> Copy from the nD variable Old_Var the nD variable New_Var
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CopynD ( new_var, old_var, pttabold, petabold, pttabnew, petabnew, &
+                          sold, snew, dsold, dsnew, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer, intent(inout) :: new_var
+    type(Agrif_Variable), pointer, intent(in)    :: old_var
+    integer, dimension(nbdim),     intent(in)    :: pttabnew
+    integer, dimension(nbdim),     intent(in)    :: petabnew
+    integer, dimension(nbdim),     intent(in)    :: pttabold
+    integer, dimension(nbdim),     intent(in)    :: petabold
+    real,    dimension(nbdim),     intent(in)    :: snew, sold
+    real,    dimension(nbdim),     intent(in)    :: dsnew,dsold
+    integer,                       intent(in)    :: nbdim
+!
+    integer :: i,j,k,l,m,n,i0,j0,k0,l0,m0,n0
+!
+    real,    dimension(nbdim) :: dim_gmin,   dim_gmax
+    real,    dimension(nbdim) :: dim_newmin, dim_newmax
+    real,    dimension(nbdim) :: dim_min
+    integer, dimension(nbdim) :: ind_gmin,ind_newmin, ind_newmax
+!
+    do i = 1,nbdim
+!
+        dim_gmin(i) = sold(i)
+        dim_gmax(i) = sold(i) + (petabold(i)-pttabold(i)) * dsold(i)
+!
+        dim_newmin(i) = snew(i)
+        dim_newmax(i) = snew(i) + (petabnew(i)-pttabnew(i)) * dsnew(i)
+!
+    enddo
+!
+    do i = 1,nbdim
+        if (dim_gmax(i) < dim_newmin(i)) return
+        if (dim_gmin(i) > dim_newmax(i)) return
+    enddo
+!
+    do i = 1,nbdim
+!
+        ind_newmin(i) = pttabnew(i) - floor(-(max(dim_gmin(i),dim_newmin(i))-dim_newmin(i))/dsnew(i))
+        dim_min(i) = snew(i) + (ind_newmin(i)-pttabnew(i))*dsnew(i)
+        ind_gmin(i)   = pttabold(i) + nint((dim_min(i)-dim_gmin(i))/dsold(i))
+        ind_newmax(i) = pttabnew(i) + int((min(dim_gmax(i),dim_newmax(i))-dim_newmin(i))/dsnew(i))
+!
+    enddo
+!
+    select case (nbdim)
+!
+    case (1)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+            new_var % array1(i)    = old_var % array1(i0)
+            new_var % restore1D(i) = 1
+            i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (2)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+            new_var % array2(i,j)    = old_var % array2(i0,j0)
+            new_var % restore2D(i,j) = 1
+            j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (3)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
+            new_var % array3(i,j,k)    =  old_var % array3(i0,j0,k0)
+            new_var % restore3D(i,j,k) = 1
+            k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (4)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4)
+            new_var % array4(i,j,k,l)    = old_var % array4(i0,j0,k0,l0)
+            new_var % restore4D(i,j,k,l) = 1
+            l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (5)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4)
+        m0 = ind_gmin(5) ; do m = ind_newmin(5),ind_newmax(5)
+            new_var % array5(i,j,k,l,m)    = old_var % array5(i0,j0,k0,l0,m0)
+            new_var % restore5D(i,j,k,l,m) = 1
+            m0 = m0 + int(dsnew(5)/dsold(5))
+        enddo
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (6)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4)
+        m0 = ind_gmin(5) ; do m = ind_newmin(5),ind_newmax(5)
+        n0 = ind_gmin(6) ; do n = ind_newmin(6),ind_newmax(6)
+            new_var % array6(i,j,k,l,m,n)    = old_var % array6(i0,j0,k0,l0,m0,n0)
+            new_var % restore6D(i,j,k,l,m,n) = 1
+            n0 = n0 + int(dsnew(6)/dsold(6))
+        enddo
+        m0 = m0 + int(dsnew(5)/dsold(5))
+        enddo
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+      end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopynD
+!===================================================================================================
+!
+end module Agrif_Save
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90	(revision 5682)
@@ -0,0 +1,640 @@
+module Agrif_seq
+!
+    use Agrif_Init
+    use Agrif_Procs
+    use Agrif_Arrays
+!
+    implicit none
+!
+contains
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+function Agrif_seq_allocate_list ( nb_seqs ) result( seqlist )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     :: nb_seqs
+!
+    type(Agrif_Sequence_List), pointer :: seqlist
+!
+    allocate(seqlist)
+    seqlist % nb_seqs = nb_seqs
+    allocate(seqlist % sequences(1:nb_seqs))
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_allocate_list
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_add_grid ( seqlist, seq_num, grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Sequence_List), intent(inout)    :: seqlist
+    integer,                   intent(in)       :: seq_num
+    type(Agrif_Grid), pointer, intent(in)       :: grid
+!
+    call Agrif_gl_append(seqlist % sequences(seq_num) % gridlist, grid )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_add_grid
+!===================================================================================================
+!
+!===================================================================================================
+recursive subroutine Agrif_seq_init_sequences ( grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout)  :: grid
+!
+    type(Agrif_PGrid), pointer  :: gp
+!
+#if defined AGRIF_MPI
+!
+! Build list of required procs for each child grid
+    gp => grid % child_list % first
+    do while ( associated( gp ) )
+        call Agrif_seq_build_required_proclist( gp % gr )
+        gp => gp % next
+    enddo
+!
+! Create integration sequences for the current grid
+    call Agrif_seq_create_proc_sequences( grid )
+    call Agrif_seq_allocate_procs_to_childs( grid )
+!
+! Create new communicators for sequences
+    call Agrif_seq_create_communicators( grid )
+!
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_init_sequences
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_build_required_proclist ( grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout) :: grid
+!
+    type(Agrif_Grid),      pointer  :: parent_grid
+    type(Agrif_Rectangle), pointer  :: grid_rect
+    type(Agrif_Proc_p),    pointer  :: proc_rect
+    type(Agrif_Proc),      pointer  :: proc
+    logical     :: proc_is_required
+    integer     :: i
+!
+    if ( grid % fixedrank == 0 ) then
+!       grid is the Root
+        if ( grid % required_proc_list % nitems == 0 ) then
+            print*, "### Error Agrif_seq_build_required_proclist: empty proc list."
+            print*, "# -> You should check if Agrif_Init_ProcList() is actually working."
+            stop
+        endif
+        return
+    endif
+!
+    parent_grid => grid % parent
+    grid_rect   => grid % rect_in_parent
+    proc_rect   => parent_grid % proc_def_list % first
+!
+
+    do while ( associated( proc_rect ) )
+
+!
+        proc => proc_rect % proc
+!
+        proc_is_required = .true.
+        do i = 1,Agrif_Probdim
+            proc_is_required = ( proc_is_required             .and. &
+                    ( grid_rect % imin(i) <= proc % imax(i) ) .and. &
+                    ( grid_rect % imax(i) >= proc % imin(i) ) )
+        enddo
+!
+        if ( proc_is_required ) then
+            call Agrif_pl_append(grid % required_proc_list, proc)
+        endif
+        proc_rect => proc_rect % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_build_required_proclist
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_create_proc_sequences ( grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout)    :: grid
+!
+    type(Agrif_Grid_List), pointer :: sorted_child_list
+    type(Agrif_PGrid),     pointer :: child_p
+    type(Agrif_PGrid),     pointer :: g1p, g2p
+    type(Agrif_Proc_p),    pointer :: pp1, pp2
+    type(Agrif_Proc),      pointer :: proc
+    integer                        :: nb_seq_max, nb_seqs, cur_seq
+!
+    nb_seq_max = 0
+!
+    if ( grid % child_list % nitems == 0 ) return
+!
+! For each required proc...
+    pp1  => grid % required_proc_list % first
+    do while ( associated(pp1) )
+        proc => pp1 % proc
+        proc % nb_seqs = 0
+!   ..loop over all child grids...
+        child_p => grid % child_list % first
+        do while ( associated(child_p) )
+!       ..and look for 'proc' in the list of procs required by 'child'
+            pp2 => child_p % gr % required_proc_list % first
+            do while ( associated(pp2) )
+                if ( proc % pn == pp2 % proc % pn ) then
+!                   'proc' is required by this child grid, so we increment its number of sequences
+                    proc % nb_seqs = proc % nb_seqs + 1
+                    pp2 => NULL()
+                else
+                    pp2 => pp2 % next
+                endif
+            enddo
+            child_p => child_p % next
+        enddo
+        nb_seq_max = max(nb_seq_max, proc % nb_seqs)
+        pp1 => pp1 % next
+    enddo
+!
+! For each grid...
+    g1p => grid % child_list % first
+    do while ( associated(g1p) )
+!     compare it with the following ones
+        g2p => g1p % next
+        do while ( associated(g2p) )
+            if ( Agrif_seq_grids_are_connected( g1p % gr, g2p % gr ) ) then
+                call Agrif_gl_append( g1p % gr % neigh_list, g2p % gr )
+                call Agrif_gl_append( g2p % gr % neigh_list, g1p % gr )
+            endif
+            g2p => g2p % next
+        enddo
+        g1p => g1p % next
+    enddo
+!
+! Colorize graph nodes
+    nb_seqs = Agrif_seq_colorize_grid_list(grid % child_list)
+    sorted_child_list => Agrif_gl_merge_sort ( grid % child_list, compare_colors )
+!
+! Create sequence structure
+    cur_seq = 0
+    grid % child_seq => Agrif_seq_allocate_list(nb_seqs)
+    child_p => sorted_child_list % first
+    do while ( associated(child_p) )
+        if ( cur_seq /= child_p % gr % seq_num ) then
+            cur_seq = child_p % gr % seq_num
+        endif
+        call Agrif_seq_add_grid(grid % child_seq,cur_seq,child_p% gr)
+        child_p => child_p % next
+    enddo
+!
+    call Agrif_gl_delete(sorted_child_list)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_create_proc_sequences
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_seq_grids_are_connected( g1, g2 ) result( connection )
+!
+!< Compare required_proc_list for g1 and g2. These are connected if they share a same proc.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in) :: g1, g2
+!
+    logical :: connection
+    type(Agrif_Proc_p), pointer :: pp1, pp2
+!
+    connection = .false.
+!
+    pp1 => g1 % required_proc_list % first
+!
+    do while( associated(pp1) .and. (.not. connection) )
+!
+        pp2 => g2 % required_proc_list % first
+        do while ( associated(pp2) .and. (.not. connection) )
+            if ( pp1 % proc % pn == pp2 % proc % pn ) then
+            ! if pp1 and pp2 are the same proc, it means that g1 and g2 are connected. We stop here.
+                connection = .true.
+            endif
+            pp2 => pp2 % next
+        enddo
+        pp1 => pp1 % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_grids_are_connected
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_seq_colorize_grid_list ( gridlist ) result ( ncolors )
+!
+!< 1.  Sort nodes in decreasing order of degree.
+!< 2.  Color the node with highest degree with color 1.
+!< 3.  Choose the node with the largest DSAT value. In case of conflict, choose the one with the
+!!       highest degree. Then the one corresponding to the largest grid.
+!< 4.  Color this node with the smallest possible color.
+!< 5.  If all nodes are colored, then stop. Otherwise, go to 3.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)    :: gridlist
+!
+    type(Agrif_Grid_List),   pointer  :: X, Y
+    type(Agrif_PGrid),       pointer  :: gridp
+    type(Agrif_Grid_List),   pointer  :: tmp_gl
+    integer                           :: ncolors
+    integer, dimension(1:gridlist%nitems)   :: colors
+!
+! Be carefull...
+    nullify(Y)
+!
+! First initialize the color of each node
+    gridp => gridlist % first
+    do while ( associated(gridp) )
+        gridp % gr % seq_num = 0
+        gridp => gridp % next
+    enddo
+!
+! Then sort the grids by decreasing degree
+    X => Agrif_gl_merge_sort( gridlist, compare_grid_degrees )
+    gridp => X % first
+!
+! Colorize the first grid in the list
+    gridp % gr % seq_num = 1
+    gridp => gridp % next
+!
+! Then for each of its neighbors...
+    do while ( associated(gridp) )
+!
+        if ( gridp % gr % neigh_list % nitems == 0 ) then
+        ! this grid is alone... let.s attach it to an existing sequence
+            call Agrif_seq_attach_grid( X, gridp % gr )
+            gridp => gridp % next
+            cycle
+        endif
+!
+!     Compute dsat value of all non-colored grids
+        tmp_gl => Agrif_gl_build_from_gp(gridp)
+        call Agrif_seq_calc_dsat(tmp_gl)
+!
+!     Sort non-colored grids by decreasing dsat value, then by size
+        call Agrif_gl_delete(Y)
+        Y => Agrif_gl_merge_sort( tmp_gl, compare_dsat_values, compare_size_values )
+!
+!     Next coloration is for the first grid in this list  TODO : maybe we could find a better choice ..?
+        gridp => Y % first
+!
+!     Assign a color to the chosen grid
+        gridp % gr % seq_num = Agrif_seq_smallest_available_color_in_neighborhood( gridp % gr % neigh_list )
+!
+        gridp => gridp % next
+        call Agrif_gl_delete(tmp_gl)
+!
+    enddo
+!
+    call Agrif_gl_delete(X)
+    call Agrif_seq_colors_in_neighborhood( gridlist, colors )
+    ncolors = maxval(colors)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_colorize_grid_list
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_attach_grid ( gridlist, grid )
+!
+!< 'grid' is not connected to any neighbor. Therefore, we give an existing and well chosen color.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)       :: gridlist
+    type(Agrif_Grid),      intent(inout)    :: grid
+!
+    integer, dimension(gridlist%nitems) :: colors
+    integer, dimension(:), allocatable  :: ngrids_by_color
+    integer :: i, color, ncolors
+!
+    call Agrif_seq_colors_in_neighborhood( gridlist, colors )
+    ncolors = maxval(colors)
+!
+    allocate(ngrids_by_color(ncolors))
+    ngrids_by_color = 0
+!
+    do i = 1,gridlist % nitems
+        if (colors(i) > 0)  ngrids_by_color(colors(i)) = ngrids_by_color(colors(i)) + 1
+    enddo
+!
+    color = ncolors
+    do i = 1,ncolors
+        if ( ngrids_by_color(i) < color ) color = i
+    enddo
+!
+    grid % seq_num = color
+    deallocate(ngrids_by_color)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_attach_grid
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_colors_in_neighborhood ( neigh_list, colors )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: neigh_list
+    integer, dimension(:), intent(out)  :: colors
+!
+    integer                     :: i
+    type(Agrif_PGrid), pointer  :: gridp
+!
+    i = lbound(colors,1)
+    colors = 0
+    gridp => neigh_list % first
+!
+    do while ( associated(gridp) )
+!
+        if ( i > ubound(colors,1) ) then
+            print*,'Error in Agrif_seq_colors_in_neighborhood : "colors" array is too small'
+            stop
+        endif
+        colors(i) = gridp % gr % seq_num
+        gridp => gridp % next
+        i = i+1
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_colors_in_neighborhood
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_seq_smallest_available_color_in_neighborhood ( neigh_list ) result ( smallest )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: neigh_list
+!
+    integer, dimension(:), allocatable :: color_is_met
+    integer     :: colors_tab(1:neigh_list%nitems)
+    integer     :: i, smallest, max_color
+!
+    call Agrif_seq_colors_in_neighborhood( neigh_list, colors_tab )
+    max_color = maxval(colors_tab)
+!
+    allocate(color_is_met(1:max_color))
+    color_is_met = 0
+!
+    do i = 1,neigh_list % nitems
+        if ( colors_tab(i) /= 0 ) then
+            color_is_met(colors_tab(i)) = 1
+        endif
+    enddo
+!
+    smallest = max_color+1
+    do i = 1,max_color
+        if ( color_is_met(i) == 0 ) then
+            smallest = i
+            exit
+        endif
+    enddo
+!
+    deallocate(color_is_met)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_smallest_available_color_in_neighborhood
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_calc_dsat ( gridlist )
+!< For each node 'v' :
+!<   if none of its neighbors is colored then
+!<       DSAT(v) = degree(v)  #  degree(v) := number of neighbors
+!<   else
+!<       DSAT(v) = number of different colors used in the first neighborhood of v.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: gridlist
+!
+    type(Agrif_PGrid), pointer          :: gridp
+    type(Agrif_Grid),  pointer          :: grid
+    integer, dimension(:), allocatable  :: colors, color_is_met
+    integer                             :: i, ncolors
+!
+    gridp => gridlist % first
+!
+    do while ( associated(gridp) )
+!
+        grid => gridp % gr
+!
+        allocate(colors(grid % neigh_list % nitems))
+        call Agrif_seq_colors_in_neighborhood( grid % neigh_list, colors )
+
+        allocate(color_is_met(1:maxval(colors)))
+        color_is_met = 0
+!
+        do i = 1,grid % neigh_list % nitems
+            if ( colors(i) /= 0 ) then
+                color_is_met(colors(i)) = 1
+            endif
+        enddo
+        ncolors = sum(color_is_met)
+!
+        if ( ncolors == 0 ) then
+            grid % dsat = grid % neigh_list % nitems
+        else
+            grid % dsat = ncolors
+        endif
+        deallocate(colors, color_is_met)
+        gridp => gridp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_calc_dsat
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_allocate_procs_to_childs ( coarse_grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout) :: coarse_grid
+!
+    integer                         :: is, ip, ig, ngrids
+    type(Agrif_Grid_List), pointer  :: gridlist
+    type(Agrif_PGrid),     pointer  :: gp
+    type(Agrif_Grid),      pointer  :: grid
+    type(Agrif_Proc_List), pointer  :: proclist
+    type(Agrif_Proc),      pointer  :: proc
+    type(Agrif_Proc_p),    pointer  :: pp
+    type(Agrif_Proc), dimension(:), allocatable, target :: procarray
+    type(Agrif_Grid), dimension(:), allocatable         :: gridarray
+    type(Agrif_Sequence_List), pointer :: seqlist
+    real,dimension(:),allocatable :: grid_costs
+    integer,dimension(:), allocatable :: nbprocs_per_grid
+    integer :: i1, i2, j1, j2
+    real :: max_cost
+    integer :: max_index
+!
+    seqlist => coarse_grid % child_seq
+    if ( .not. associated(seqlist) ) return
+!
+! Initialize proc allocation
+    pp => coarse_grid % proc_def_list % first
+    do while ( associated(pp) )
+        pp % proc % grid_id = 0
+        pp => pp % next
+    enddo
+!
+! For each sequence...
+    do is = 1,seqlist % nb_seqs
+!
+        proclist => seqlist % sequences(is) % proclist
+        gridlist => seqlist % sequences(is) % gridlist
+!
+!     Copy coarse grid proc list and convert it to an array
+        call Agrif_pl_deep_copy( coarse_grid % proc_def_list, proclist )
+        call Agrif_pl_to_array ( proclist, procarray )
+!
+!     Allocate a temporary array with concerned grid numbers
+        ngrids = gridlist % nitems
+        allocate(gridarray(1:ngrids))
+        allocate(grid_costs(1:ngrids))
+        allocate(nbprocs_per_grid(1:ngrids))
+
+      nbprocs_per_grid = 0
+!
+!     Allocate required procs to each grid
+        gp => gridlist % first
+        ig = 0
+        do while ( associated(gp) )
+            grid => gp % gr
+            ig = ig+1 ; gridarray(ig) = grid
+            pp => grid % required_proc_list % first
+            do while ( associated(pp) )
+                procarray( pp % proc % pn+1 ) % grid_id = grid % fixedrank
+                nbprocs_per_grid(ig) = nbprocs_per_grid(ig) + 1
+                pp => pp % next
+            enddo
+            gp => gp % next
+        enddo
+!
+!     Add unused procs to the grids
+! TODO FIXME: This is just a dummy allocation. You should take into account grid size and more
+!             information here...
+
+! Estimate current costs
+
+        do ig = 1, ngrids
+          i1 = gridarray(ig)%ix(1)
+          i2 = gridarray(ig)%ix(1)+gridarray(ig)%nb(1)/gridarray(ig)%spaceref(1)-1
+          j1 = gridarray(ig)%ix(2)
+          j2 = gridarray(ig)%ix(2)+gridarray(ig)%nb(2)/gridarray(ig)%spaceref(2)-1
+          Call Agrif_estimate_parallel_cost(i1,i2,j1,j2,nbprocs_per_grid(ig),grid_costs(ig))
+          grid_costs(ig) = grid_costs(ig) * gridarray(ig)%timeref(1)
+        enddo
+
+        ig = 1
+        do ip = 1,proclist%nitems
+            if ( procarray( ip ) % grid_id == 0 ) then
+!             this proc is unused
+              max_cost = 0.
+              max_index = 1
+              do ig = 1,ngrids
+                 if (grid_costs(ig) > max_cost) then
+                    max_cost = grid_costs(ig)
+                    max_index = ig
+                 endif
+              enddo
+
+              ig = max_index
+              procarray( ip ) % grid_id = gridarray(ig) % fixedrank
+
+              nbprocs_per_grid(ig) =  nbprocs_per_grid(ig) + 1
+              i1 = gridarray(ig)%ix(1)
+              i2 = gridarray(ig)%ix(1)+gridarray(ig)%nb(1)/gridarray(ig)%spaceref(1)-1
+              j1 = gridarray(ig)%ix(2)
+              j2 = gridarray(ig)%ix(2)+gridarray(ig)%nb(2)/gridarray(ig)%spaceref(2)-1
+              Call Agrif_estimate_parallel_cost(i1,i2,j1,j2,nbprocs_per_grid(ig),grid_costs(ig))
+              grid_costs(ig) = grid_costs(ig) * gridarray(ig)%timeref(1)
+
+            endif
+        enddo
+!
+!     Allocate proc nums to each grid
+        gp => gridlist % first
+        do while ( associated(gp) )
+            do ip = 1,proclist%nitems
+                if ( procarray( ip ) % grid_id == gp % gr % fixedrank ) then
+                    allocate(proc)
+                    proc = procarray( ip )
+                    call Agrif_pl_append(gp % gr % proc_def_in_parent_list, proc)
+                endif
+            enddo
+            gp => gp % next
+        enddo
+!
+!     Clean up
+        deallocate(procarray, gridarray, grid_costs, nbprocs_per_grid)
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_allocate_procs_to_childs
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_create_communicators ( grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout) :: grid
+!
+    include 'mpif.h'
+    type(Agrif_Sequence_List), pointer  :: seqlist  ! List of child sequences
+    type(Agrif_PGrid), pointer          :: gridp
+    type(Agrif_Proc),  pointer          :: proc
+    integer     :: i, ierr
+    integer     :: current_comm, comm_seq, color_seq
+!
+    seqlist => grid % child_seq
+    if ( .not. associated(seqlist) ) return
+!
+    current_comm = grid % communicator
+    color_seq = MPI_COMM_NULL
+!
+! For each sequence, split the current communicator into as many groups as needed.
+    do i = 1,seqlist % nb_seqs
+!
+!     Loop over each proclist to give a color to the current process
+        gridp => seqlist % sequences(i) % gridlist % first
+        grid_loop : do while ( associated(gridp) )
+            proc => Agrif_pl_search_proc( gridp % gr % proc_def_in_parent_list, Agrif_Procrank )
+            if ( associated(proc) ) then
+                if ( gridp % gr % fixedrank /= proc % grid_id ) then
+                    write(*,'("### Error Agrif_seq_create_communicators : ")')
+                    write(*,'("  inconsitancy on proc ",i2,":")') Agrif_Procrank
+                    write(*,'("gr % fixedrank = ",i0,", where proc % grid_id = ",i0)') &
+                            gridp % gr % fixedrank, proc % grid_id
+                    stop
+                endif
+                color_seq = gridp % gr % fixedrank
+                exit grid_loop
+            endif
+            gridp => gridp % next
+        enddo grid_loop
+!
+        call MPI_COMM_SPLIT(current_comm, color_seq, Agrif_ProcRank, comm_seq, ierr)
+        gridp % gr % communicator = comm_seq
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_create_communicators
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_seq_select_child ( g, is ) result ( gridp )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(in)   :: g
+    integer,                   intent(in)   :: is
+!
+    type(Agrif_PGrid), pointer  :: gridp
+    type(Agrif_Proc),  pointer  :: proc
+!
+    call Agrif_Instance( g )
+    gridp => g % child_seq % sequences(is) % gridlist % first
+!
+    do while ( associated(gridp) )
+        proc => Agrif_pl_search_proc( gridp % gr % proc_def_in_parent_list, Agrif_Procrank )
+        if ( associated(proc) ) then
+            return
+        endif
+        gridp => gridp % next
+    enddo
+    write(*,'("### Error Agrif_seq_select_child : no grid found in sequence ",i0," (mother G",i0,") for P",i0)')&
+        is, g%fixedrank, Agrif_Procrank
+    stop
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_select_child
+!===================================================================================================
+#else
+    subroutine dummy_Agrif_seq ()
+    end subroutine dummy_Agrif_seq
+#endif
+!
+end module Agrif_seq
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F	(revision 5659)
+++ 	(revision )
@@ -1,460 +1,0 @@
-C     Agrif (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_types  
-C
-      Module Agrif_types 
-C
-CCC   Description:
-CCC   Definition of data types used in Agrif, of several variables and
-C        PARAMETERs.     
-C
-      IMPLICIT NONE
-      
-C     Maximum refinement ratio
-
-      INTEGER, PARAMETER :: Agrif_MaxRaff = 7
-      
-C     Maximum number of grids of the hierarchy
-      INTEGER, PARAMETER :: Agrif_NbMaxGrids = 10
-C     MPI Communicator
-      INTEGER :: MPI_COMM_AGRIF
-C
-C     **************************************************************************
-CCC   TYPE Agrif_LRECTANGLE
-C     **************************************************************************
-C
-CCC   Description:
-CCC   Data TYPE allowing a grid to reach a grid on the same level or its child
-CCC   grids.
-C
-      TYPE Agrif_lrectangle  
-           TYPE(Agrif_rectangle) , Pointer :: r    ! to reach a child grid
-           TYPE(Agrif_lrectangle), Pointer :: next ! to reach a grid on the 
-                                                   !    same level
-      End TYPE Agrif_lrectangle  
-C
-C     **************************************************************************
-CCC   TYPE Agrif_RECTANGLE: 
-C     **************************************************************************
-C
-CCC   Description:
-CCC   Data TYPE to define several CHARACTERistics of a grid (number,position,
-CCC   time and space refinement factors,...). 
-C
-      TYPE Agrif_rectangle
-           INTEGER                         :: number      ! Number of the grid
-           ! Number of child grids 
-           INTEGER                         :: nbgridchild 
-           ! Minimal position in the x,y and z direction
-           INTEGER, DIMENSION(3)           :: imin        
-           ! Maximal position in the x,y and z direction 
-           INTEGER, DIMENSION(3)           :: imax 
-           ! Space refinement factor in the x,y and z direction  
-           INTEGER, DIMENSION(3)           :: spaceref    
-           ! Time refinement factor in the x,y and z direction
-           INTEGER, DIMENSION(3)           :: timeref     
-           ! Pointer to reach a grid on  the same level or a child grid
-           TYPE(Agrif_lrectangle), Pointer :: childgrids  
-      End TYPE Agrif_rectangle  
-C
-C
-C
-C     **************************************************************************
-CCC   TYPE Agrif_PGrid
-C     **************************************************************************
-C
-CCC   Description:
-CCC   Data TYPE to go over the grid hierarchy (used for the creation of this 
-CCC   grid hierarchy and during the time integration).
-C 
-      TYPE Agrif_pgrid  
-           ! allows to reach a child grid  
-           TYPE(Agrif_grid) , Pointer :: gr
-           ! allows to reach the grids of the same level 
-           TYPE(Agrif_pgrid), Pointer :: next 
-      End TYPE Agrif_pgrid 
-C
-C
-C
-C     **************************************************************************
-CCC   TYPE Agrif_PVariable
-C     **************************************************************************
-C
-CCC   Description:
-CCC   Data TYPE to define a grid variable.
-C
-      TYPE Agrif_PVariable 
-           ! This field allows to get the various CHARACTERistics 
-           !   of the variable (defined by the Agrif_Variable data TYPE)
-           TYPE(Agrif_Variable) , Pointer :: var  
-           ! Pointer on the parent grid
-           TYPE(Agrif_PVariable), Pointer :: parent_var 
-      End TYPE Agrif_PVariable 
-C
-C     **************************************************************************
-CCC   TYPE Agrif_Grid
-C     **************************************************************************
-C
-CCC   Description:
-CCC   Data TYPE to define a grid (position, space and time refinement factors).
-C
-      TYPE Agrif_grid  
-           ! pointer on the parent grid 
-           TYPE(Agrif_grid)                    ,Pointer :: parent      
-           ! pointer on the child grids 
-           TYPE(Agrif_pgrid)                   ,Pointer :: child_grids 
-           ! List of the grid variables   
-           TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: tabvars     
-           ! pointer on the save grid 
-           TYPE(Agrif_grid)                    ,Pointer :: save_grid                
-C
-           ! Global x,y and z position
-           REAL    ,DIMENSION(3)                   :: Agrif_x   
-           ! Global space step in the x,y and z direction
-           REAL    ,DIMENSION(3)                   :: Agrif_d
-           ! number of cells in the x,y and z direction
-           INTEGER ,DIMENSION(3)                   :: nb        
-           ! minimal position in the x,y and z direction
-           INTEGER ,DIMENSION(3)                   :: ix        
-           ! Space refinement factor in the x,y and z direction
-           INTEGER ,DIMENSION(3)                   :: spaceref  
-           ! Time refinement factor in the x,y and z direction 
-           INTEGER ,DIMENSION(3)                   :: timeref   
-           INTEGER ,DIMENSION(:)          ,Pointer :: restore1D   
-           INTEGER ,DIMENSION(:,:)        ,Pointer :: restore2D   
-           INTEGER ,DIMENSION(:,:,:)      ,Pointer :: restore3D 
-           INTEGER ,DIMENSION(:,:,:,:)    ,Pointer :: restore4D
-           INTEGER ,DIMENSION(:,:,:,:,:)  ,Pointer :: restore5D
-           INTEGER ,DIMENSION(:,:,:,:,:,:),Pointer :: restore6D
-           ! number of time step  
-           INTEGER                                 :: ngridstep 
-           INTEGER                                 :: rank  
-           !moving grid id
-           INTEGER                                 :: grid_id
-           ! number of the grid 
-           INTEGER                                 :: fixedrank 
-           ! fixed or moving grid ?  
-           LOGICAL                                 :: fixed     
-           LOGICAL                                 :: oldgrid   
-C          LOGICALs indicating if the current grid has a common border 
-C             with the root coarse grid
-           LOGICAL ,DIMENSION(3)                   :: NearRootBorder
-           LOGICAL ,DIMENSION(3)                   :: DistantRootBorder
-C          Arrays for adaptive grid refinement
-           REAL    ,DIMENSION(:)          ,Pointer :: valtabpoint1D
-           REAL    ,DIMENSION(:,:)        ,Pointer :: valtabpoint2D
-           REAL    ,DIMENSION(:,:,:)      ,Pointer :: valtabpoint3D
-           INTEGER ,DIMENSION(:)          ,Pointer :: tabpoint1D
-           INTEGER ,DIMENSION(:,:)        ,Pointer :: tabpoint2D
-           INTEGER ,DIMENSION(:,:,:)      ,Pointer :: tabpoint3D
-           Type(Agrif_List_Variables), Pointer     :: variables=>NULL()
-           INTEGER                                 :: NbVariables = 0
-           Type(Agrif_Flux), Pointer               :: fluxes => NULL()
-           INTEGER                                 :: level
-           ! level of the grid in the hierarchy
-      End TYPE Agrif_grid
-C
-C     **************************************************************************
-CCC   TYPE Agrif_VARIABLE
-C     **************************************************************************
-C     
-CCC   Description:
-CCC   Data TYPE to CHARACTERize a grid variable.   
-C
-      TYPE Agrif_Variable 
-         CHARACTER*80 :: variablename
-C       
-         ! Pointer on the variable of the root grid 
-         TYPE(Agrif_Variable), Pointer :: root_var 
-C
-         ! index of the first point in the REAL domain (x,y and z direction)
-         INTEGER     ,DIMENSION(6)          :: point
-         ! position of the variable on the cell (1 for the boarder of 
-         !    the edge, 2 for the center)
-         INTEGER     ,DIMENSION(:) ,Pointer :: posvar      => NULL() 
-         ! Indication for the space interpolation (module Agrif_Boundary)
-         INTEGER                   ,Pointer :: interpIndex => NULL() 
-         ! number of DIMENSIONs of the grid variable
-         INTEGER                            :: nbdim = 0             
-         ! Array indicating the TYPE of DIMENSION (space or not) for 
-         !    each of them 
-         CHARACTER(6),DIMENSION(:) ,Pointer :: interptab   => NULL() 
-C        Arrays containing the values of the grid variables (REAL)
-         REAL                                    :: array0 
-         REAL   , DIMENSION(:)          ,ALLOCATABLE :: array1    
-         REAL   , DIMENSION(:,:)        ,ALLOCATABLE :: array2    
-         REAL   , DIMENSION(:,:,:)      ,ALLOCATABLE :: array3    
-         REAL   , DIMENSION(:,:,:,:)    ,ALLOCATABLE :: array4    
-         REAL   , DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: array5    
-         REAL   , DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: array6  
-         
-         REAL   , DIMENSION(:)          ,POINTER :: parray1    
-         REAL   , DIMENSION(:,:)        ,POINTER :: parray2    
-         REAL   , DIMENSION(:,:,:)      ,POINTER :: parray3    
-         REAL   , DIMENSION(:,:,:,:)    ,POINTER :: parray4    
-         REAL   , DIMENSION(:,:,:,:,:)  ,POINTER :: parray5    
-         REAL   , DIMENSION(:,:,:,:,:,:),POINTER :: parray6
-         
-C        Arrays containing the values of the grid variables (REAL*8)
-         REAL*8                                 :: darray0
-         REAL*8, DIMENSION(:)          ,ALLOCATABLE :: darray1   
-         REAL*8, DIMENSION(:,:)        ,ALLOCATABLE :: darray2   
-         REAL*8, DIMENSION(:,:,:)      ,ALLOCATABLE :: darray3   
-         REAL*8, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: darray4   
-         REAL*8, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: darray5   
-         REAL*8, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: darray6   
-C        Arrays containing the values of the grid variables (REAL*4)
-         REAL*4                                 :: sarray0
-         REAL*4, DIMENSION(:)          ,ALLOCATABLE :: sarray1   
-         REAL*4, DIMENSION(:,:)        ,ALLOCATABLE :: sarray2   
-         REAL*4, DIMENSION(:,:,:)      ,ALLOCATABLE :: sarray3   
-         REAL*4, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: sarray4   
-         REAL*4, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: sarray5   
-         REAL*4, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: sarray6   
-C        Arrays containing the values of the grid variables (LOGICAL)
-         LOGICAL                                 :: larray0
-         LOGICAL, DIMENSION(:)          ,ALLOCATABLE :: larray1   
-         LOGICAL, DIMENSION(:,:)        ,ALLOCATABLE :: larray2   
-         LOGICAL, DIMENSION(:,:,:)      ,ALLOCATABLE :: larray3   
-         LOGICAL, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: larray4   
-         LOGICAL, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: larray5   
-         LOGICAL, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: larray6   
-C         Arrays containing the values of the grid variables (INTEGER)   
-         INTEGER                                 :: iarray0
-         INTEGER, DIMENSION(:)          ,ALLOCATABLE :: iarray1   
-         INTEGER, DIMENSION(:,:)        ,ALLOCATABLE :: iarray2   
-         INTEGER, DIMENSION(:,:,:)      ,ALLOCATABLE :: iarray3   
-         INTEGER, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: iarray4   
-         INTEGER, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: iarray5   
-         INTEGER, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: iarray6   
-C
-         INTEGER, DIMENSION(:)          ,Pointer :: restore1D => NULL()
-         INTEGER, DIMENSION(:,:)        ,Pointer :: restore2D => NULL()
-         INTEGER, DIMENSION(:,:,:)      ,Pointer :: restore3D => NULL()
-         INTEGER, DIMENSION(:,:,:,:)    ,Pointer :: restore4D => NULL()
-         INTEGER, DIMENSION(:,:,:,:,:)  ,Pointer :: restore5D => NULL()
-         INTEGER, DIMENSION(:,:,:,:,:,:),Pointer :: restore6D => NULL()
-C   
-         CHARACTER(2050)                          :: carray0
-         CHARACTER(200), DIMENSION(:)    ,ALLOCATABLE :: carray1
-         CHARACTER(200), DIMENSION(:,:)  ,ALLOCATABLE :: carray2
-C
-         ! Array used for the time interpolation
-         REAL   , DIMENSION(:,:)      ,Pointer :: oldvalues2D => NULL()
-
-         ! if the variable should be restore -> =1
-         LOGICAL :: restaure = .FALSE.
-         ! the interpolation should be made in any case
-         LOGICAL :: Interpolationshouldbemade = .FALSE. 
-         INTEGER :: bcinf ! option bc
-         INTEGER :: bcsup ! option bc
-         INTEGER, DIMENSION(6) :: updateinf ! option update
-         INTEGER, DIMENSION(6) :: updatesup ! option update         
-         INTEGER, DIMENSION(6,6) :: bcTYPEinterp ! option bcinterp
-         INTEGER, DIMENSION(6) :: TYPEinterp ! option interp
-         INTEGER, DIMENSION(6) :: TYPEupdate ! option update
-         
-         INTEGER, DIMENSION(6) :: lb, ub
-         
-         Type(Agrif_List_Interp_Loc), Pointer :: list_interp => NULL()
-         Type(Agrif_List_Interp_Loc), Pointer :: list_update => NULL()
-C
-      End TYPE Agrif_Variable 
-      
-      Type Agrif_Interp_Loc
-      integer,dimension(6) :: pttab,petab,
-     &                          pttab_Child,pttab_Parent = -99
-      integer,dimension(6) :: indmin, indmax
-      INTEGER,DIMENSION(6)    :: pttruetab,cetruetab
-      logical :: member, memberin      
-#if !defined key_mpp_mpi      
-      integer,dimension(6) :: indminglob,indmaxglob
-#else
-      integer,dimension(6) :: indminglob2,indmaxglob2
-      INTEGER,DIMENSION(6,2,2) :: parentarray
-      INTEGER,DIMENSION(:,:,:), POINTER :: tab4t
-      LOGICAL, DIMENSION(:), POINTER :: memberinall
-      INTEGER,DIMENSION(:,:,:), POINTER :: tab5t
-      LOGICAL, DIMENSION(:), POINTER :: memberinall2
-      LOGICAL, DIMENSION(:), POINTER :: sendtoproc1    
-      LOGICAL, DIMENSION(:), POINTER :: recvfromproc1      
-      LOGICAL, DIMENSION(:), POINTER :: sendtoproc2      
-      LOGICAL, DIMENSION(:), POINTER :: recvfromproc2      
-#endif      
-      End Type Agrif_Interp_Loc
-      
-      Type Agrif_List_Interp_Loc
-      Type(Agrif_Interp_Loc), Pointer :: interp_loc
-      Type(Agrif_List_Interp_Loc), Pointer :: suiv
-      End Type Agrif_List_Interp_Loc
-
-       TYPE Agrif_List_Variables
-         Type(Agrif_PVariable), Pointer :: pvar
-         Type(Agrif_List_Variables), Pointer :: nextvariable  => NULL()
-       END TYPE Agrif_List_Variables
-               
-       TYPE Agrif_Profile
-          character*80 :: profilename
-C
-         ! index of the first point in the REAL domain (x,y and z direction)
-         INTEGER     ,DIMENSION(6)          :: point
-         ! position of the variable on the cell (1 for the boarder of 
-         !    the edge, 2 for the center)
-         INTEGER     ,DIMENSION(:) ,Pointer :: posvar      => NULL() 
-         ! Indication for the space interpolation (module Agrif_Boundary)
-         INTEGER                   ,Pointer :: interpIndex => NULL() 
-         ! number of DIMENSIONs of the grid variable
-         INTEGER                            :: nbdim = 0             
-         ! Array indicating the TYPE of DIMENSION (space or not) for 
-         !    each of them 
-         CHARACTER(6),DIMENSION(:) ,Pointer :: interptab   => NULL() 
-         Type(Agrif_Variable), Pointer :: var
-         Type(Agrif_Profile), Pointer :: nextprofile  => NULL()
-       END TYPE Agrif_Profile
-       
-       Type(Agrif_Profile), Pointer :: Agrif_MyProfiles => NULL()
-           
-C  Boundaries Fluxes
-
-      Type Agrif_Flux
-        Character*80 fluxname
-        Type(Agrif_Variable), Pointer :: fluxtabx
-        Type(Agrif_Variable), Pointer :: fluxtaby
-        Type(Agrif_Variable), Pointer :: fluxtabz        
-        Type(Agrif_Profile), Pointer  :: profile
-        Logical :: Fluxallocated = .FALSE.
-        Type(Agrif_Flux), Pointer     :: nextflux => NULL()
-      End Type Agrif_Flux      
-C
-C     **************************************************************************
-CCC   Different PARAMETERs
-C     **************************************************************************
-      TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: Agrif_tabvars
-C
-      ! this pointer always points on the root grid of the grid hierarchy
-      TYPE(Agrif_grid)  ,Pointer :: Agrif_Mygrid      
-      ! Pointer used in the Agrif_regrid subroutine (Agrif_Util module). 
-      !    It contains  the safeguard of the grid hierarchy.
-      TYPE(Agrif_pgrid) ,Pointer :: Agrif_oldmygrid   
-      ! pointer to the current grid (the link is done by using the
-      !    Agrif_Instance   procedure (module Agrif_Init)) 
-      TYPE(Agrif_grid)  ,Pointer :: Agrif_Curgrid
-      ! Pointer used in the Agrif_ChildGrid_to_ParentGrid and 
-      !    Agrif_ParentGrid_to_ChildGrid subroutines 
-      !    (Agrif_CurgridFunctions module). It contains the 
-      !    safeguard of the current grid hierarchy.
-      TYPE(Agrif_grid)  ,Pointer :: Agrif_saveCURGRID
-C
-      ! Problem DIMENSION
-      INTEGER               :: Agrif_Probdim
-      ! number of variables
-      INTEGER               :: Agrif_NbVariables
-      ! number of fixed grids in the grid hierarchy
-      INTEGER               :: Agrif_nbfixedgrids            
-      ! space refinement factor
-      INTEGER ,DIMENSION(3) :: Agrif_coeffref
-      ! time refinement factor
-      INTEGER ,DIMENSION(3) :: Agrif_coeffreft
-      ! LOGICAL to use special values on the parent grid
-      LOGICAL               :: Agrif_UseSpecialValue
-      ! LOGICAL to use special values on the parent grid
-      LOGICAL               :: Agrif_UseSpecialValueInUpdate
-      ! LOGICAL to use special values on the current grid
-      LOGICAL               :: Agrif_UseSpecialValueFineGrid
-      ! Special values on the parent grid
-      REAL                  :: Agrif_SpecialValue
-      ! Special values on the current grid
-      REAL                  :: Agrif_SpecialValueFineGrid
-C   clustering PARAMETERs
-      INTEGER               :: Agrif_Regridding = 10
-      INTEGER               :: Agrif_Minwidth
-      REAL                  :: Agrif_Efficiency = 0.7
-      INTEGER               :: MaxSearch = 5
-      REAL    ,DIMENSION(3) :: Agrif_mind
-C     PARAMETERs for the interpolation of the child grids
-      ! linear interpolation
-      INTEGER ,PARAMETER    :: Agrif_linear=1
-      ! lagrange interpolation
-      INTEGER ,PARAMETER    :: Agrif_lagrange=2
-      ! spline interpolation
-      INTEGER ,PARAMETER    :: Agrif_eno=3
-      ! user s interpolation
-      INTEGER ,PARAMETER    :: Agrif_user_interp=4
-      ! constant interpolation
-      INTEGER ,PARAMETER    :: Agrif_constant=5
-      ! linear conservative interpolation 
-      INTEGER ,PARAMETER    :: Agrif_linearconserv=6
-      ! linear conservative interpolation       
-      INTEGER ,PARAMETER    :: Agrif_linearconservlim=7
-      INTEGER ,PARAMETER    :: Agrif_ppm=8 
-      INTEGER ,PARAMETER    :: Agrif_weno=9         
-C     PARAMETERs for the update of the parent grids      
-      INTEGER ,PARAMETER    :: Agrif_Update_Copy=1           ! copy
-      INTEGER ,PARAMETER    :: Agrif_Update_Average=2        ! average
-      INTEGER ,PARAMETER    :: Agrif_Update_Full_Weighting=3 ! full-weighting 
-C     Raffinement grid switch definition
-      ! Agrif_USE_ONLY_FIXED_GRIDS =1 if fixed grid mode
-      INTEGER               :: Agrif_USE_ONLY_FIXED_GRIDS    
-      ! Agrif_USE_FIXED_GRIDS = 1 if AMR mode + fixed grid 
-      !    else only AMR mode
-      INTEGER               :: Agrif_USE_FIXED_GRIDS
-      INTEGER               :: Agrif_Maxlevelloc
-C
-#ifdef key_mpp_mpi
-      INTEGER :: Agrif_Nbprocs  ! Number of processors
-      INTEGER :: Agrif_ProcRank ! Rank of the current processor 
-      INTEGER :: Agrif_Group    ! Group associated to MPI_COMM_AGRIF
-      INTEGER :: Agrif_MPIPREC
-#endif
-C
-      contains
-C   
-      Integer Function agrif_ceiling(x)
-C             
-          Real :: x
-          Integer ::i 
-C
-          i = floor(x)
-C      
-          if( abs(x - i).le.0.0001 )then
-             agrif_ceiling = i
-          else
-             agrif_ceiling = i+1
-          endif      
-C
-      End Function
-C
-      Integer Function agrif_int(x)
-C             
-          Real :: x
-          Integer ::i 
-C
-          i = floor(x) + 1
-C      
-          if( abs(x - i).le.0.0001 )then
-             agrif_int = i
-          else
-             agrif_int = i-1
-          endif      
-C
-      End Function
-      End Module Agrif_TYPEs  
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90	(revision 5682)
@@ -0,0 +1,425 @@
+!     Agrif (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!
+!
+!> Definition of data types used in AGRIF, of several variables and parameters
+!
+module Agrif_Types
+!
+use Agrif_Procs
+!
+implicit none
+!
+integer, parameter :: Agrif_MaxRaff = 7       !< Maximum refinement ratio
+integer, parameter :: Agrif_NbMaxGrids = 10   !< Maximum number of grids of the hierarchy
+!
+!===================================================================================================
+type Agrif_LRectangle
+!---------------------------------------------------------------------------------------------------
+!<  Data type allowing a grid to reach a grid on the same level or its child grids
+!
+    type(Agrif_Rectangle) , pointer :: r    => NULL()   !< to reach a child grid
+    type(Agrif_LRectangle), pointer :: next => NULL()   !< to reach a grid on the same level
+!
+!---------------------------------------------------------------------------------------------------
+end type Agrif_LRectangle
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Rectangle
+!---------------------------------------------------------------------------------------------------
+!<  Data type to define several characteristics of a grid (number, position, time and space
+!<  refinement factors, etc).
+!
+    integer                         :: number       !< Number of the grid
+    integer, dimension(3)           :: imin         !< Minimal position in the x,y and z direction
+    integer, dimension(3)           :: imax         !< Maximal position in the x,y and z direction
+    integer, dimension(3)           :: spaceref     !< Space refinement factor in the x,y and z direction
+    integer, dimension(3)           :: timeref      !< Time refinement factor in the x,y and z direction
+    type(Agrif_LRectangle), pointer :: childgrids => NULL()   !< Pointer to reach a grid on the same level or a child grid
+!
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Rectangle
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable), pointer  :: root_var   => NULL()  !< pointer on the variable of the root grid
+    type(Agrif_Variable), pointer  :: parent_var => NULL()  !< pointer on the parent variable
+!
+    integer,   dimension(6)              :: point           !< index of the first point in the
+                                                            !<    real domain (x,y and z direction)
+    integer,   dimension(:), allocatable :: posvar          !< position of the variable on the cell
+                                                            !<   (1 for the boarder of the edge, 2 for the center)
+    integer                            :: interpIndex = -1  !< Indication for the space interpolation (module Agrif_Boundary)
+    integer                            :: nbdim = 0         !< number of dimensions of the grid variable
+    character(1), dimension(:), allocatable :: interptab    !< Array indicating the type of dimension (space or not)
+                                                            !!   for each of them
+    integer,   dimension(:), allocatable :: coords          !< Array indicating the coordinate for each dimension
+                                                            !!   of the array that is refined :
+                                                            !!  'x' -> 1 ; 'y' -> 2 ; 'z' -> 3 ; 'N' -> 0
+
+!> @}
+!> \name Arrays containing the values of the grid variables (real)
+!> @{
+    real,    dimension(:)          , allocatable :: array1
+    real,    dimension(:,:)        , allocatable :: array2
+    real,    dimension(:,:,:)      , allocatable :: array3
+    real,    dimension(:,:,:,:)    , allocatable :: array4
+    real,    dimension(:,:,:,:,:)  , allocatable :: array5
+    real,    dimension(:,:,:,:,:,:), allocatable :: array6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*8)
+!> @{
+    real(8), dimension(:)          , allocatable :: darray1
+    real(8), dimension(:,:)        , allocatable :: darray2
+    real(8), dimension(:,:,:)      , allocatable :: darray3
+    real(8), dimension(:,:,:,:)    , allocatable :: darray4
+    real(8), dimension(:,:,:,:,:)  , allocatable :: darray5
+    real(8), dimension(:,:,:,:,:,:), allocatable :: darray6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*4)
+!> @{
+    real(4), dimension(:)          , allocatable :: sarray1
+    real(4), dimension(:,:)        , allocatable :: sarray2
+    real(4), dimension(:,:,:)      , allocatable :: sarray3
+    real(4), dimension(:,:,:,:)    , allocatable :: sarray4
+    real(4), dimension(:,:,:,:,:)  , allocatable :: sarray5
+    real(4), dimension(:,:,:,:,:,:), allocatable :: sarray6
+!> @}
+!> \name Arrays used to restore the values
+!> @{
+    integer, dimension(:)          , pointer :: restore1D => NULL()
+    integer, dimension(:,:)        , pointer :: restore2D => NULL()
+    integer, dimension(:,:,:)      , pointer :: restore3D => NULL()
+    integer, dimension(:,:,:,:)    , pointer :: restore4D => NULL()
+    integer, dimension(:,:,:,:,:)  , pointer :: restore5D => NULL()
+    integer, dimension(:,:,:,:,:,:), pointer :: restore6D => NULL()
+!> @}
+
+    real, dimension(:,:), pointer :: oldvalues2D => NULL() !< Array used for the time interpolation
+
+    logical :: restore = .FALSE. !< =1 if the variable should be restored
+    logical :: Interpolationshouldbemade = .FALSE. !< TRUE if the interpolation should be made in any case
+    integer                 :: bcinf !< option bc
+    integer                 :: bcsup !< option bc
+    integer, dimension(6)   :: type_interp    !< option interp
+    integer, dimension(6,6) :: type_interp_bc !< option bcinterp
+    integer, dimension(6)   :: type_update    !< option update
+
+    integer, dimension(6)   :: lb
+    integer, dimension(6)   :: ub
+
+    logical,dimension(6,2) :: memberin
+    integer,dimension(6,2,2,6,2) :: childarray
+
+    type(Agrif_List_Interp_Loc), pointer :: list_interp => NULL()
+    type(Agrif_List_Interp_Loc), pointer :: list_update => NULL()
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable_c
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable_c), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
+    type(Agrif_Variable_c), pointer  :: parent_var => NULL()      !< pointer on the parent variable
+!
+    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
+!
+!> \name Arrays containing the values of the grid variables (character)
+!> @{
+    character(2400)                             :: carray0
+    character(200), dimension(:)  , allocatable :: carray1
+    character(200), dimension(:,:), allocatable :: carray2
+!> @}
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable_c
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable_r
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable_r), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
+    type(Agrif_Variable_r), pointer  :: parent_var => NULL()      !< pointer on the parent variable
+!
+    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
+!
+!> \name Arrays containing the values of the grid variables (real)
+!> @{
+    real                                         :: array0
+    real,    dimension(:)          , allocatable :: array1
+    real,    dimension(:,:)        , allocatable :: array2
+    real,    dimension(:,:,:)      , allocatable :: array3
+    real,    dimension(:,:,:,:)    , allocatable :: array4
+    real,    dimension(:,:,:,:,:)  , allocatable :: array5
+    real,    dimension(:,:,:,:,:,:), allocatable :: array6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*8)
+!> @{
+    real(8)                                      :: darray0
+    real(8), dimension(:)          , allocatable :: darray1
+    real(8), dimension(:,:)        , allocatable :: darray2
+    real(8), dimension(:,:,:)      , allocatable :: darray3
+    real(8), dimension(:,:,:,:)    , allocatable :: darray4
+    real(8), dimension(:,:,:,:,:)  , allocatable :: darray5
+    real(8), dimension(:,:,:,:,:,:), allocatable :: darray6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*4)
+!> @{
+    real(4)                                      :: sarray0
+    real(4), dimension(:)          , allocatable :: sarray1
+    real(4), dimension(:,:)        , allocatable :: sarray2
+    real(4), dimension(:,:,:)      , allocatable :: sarray3
+    real(4), dimension(:,:,:,:)    , allocatable :: sarray4
+    real(4), dimension(:,:,:,:,:)  , allocatable :: sarray5
+    real(4), dimension(:,:,:,:,:,:), allocatable :: sarray6
+!> @}
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable_r
+!===================================================================================================
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable_l
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable_l), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
+    type(Agrif_Variable_l), pointer  :: parent_var => NULL()      !< pointer on the parent variable
+!
+    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
+!
+!> \name Arrays containing the values of the grid variables (logical)
+!> @{
+    logical                                      :: larray0
+    logical, dimension(:)          , allocatable :: larray1
+    logical, dimension(:,:)        , allocatable :: larray2
+    logical, dimension(:,:,:)      , allocatable :: larray3
+    logical, dimension(:,:,:,:)    , allocatable :: larray4
+    logical, dimension(:,:,:,:,:)  , allocatable :: larray5
+    logical, dimension(:,:,:,:,:,:), allocatable :: larray6
+!> @}
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable_l
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable_i
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable_i), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
+    type(Agrif_Variable_i), pointer  :: parent_var => NULL()      !< pointer on the parent variable
+!
+    integer                          :: nbdim = 0             !< number of dimensions of the grid variable
+!
+!> \name Arrays containing the values of the grid variables (integer)
+!> @{
+    integer                                      :: iarray0
+    integer, dimension(:)          , allocatable :: iarray1
+    integer, dimension(:,:)        , allocatable :: iarray2
+    integer, dimension(:,:,:)      , allocatable :: iarray3
+    integer, dimension(:,:,:,:)    , allocatable :: iarray4
+    integer, dimension(:,:,:,:,:)  , allocatable :: iarray5
+    integer, dimension(:,:,:,:,:,:), allocatable :: iarray6
+!> @}
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable_i
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Interp_Loc
+!---------------------------------------------------------------------------------------------------
+    integer,dimension(6)              :: pttab, petab, pttab_Child, pttab_Parent = -99
+    integer,dimension(6)              :: indmin, indmax
+    integer,dimension(6)              :: pttruetab,cetruetab
+    logical :: member, memberin
+#if !defined AGRIF_MPI
+    integer,dimension(6)              :: indminglob,indmaxglob
+#else
+    integer,dimension(6)              :: indminglob2,indmaxglob2
+    integer,dimension(6,2,2)          :: parentarray
+    integer,dimension(:,:,:), pointer :: tab4t          => NULL()
+    integer,dimension(:,:,:), pointer :: tab5t          => NULL()
+    logical, dimension(:),    pointer :: memberinall    => NULL()
+    logical, dimension(:),    pointer :: memberinall2   => NULL()
+    logical, dimension(:),    pointer :: sendtoproc1    => NULL()
+    logical, dimension(:),    pointer :: sendtoproc2    => NULL()
+    logical, dimension(:),    pointer :: recvfromproc1  => NULL()
+    logical, dimension(:),    pointer :: recvfromproc2  => NULL()
+#endif
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Interp_Loc
+!===================================================================================================
+
+!===================================================================================================
+type Agrif_List_Interp_Loc
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Interp_Loc),      pointer :: interp_loc => NULL()
+    type(Agrif_List_Interp_Loc), pointer :: suiv       => NULL()
+!---------------------------------------------------------------------------------------------------
+end type Agrif_List_Interp_Loc
+!===================================================================================================
+
+!===================================================================================================
+type Agrif_Variables_List
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),       pointer :: var  => NULL()
+    type(Agrif_Variables_List), pointer :: next => NULL()
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variables_List
+!===================================================================================================
+!
+!===================================================================================================
+!> Different parameters
+!
+    type(Agrif_Variable),   dimension(:), pointer :: Agrif_tabvars => NULL()
+    type(Agrif_Variable_c), dimension(:), pointer :: Agrif_tabvars_c => NULL()
+    type(Agrif_Variable_r), dimension(:), pointer :: Agrif_tabvars_r => NULL()
+    type(Agrif_Variable_l), dimension(:), pointer :: Agrif_tabvars_l => NULL()
+    type(Agrif_Variable_i), dimension(:), pointer :: Agrif_tabvars_i => NULL()
+!
+    integer               :: Agrif_Probdim          !< Problem dimension
+    integer,dimension(0:4):: Agrif_NbVariables      !< Number of variables
+    integer               :: Agrif_nbfixedgrids     !< Number of fixed grids in the grid hierarchy
+    integer, dimension(3) :: Agrif_coeffref         !< Space refinement factor
+    integer, dimension(3) :: Agrif_coeffreft        !< Time refinement factor
+    logical               :: Agrif_UseSpecialValue          !< T if use special values on the parent grid
+    logical               :: Agrif_UseSpecialValueInUpdate  !< T if use special values on the parent grid
+    logical               :: Agrif_Update_Weights = .FALSE.
+    logical               :: Agrif_UseSpecialValueFineGrid  !< T if use special values on the current grid
+    real                  :: Agrif_SpecialValue             !< Special value on the parent grid
+    real                  :: Agrif_SpecialValueFineGrid     !< Special value on the current grid
+!>
+!> \name Clustering parameters
+!> @{
+    integer               :: Agrif_Regridding = 10
+    integer               :: Agrif_Minwidth
+    real                  :: Agrif_Efficiency = 0.7
+    integer               :: MaxSearch = 5
+    real, dimension(3)    :: Agrif_mind
+!> @}
+!> \name parameters for the interpolation of the child grids
+!> @{
+    integer, parameter    :: Agrif_linear = 1           !< linear interpolation
+    integer, parameter    :: Agrif_lagrange = 2         !< lagrange interpolation
+    integer, parameter    :: Agrif_eno = 3              !< spline interpolation
+    integer, parameter    :: Agrif_user_interp = 4      !< user defined interpolation
+    integer, parameter    :: Agrif_constant = 5         !< constant interpolation
+    integer, parameter    :: Agrif_linearconserv = 6    !< linear conservative interpolation
+    integer, parameter    :: Agrif_linearconservlim = 7 !< linear conservative interpolation
+    integer, parameter    :: Agrif_ppm = 8              !< PPM interpolation
+    integer, parameter    :: Agrif_weno = 9             !< WENO5 interpolation
+    integer, parameter    :: Agrif_ppm_lim = 10         !< PPM interpolation with monotonicity
+!> @}
+!> \name parameters for the update of the parent grids
+!> @{
+    integer, parameter    :: Agrif_Update_Copy = 1              !< copy
+    integer, parameter    :: Agrif_Update_Average = 2           !< average
+    integer, parameter    :: Agrif_Update_Full_Weighting = 3    !< full-weighting
+!> @}
+!> \name Raffinement grid switches
+!> @{
+    integer               :: Agrif_USE_ONLY_FIXED_GRIDS   !< = 1 if fixed grid mode
+    integer               :: Agrif_USE_FIXED_GRIDS        !< = 1 if AMR mode + fixed grid else only AMR mode
+!> @}
+    integer               :: Agrif_Maxlevelloc
+!
+#if defined AGRIF_MPI
+    integer :: Agrif_Nbprocs  !< Number of processors
+    integer :: Agrif_ProcRank !< Rank of the current processor
+    integer :: Agrif_Group    !< Group associated to Agrif_mpi_comm
+    integer :: Agrif_mpi_comm
+#else
+    integer :: Agrif_ProcRank = 0
+#endif
+!
+    integer :: Agrif_Extra_Boundary_Cells = 3       !< When computing integration sequences, the grid rects
+                                                    !! are expanded to this number of cells.
+    logical :: Agrif_Parallel_sisters = .FALSE.     !< When TRUE, try to compute sister grids (which have the same parent)
+                                                    !! in parallel rather than sequentially.
+    logical :: agrif_regrid_has_been_done = .FALSE. !< switch to skip Agrif_Regrid call
+!
+    real, dimension(:)          , allocatable :: parray1
+    real, dimension(:,:)        , allocatable :: parray2
+    real, dimension(:,:,:)      , allocatable :: parray3
+    real, dimension(:,:,:,:)    , allocatable :: parray4
+    real, dimension(:,:,:,:,:)  , allocatable :: parray5
+    real, dimension(:,:,:,:,:,:), allocatable :: parray6
+!
+    logical :: agrif_debug = .false.    ! may be activaded in users subroutine for debugging purposes
+
+! If a grand mother grid is present
+    logical :: agrif_coarse = .false.
+    integer, dimension(3) :: coarse_spaceref = (/1,1,1/)
+    integer, dimension(3) :: coarse_timeref  = (/1,1,1/)
+!
+contains
+!
+!===================================================================================================
+!  function Agrif_Ceiling
+!---------------------------------------------------------------------------------------------------
+integer function Agrif_Ceiling ( x )
+!---------------------------------------------------------------------------------------------------
+    real,   intent(in) :: x
+!
+    integer   :: i
+!
+    i = FLOOR(x)
+!
+    if( ABS(x - i) <= 0.0001 )then
+        Agrif_Ceiling = i
+    else
+        Agrif_Ceiling = i+1
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Ceiling
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Int
+!---------------------------------------------------------------------------------------------------
+    integer function Agrif_Int(x)
+!---------------------------------------------------------------------------------------------------
+    real,   intent(in) :: x
+!
+    integer :: i
+!
+    i = FLOOR(x) + 1
+!
+    if( ABS(x - i) <= 0.0001 )then
+        Agrif_Int = i
+    else
+        Agrif_Int = i-1
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Int
+!===================================================================================================
+!
+end module Agrif_Types
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F	(revision 5659)
+++ 	(revision )
@@ -1,2677 +1,0 @@
-!
-! $Id$
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Update
-C
-      Module Agrif_Update
-C
-CCC   Description:
-CCC   Module to update a parent grid from its child grids
-C
-C     Modules used:
-C   
-      Use Agrif_Updatebasic
-c      Use Agrif_Boundary
-      Use Agrif_Arrays
-      Use Agrif_CurgridFunctions
-      Use Agrif_Mask
-#ifdef key_mpp_mpi
-      Use Agrif_mpp
-#endif
-C
-      IMPLICIT NONE
-      logical, private :: precomputedone(7) = .FALSE.      
-C      
-      CONTAINS
-C     Define procedures contained in this module
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_1d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Update_1d(TypeUpdate,parent,child,tab,deb,fin,
-     &                           procname)
-C
-CCC   Description:
-CCC   Subroutine to update a 1D grid variable on the parent grid.
-C
-C     Declarations:
-C
-      
-C
-C     Arguments      
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
-                                              ! are done on the fine grid       
-      External :: procname
-      Optional ::  procname      
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1)
-     &         ), Target :: tab    ! Result
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE  
-      allocate(childtemp % var)
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = 1  
-C      
-C     Values on the current grid used for the update
-C      childtemp % var % array1 => tab
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub             
-      
-C      childtemp % var % list_update => child%var%list_update
-             
-C
-     
-      IF (present(procname)) THEN
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin,procname)
-      ELSE
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin)
-      ENDIF     
-C      
-C      child % var % list_update => childtemp%var%list_update
-      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Update_1D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_2d
-C     **************************************************************************
-C 
-
-      Subroutine Agrif_Update_2d(TypeUpdate,parent,child,tab,deb,fin,
-     &                           procname)
-C
-CCC   Description:
-CCC   Subroutine to update a 2D grid variable on the parent grid.
-C
-C     Declarations:
-C
-      
-C
-C     Arguments      
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations  
-                                              ! are done on the fine grid 
-                                              
-      External :: procname
-      Optional ::  procname
-                                                          
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2)
-     &    ), Target :: tab    ! Result
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE
-      allocate(childtemp % var)
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = 2  
-C      
-C     Values on the current grid used for the update
-C      childtemp % var % array2 => tab 
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub             
-      
-C      childtemp % var % list_update => child%var%list_update      
-C
-      IF (present(procname)) THEN
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin,procname)
-      ELSE
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin)
-      ENDIF
-C      
-C      child % var % list_update => childtemp%var%list_update
-      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Update_2D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_3d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Update_3d(TypeUpdate,parent,child,tab,deb,fin,
-     &                           procname)
-C
-CCC   Description:
-CCC   Subroutine to update a 3D grid variable on the parent grid.
-C
-C     Declarations:
-C
-      
-C
-C     Arguments      
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
-                                              ! are done on the fine grid    
-      External :: procname
-      Optional ::  procname
-                                                       
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3)
-     &      ), Target :: tab  ! Results  
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE  
-      allocate(childtemp % var)
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = 3  
-C      
-C     Values on the current grid used for the update
-C      childtemp % var % array3 => tab     
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-      
-C      childtemp % var % list_update => child%var%list_update      
-C
-      IF (present(procname)) THEN
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin,procname)
-      ELSE
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin)
-      ENDIF
-C      
-C      child % var % list_update => childtemp%var%list_update
-      
-      DEALLOCATE(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Update_3D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_4d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Update_4d(TypeUpdate,parent,child,tab,deb,fin,
-     &                           procname)
-C
-CCC   Description:
-CCC   Subroutine to update a 4D grid variable on the parent grid.
-C
-C     Declarations:
-C
-      
-C
-C     Arguments      
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
-                                              ! are done on the fine grid     
-      External :: procname
-      Optional ::  procname        
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4)
-     &      ), Target :: tab  ! Results
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE  
-      allocate(childtemp % var)
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = 4  
-C      
-C     Values on the current grid used for the update
-C      childtemp % var % array4 => tab     
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-      
-C      childtemp % var % list_update => child%var%list_update
-            
-C
-      IF (present(procname)) THEN
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin,procname)
-      ELSE
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin)
-      ENDIF
-
-C      child % var % list_update => childtemp%var%list_update      
-C
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Update_4D
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_5d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Update_5d(TypeUpdate,parent,child,tab,deb,fin,
-     &                           procname)
-C
-CCC   Description:
-CCC   Subroutine to update a 5D grid variable on the parent grid.
-C
-C     Declarations:
-C
-      
-C
-C     Arguments      
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
-                                              ! are done on the fine grid     
-      External :: procname
-      Optional ::  procname
-              
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4),
-     &         child%var%lb(5):child%var%ub(5)
-     &      ),  Target :: tab  ! Results
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE  
-      allocate(childtemp % var)
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = 5  
-C      
-C     Values on the current grid used for the update
-C      childtemp % var % array5 => tab      
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub        
-      
-C      childtemp % var % list_update => child%var%list_update      
-C
-      IF (present(procname)) THEN
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin,procname)
-      ELSE
-      CALL Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin)
-      ENDIF
-      
-C      child % var % list_update => childtemp%var%list_update
-            
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Update_5D
-C
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_6d
-C     **************************************************************************
-C 
-      Subroutine Agrif_Update_6d(TypeUpdate,parent,child,tab,deb,fin)
-C
-CCC   Description:
-CCC   Subroutine to update a 6D grid variable on the parent grid.
-C
-C     Declarations:
-C
-      
-C
-C     Arguments      
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
-      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
-                                              ! are done on the fine grid       
-      REAL, DIMENSION(
-     &         child%var%lb(1):child%var%ub(1),
-     &         child%var%lb(2):child%var%ub(2),
-     &         child%var%lb(3):child%var%ub(3),
-     &         child%var%lb(4):child%var%ub(4),
-     &         child%var%lb(5):child%var%ub(5),
-     &         child%var%lb(6):child%var%ub(6)
-     &      ),  Target :: tab  ! Results
-C
-C
-C     Definition of a temporary AGRIF_PVariable data TYPE  
-      allocate(childtemp % var)
-C
-C     Pointer on the root variable
-      childtemp % var % root_var => child % var %root_var
-C      
-C     Number of dimensions of the grid variable
-      childtemp % var % nbdim = 6  
-C      
-C     Values on the current grid used for the update
-C      childtemp % var % array6 => tab      
-      
-      childtemp % var % lb = child % var % lb
-      childtemp % var % ub = child % var % ub  
-            
-C      childtemp % var % list_update => child%var%list_update
-C
-      Call Agrif_UpdateVariable
-     &     (TypeUpdate,parent,child,deb,fin)
-     
-C      child % var % list_update => childtemp%var%list_update
-           
-C      
-      deallocate(childtemp % var)
-C
-C       
-      End Subroutine Agrif_Update_6D
-C
-C
-C
-C     **************************************************************************  
-C     Subroutine Agrif_UpdateVariable    
-C     **************************************************************************  
-C   
-      Subroutine Agrif_UpdateVariable(TypeUpdate,parent,child,deb,fin,
-     &                   procname)   
-C
-CCC   Description:
-CCC   Subroutine to set arguments of Agrif_UpdatenD, n being the number of
-C         dimensions of the grid variable.
-C
-CC    Declarations:
-C      
-c      
-C      
-C     Scalar argument
-      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
-C     Data TYPE arguments
-      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
-      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid 
-      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
-                                        !    are calculated     
-      External :: procname
-      Optional ::  procname
-      
-C
-C     Local scalars      
-      INTEGER :: nbdim                  ! Number of dimensions of the current
-                                        !    grid
-      INTEGER ,DIMENSION(6) :: pttab_child  
-      INTEGER ,DIMENSION(6) :: petab_child      
-      INTEGER ,DIMENSION(6) :: pttab_parent  
-      REAL    ,DIMENSION(6) :: s_child,s_parent
-      REAL    ,DIMENSION(6) :: ds_child,ds_parent
-      INTEGER,DIMENSION(6)          :: loctab_Child ! Indicates if the child
-                                        !    grid has a common border with 
-                                        !    the root grid            
-      TYPE(AGRIF_Variable), Pointer :: root               ! Variable on the root grid
-      INTEGER,DIMENSION(6)          :: posvartab_Child    ! Position of the
-                                        !    variable on the cell
-      INTEGER,DIMENSION(6)          :: nbtab_Child        ! Number of the cells    
-      INTEGER :: n              
-      LOGICAL :: wholeupdate
-C
-C 
-
-      loctab_child(:) = 0
-C
-      root => child % var % root_var 
-      nbdim = root % nbdim
-C
-      do n = 1,nbdim
-        posvartab_child(n) = root % posvar(n)
-      enddo
-C      
-      
-      Call PreProcessToInterpOrUpdate(parent,child,
-     &             petab_Child(1:nbdim),
-     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &             s_Child(1:nbdim),s_Parent(1:nbdim),
-     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &             nbdim)
-C
-C
-      do n = 1,nbdim
-C
-        Select case(root % interptab(n))
-C
-          case('x') ! x DIMENSION
-C
-            nbtab_Child(n) = Agrif_Curgrid % nb(1)
-C
-          case('y') ! y DIMENSION      
-C
-            nbtab_Child(n) = Agrif_Curgrid % nb(2)
-C
-          case('z') ! z DIMENSION
-C
-            nbtab_Child(n) = Agrif_Curgrid % nb(3)
-C
-          case('N') ! No space DIMENSION      
-C
-            
-            nbtab_Child(n) = child % var % ub(n) - child % var % lb(n)
-C
-C           No interpolation but only a copy of the values of the grid variable      
-C      
-            posvartab_child(n) = 1
-            
-            loctab_child(n) = -3
-C
-        End select
-C
-      enddo
-      
-C     Call to a procedure of update according to the number of dimensions of
-C     the grid variable
-
-      wholeupdate = .FALSE.
-      
-      do n=1,nbdim
-      if (loctab_child(n) /= -3) then
-        if (deb(n)>fin(n)) wholeupdate = .TRUE.
-        if ((deb(n) == -99).AND.(deb(n)==fin(n))) wholeupdate=.TRUE.
-      endif
-      enddo
-
-       IF (present(procname)) THEN
-
-          IF (wholeupdate) THEN
-
-          Call AGRIF_UpdateWhole
-     &         (TypeUpdate,parent,child,deb,fin,
-     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
-     &          loctab_Child(1:nbdim),
-     &          s_Child(1:nbdim),s_Parent(1:nbdim),
-     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)  
-         ELSE
-          Call AGRIF_UpdateBcnD
-     &         (TypeUpdate,parent,child,deb,fin,
-     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
-     &          loctab_Child(1:nbdim),
-     &          s_Child(1:nbdim),s_Parent(1:nbdim),
-     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)  
-         ENDIF
-       ELSE
-         IF (wholeupdate) THEN
-          Call AGRIF_UpdateWhole
-     &         (TypeUpdate,parent,child,deb,fin,
-     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
-     &          loctab_Child(1:nbdim),
-     &          s_Child(1:nbdim),s_Parent(1:nbdim),
-     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
-         ELSE
-          Call AGRIF_UpdateBcnD
-     &         (TypeUpdate,parent,child,deb,fin,
-     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
-     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
-     &          loctab_Child(1:nbdim),
-     &          s_Child(1:nbdim),s_Parent(1:nbdim),
-     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
-         ENDIF
-       ENDIF
-C
-      Return
-C
-C
-      End subroutine Agrif_UpdateVariable
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_UpdateWhole
-C     **************************************************************************               
-C
-      Subroutine AGRIF_UpdateWhole(TypeUpdate,parent,child,deb,fin,
-     &                           pttab_child,pttab_Parent,
-     &                           nbtab_Child,posvartab_Child,
-     &                           loctab_Child,
-     &                           s_Child,s_Parent,
-     &                           ds_Child,ds_Parent,nbdim,procname)
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions for a nD grid variable on 
-CCC   a fine grid by using a space and time interpolations; it is called by the 
-CCC   Agrif_CorrectVariable procedure.
-C
-C
-C     Declarations:
-C
-      
-C
-#ifdef key_mpp_mpi
-C
-      INCLUDE 'mpif.h'
-C
-#endif
-C
-C     Arguments
-      INTEGER, DIMENSION(6) :: TypeUpdate            ! TYPE of update (copy or
-                                                     !    average) 
-      TYPE(AGRIF_PVariable)    :: parent             ! Variable on the parent
-                                                     !    grid
-      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child
-                                                     !    grid 
-      INTEGER, DIMENSION(6) :: deb, fin
-      INTEGER                  :: nbdim              ! Number of dimensions of
-                                                     !    the grid variable
-      INTEGER,DIMENSION(nbdim) :: pttab_child        ! Index of the first point
-                                                     !    inside the domain for
-                                                     !    the parent grid
-                                                     !    variable
-      INTEGER,DIMENSION(nbdim) :: pttab_Parent       ! Index of the first point
-                                                     !    inside the domain for
-                                                     !    the child grid
-                                                     !    variable
-      INTEGER,DIMENSION(nbdim) :: nbtab_Child        ! Number of cells of the
-                                                     !    child grid
-      INTEGER,DIMENSION(nbdim) :: posvartab_Child    ! Position of the grid
-                                                     !    variable (1 or 2)
-      INTEGER,DIMENSION(nbdim) :: loctab_Child       ! Indicates if the child
-                                                     !    grid has a common
-                                                     !    border with the root
-                                                     !    grid
-      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent   ! Positions of the parent
-                                                     !    and child grids 
-      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the parent
-                                                     !    and child grids
-      External :: procname
-      Optional ::  procname      
-C
-C     Local variables     
-      INTEGER,DIMENSION(nbdim,2)   :: lubglob
-      INTEGER                      :: i                 
-      INTEGER,DIMENSION(nbdim,2,2) :: indtab         ! Arrays indicating the
-                                                     !    limits of the child
-      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab     ! grid variable where
-                                                     !   boundary conditions are
-      integer :: coeffraf
-      INTEGER :: debloc, finloc
-C
-#ifdef key_mpp_mpi
-C
-      INTEGER,DIMENSION(nbdim)   :: lb,ub
-      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
-      INTEGER                    :: code
-C
-#endif
-C      
-C
-C indtab contains the limits for the fine grid points that will be used
-C in the update scheme
-
-      DO i = 1, nbdim
-        coeffraf = nint(ds_Parent(i)/ds_Child(i))
-        debloc = 0
-        finloc = nbtab_Child(i)/coeffraf - 1
-
-        IF (posvartab_child(i) == 1) THEN
-           finloc = finloc - 1
-        ENDIF
-
-        IF (deb(i) > fin(i)) THEN
-          debloc = deb(i)
-          finloc = finloc - deb(i)
-        ENDIF
-
-        indtab(i,1,1) = pttab_child(i) + (debloc + 1) * coeffraf
-        indtab(i,1,2) = pttab_child(i) + (finloc + 1) * coeffraf
-
-        IF (posvartab_child(i) == 1) THEN
-          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
-            indtab(i,1,1) = indtab(i,1,1) - (coeffraf - 1)
-            indtab(i,1,2) = indtab(i,1,2) + (coeffraf - 1)        
-          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN
-            indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
-            indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
-          ENDIF
-        ELSE
-          indtab(i,1,1) = indtab(i,1,1) - coeffraf
-          indtab(i,1,2) = indtab(i,1,2) - 1
-C at this point, indices are OK for an average          
-          IF ((TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting)) THEN
-            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
-            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
-          ENDIF
-        ENDIF
-        IF (loctab_child(i) == -3) THEN
-           indtab(i,1,1) = pttab_child(i)
-C
-               if (posvartab_child(i) == 1) then
-C
-               indtab(i,1,2) = pttab_child(i) + nbtab_child(i) 
-C
-               else
-C
-               indtab(i,1,2) = pttab_child(i) + nbtab_child(i) - 1
-               ENDIF
-        ENDIF
-      ENDDO
-
-C lubglob contains the global lbound and ubound of the child array
-C lubglob(:,1) : global lbound for each dimension
-C lubglob(:,2) : global lbound for each dimension
-
-#if !defined key_mpp_mpi
-        Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
-     &               lubglob(:,2),nbdim)
-C
-#else
-C     
-        Call Agrif_nbdim_Get_bound_dimension(child % var,lb,ub,nbdim)
-      DO i = 1,nbdim
-C
-        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
-        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
-C
-      ENDDO
-C
-      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
-      
-      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
-     &                     MPI_COMM_AGRIF,code)
-
-      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
-C
-#endif 
-C
-      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
-     &     lubglob(1:nbdim,1))
-      indtruetab(1:nbdim,1,2) = min(indtab(1:nbdim,1,2),
-     &     lubglob(1:nbdim,2))
-
-C
-C
-           IF (present(procname)) THEN
-              Call Agrif_UpdatenD              
-     &             (TypeUpdate,parent,child,
-     &              indtruetab(1:nbdim,1,1),indtruetab(1:nbdim,1,2),
-     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
-     &              s_Child(1:nbdim),s_Parent(1:nbdim),
-     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &              posvartab_child,loctab_Child,
-     &              nbdim,procname)
-           ELSE
-              Call Agrif_UpdatenD              
-     &             (TypeUpdate,parent,child,
-     &              indtruetab(1:nbdim,1,1),indtruetab(1:nbdim,1,2),
-     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
-     &              s_Child(1:nbdim),s_Parent(1:nbdim),
-     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &              posvartab_child,loctab_Child,
-     &              nbdim)           
-           ENDIF        
-C
-C      
-C  
-      End Subroutine Agrif_UpdateWhole
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_UpdateBcnd
-C     **************************************************************************               
-C
-      Subroutine AGRIF_UpdateBcnd(TypeUpdate,parent,child,deb,fin,
-     &                           pttab_child,pttab_Parent,
-     &                           nbtab_Child,posvartab_Child,
-     &                           loctab_Child,
-     &                           s_Child,s_Parent,
-     &                           ds_Child,ds_Parent,nbdim,procname)
-C
-CCC   Description:
-CCC   Subroutine to calculate the boundary conditions for a nD grid variable on
-CCC   a fine grid by using a space and time interpolations; it is called by the 
-CCC   Agrif_CorrectVariable procedure.
-C
-C
-C     Declarations:
-C
-      
-C
-#ifdef key_mpp_mpi
-C
-       INCLUDE 'mpif.h'
-C
-#endif
-C
-C     Arguments
-      INTEGER, DIMENSION(6) :: TypeUpdate            ! TYPE of update 
-                                                     !   (copy or average) 
-      TYPE(AGRIF_PVariable)    :: parent             ! Variable on the parent
-                                                     !   grid
-      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child
-                                                     !   grid 
-      INTEGER, DIMENSION(6) :: deb, fin
-      INTEGER                  :: nbdim              ! Number of dimensions of
-                                                     !   the grid variable
-      INTEGER,DIMENSION(nbdim) :: pttab_child        ! Index of the first point
-                                                     !   inside the domain for
-                                                     !   the parent grid
-                                                     !   variable
-      INTEGER,DIMENSION(nbdim) :: pttab_Parent       ! Index of the first point
-                                                     !   inside the domain for
-                                                     !   the child grid variable
-      INTEGER,DIMENSION(nbdim) :: nbtab_Child        ! Number of cells of the
-                                                     !   child grid
-      INTEGER,DIMENSION(nbdim) :: posvartab_Child    ! Position of the grid
-                                                     !   variable (1 or 2)
-      INTEGER,DIMENSION(nbdim) :: loctab_Child       ! Indicates if the child
-                                                     !   grid has a common
-                                                     !   border with the root
-                                                     !   grid
-      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent   ! Positions of the parent
-                                                     !   and child grids 
-      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the parent
-                                                     !   and child grids
-      External :: procname
-      Optional ::  procname      
-C
-C     Local variables
-      INTEGER,DIMENSION(nbdim,2)   :: lubglob
-      INTEGER                      :: i                 
-      INTEGER,DIMENSION(nbdim,2,2) :: indtab         ! Arrays indicating the
-                                                     !   limits of the child
-      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab     ! grid variable where
-                                                     !  boundary conditions are 
-      INTEGER,DIMENSION(nbdim,2,2,nbdim)   :: ptres      ! calculated
-      INTEGER                      :: nb,ndir,n
-      integer :: coeffraf
-C
-#ifdef key_mpp_mpi
-C
-      INTEGER,DIMENSION(nbdim)   :: lb,ub
-      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
-      INTEGER                    :: code
-C
-#endif
-C      
-C
-
-      DO i = 1, nbdim
-        coeffraf = nint(ds_Parent(i)/ds_Child(i))
-        indtab(i,1,1) = pttab_child(i) + (deb(i) + 1) * coeffraf
-        indtab(i,1,2) = pttab_child(i) + (fin(i) + 1) * coeffraf
-
-        indtab(i,2,1) = pttab_child(i) + nbtab_child(i)
-     &    - (fin(i) + 1) *  coeffraf
-        indtab(i,2,2) = pttab_child(i) + nbtab_child(i)
-     &    - (deb(i) + 1) *  coeffraf
-
-        IF (posvartab_child(i) == 1) THEN
-          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
-            indtab(i,:,1) = indtab(i,:,1) - (coeffraf - 1)
-            indtab(i,:,2) = indtab(i,:,2) + (coeffraf - 1)        
-          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN
-            indtab(i,:,1) = indtab(i,:,1) - coeffraf / 2
-            indtab(i,:,2) = indtab(i,:,2) + coeffraf / 2
-          ENDIF
-        ELSE
-          indtab(i,1,1) = indtab(i,1,1) - coeffraf
-          indtab(i,1,2) = indtab(i,1,2) - 1
-          indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1
-          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
-            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
-            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
-            indtab(i,2,1) = indtab(i,2,1) - coeffraf/2
-            indtab(i,2,2) = indtab(i,2,2) + coeffraf/2
-          ENDIF          
-        ENDIF
-      ENDDO
-
-#if !defined key_mpp_mpi      
-        Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
-     &               lubglob(:,2),nbdim)
-
-C
-#else
-C     
-        Call Agrif_nbdim_Get_bound_dimension(child % var,lb,ub,nbdim)
-      DO i = 1,nbdim
-C
-        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
-        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
-C
-      ENDDO
-C
-      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
-      
-      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
-     &                     MPI_COMM_AGRIF,code)  
-     
-      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
-C
-#endif 
-C     
-      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
-     &     lubglob(1:nbdim,1))
-      indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),
-     &     lubglob(1:nbdim,1))
-      indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),
-     &     lubglob(1:nbdim,2))
-      indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),
-     &     lubglob(1:nbdim,2))
-                        
-C 
-C
-      do nb = 1,nbdim
-C
-        do ndir = 1,2
-C
-          if (loctab_child(nb) /= -3) then
-C           
-              do n = 1,2
-C
-                ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)
-C
-              enddo              
-C
-              do i = 1,nbdim
-C     
-                if (i .NE. nb) then      
-C
-                    if (loctab_child(i) == -3) then
-C
-                        ptres(i,1,ndir,nb) = pttab_child(i)
-C
-                      else
-C
-                        ptres(i,1,ndir,nb) = indtruetab(i,1,1)
-C
-                    endif
-C
-                    if (loctab_child(i) == -3) then
-C
-                        if (posvartab_child(i) == 1) then
-C
-                            ptres(i,2,ndir,nb) = pttab_child(i) 
-     &                                + nbtab_child(i)
-C
-                          else
-C
-                            ptres(i,2,ndir,nb) = pttab_child(i) 
-     &                             + nbtab_child(i) - 1
-C
-                        endif                             
-C
-                      else
-C
-                        ptres(i,2,ndir,nb) = indtruetab(i,2,2)
-C
-                    endif                        
-C      
-                endif
-C      
-              enddo
-      
-C
-            
-        endif
-      
-        enddo
-       enddo
-C
-
-C
-
-      do nb = 1,nbdim
-C
-        do ndir = 1,2                
-C
-          if (loctab_child(nb) /= -3) then
-C
-           IF (present(procname)) THEN
-              Call Agrif_UpdatenD              
-     &             (TypeUpdate,parent,child,
-     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
-     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
-     &              s_Child(1:nbdim),s_Parent(1:nbdim),
-     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &              posvartab_Child,loctab_Child,
-     &              nbdim,procname,nb,ndir)
-           ELSE
-              Call Agrif_UpdatenD              
-     &             (TypeUpdate,parent,child,
-     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
-     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
-     &              s_Child(1:nbdim),s_Parent(1:nbdim),
-     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
-     &              posvartab_Child,loctab_Child,
-     &              nbdim)           
-           ENDIF
-C
-          endif
-          
-C
-        enddo       
-C
-      enddo
-C
-C      
-C  
-      End Subroutine Agrif_UpdateBcnd
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_UpdatenD  
-C     **************************************************************************  
-C  
-      Subroutine Agrif_UpdatenD(TypeUpdate,parent,child,
-     &                          pttab,petab,
-     &                          pttab_Child,pttab_Parent,
-     &                          s_Child,s_Parent,
-     &                          ds_Child,ds_Parent,
-     &                          posvartab_Child,loctab_Child,
-     &                          nbdim,procname,nb,ndir)  
-C
-C     Description:
-C     Subroutine to update a 2D grid variable on the parent grid of 
-C        the current grid. 
-C
-C     Declarations:
-C
-      
-C
-#ifdef key_mpp_mpi
-C
-       INCLUDE 'mpif.h'
-C
-#endif
-C
-C     Arguments
-      INTEGER                    :: nbdim
-      INTEGER, DIMENSION(6) :: TypeUpdate              ! TYPE of update 
-                                                       !  (copy or average)
-      TYPE(AGRIF_PVARIABLE)      :: parent             ! Variable of the parent
-                                                       !   grid   
-      TYPE(AGRIF_PVARIABLE)      :: child              ! Variable of the child
-                                                       !   grid
-      INTEGER,DIMENSION(nbdim)   :: pttab              ! Index of the first
-                                                       !   point inside the
-                                                       !   domain
-      INTEGER,DIMENSION(nbdim)   :: petab              ! Index of the first
-                                                       !   point inside the
-                                                       !   domain
-      INTEGER,DIMENSION(nbdim)   :: pttab_Child        ! Index of the first
-                                                       !   point inside the
-                                                       !   domain for the child
-                                                       !   grid variable
-      INTEGER,DIMENSION(nbdim)   :: pttab_Parent       ! Index of the first
-                                                       !   point inside the
-                                                       !   domain for the parent
-                                                       !   grid variable
-      REAL,DIMENSION(nbdim)      :: s_Child,s_Parent   ! Positions of the parent
-                                                       !   and child grids
-      REAL,DIMENSION(nbdim)      :: ds_Child,ds_Parent ! Space steps of the
-                                                       !   parent and child
-                                                       !   grids 
-      External :: procname
-      Optional ::  procname
-      Integer :: nb,ndir
-      Optional :: nb,ndir
-      
-C
-C     Local pointers
-      TYPE(AGRIF_PVARIABLE), SAVE      :: tempP      ! Temporary parent grid variable
-      TYPE(AGRIF_PVARIABLE), SAVE      :: tempC      ! Temporary child grid variable
-C
-C     Local scalars
-      INTEGER,DIMENSION(nbdim)    :: pttruetab,cetruetab
-      INTEGER,DIMENSION(nbdim)    :: posvartab_Child,loctab_Child
-      INTEGER,DIMENSION(nbdim)    :: indmin,indmax
-      INTEGER,DIMENSION(nbdim)    :: indminglob,indmaxglob
-      REAL   ,DIMENSION(nbdim)    :: s_Child_temp,s_Parent_temp
-cccccccc      LOGICAL,DIMENSION(nbdim)    :: noraftab
-      INTEGER,DIMENSION(nbdim)    :: lowerbound,upperbound
-      LOGICAL :: memberin, member
-      INTEGER,DIMENSION(nbdim)    :: pttruetabwhole,cetruetabwhole
-      INTEGER,DIMENSION(nbdim,2,2) :: childarray
-      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
-      TYPE(AGRIF_PVARIABLE), SAVE      :: tempCextend,tempPextend ! Temporary child
-      INTEGER :: nbin, ndirin
-C
-#ifdef key_mpp_mpi
-C
-      INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2      
-      INTEGER                              :: code
-      INTEGER                              :: i,j,k
-      INTEGER,DIMENSION(nbdim,4)           :: tab3
-      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
-      LOGICAL :: find_list_update
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
-      LOGICAL, DIMENSION(1) :: memberin1      
-C
-#endif
-C
-  
-C
-C     local lbound and ubound of the child array
-
-      Call Agrif_nbdim_Get_bound_dimension(child%var,
-     &                              lowerbound,upperbound,nbdim)
-
-C here pttab and petab corresponds to the (global) indices of the points needed
-C in the update
-C pttruetab and cetruetab contains only indices that are present
-C on the local processor
-
-      Call Agrif_Childbounds(nbdim,
-     &                       lowerbound,upperbound,
-     &                       pttab,petab,
-     &                       pttruetab,cetruetab,memberin)
-
-       Call Agrif_Prtbounds(nbdim,indminglob,indmaxglob,s_Parent_temp,
-     &                     s_Child_temp,s_Child,ds_Child,
-     &                     s_Parent,ds_Parent,
-     &                     pttab,petab,pttab_Child,
-     &                     pttab_Parent,
-     &                     posvartab_Child,TypeUpdate,loctab_Child
-#ifdef key_mpp_mpi
-     &                 ,pttruetabwhole,cetruetabwhole
-#endif
-     &     )
-
-#ifdef key_mpp_mpi
-      IF (memberin) THEN
-       Call Agrif_GlobtoLocInd2(childarray,
-     &                     lowerbound,upperbound,
-     &                     pttruetab,cetruetab,
-     &                     nbdim,Agrif_Procrank,
-     &                     member)
-
-      ENDIF
-
-
-         Call Agrif_Prtbounds(nbdim,indmin,indmax,s_Parent_temp,
-     &                     s_Child_temp,s_Child,ds_Child,
-     &                     s_Parent,ds_Parent,
-     &                     pttruetab,cetruetab,pttab_Child,
-     &                     pttab_Parent,
-     &                     posvartab_Child,TypeUpdate,loctab_Child
-     &                 ,pttruetabwhole,cetruetabwhole
-     &     )
-
-#else
-       indmin = indminglob
-       indmax = indmaxglob
-       pttruetabwhole = pttruetab
-       cetruetabwhole = cetruetab
-       childarray(:,1,2) = pttruetab
-       childarray(:,2,2) = cetruetab
-#endif
-
-       IF (present(procname)) THEN
-       IF (.Not.present(nb)) THEN
-       nbin=0
-       ndirin=0
-       ELSE
-       nbin = nb
-       ndirin = ndir
-       ENDIF
-       ENDIF
-       
-      IF (memberin) THEN
-      IF (.not.associated(tempC%var)) allocate(tempC%var)
-
-C
-      Call Agrif_nbdim_allocation(tempC%var,
-     &                 pttruetab,cetruetab,nbdim)
-
-      Call Agrif_nbdim_Full_VarEQreal(tempC%var,0.,nbdim)
-
-      IF (present(procname)) THEN
-        SELECT CASE (nbdim)
-        CASE(1)
-          CALL procname(tempC%var%array1,
-     &                          childarray(1,1,2),childarray(1,2,2),
-     &                                   .TRUE.,nbin,ndirin)
-        CASE(2)
-          CALL procname(tempC%var%array2,
-     &                          childarray(1,1,2),childarray(1,2,2),
-     &                          childarray(2,1,2),childarray(2,2,2),
-     &                                   .TRUE.,nbin,ndirin)
-        CASE(3)
-          CALL procname(tempC%var%array3,
-     &                          childarray(1,1,2),childarray(1,2,2),
-     &                          childarray(2,1,2),childarray(2,2,2),
-     &                          childarray(3,1,2),childarray(3,2,2),
-     &                                   .TRUE.,nbin,ndirin)
-        CASE(4)
-          CALL procname(tempC%var%array4,
-     &                          childarray(1,1,2),childarray(1,2,2),
-     &                          childarray(2,1,2),childarray(2,2,2),
-     &                          childarray(3,1,2),childarray(3,2,2),
-     &                          childarray(4,1,2),childarray(4,2,2),
-     &                                   .TRUE.,nbin,ndirin)
-        CASE(5)
-          CALL procname(tempC%var%array5,
-     &                          childarray(1,1,2),childarray(1,2,2),
-     &                          childarray(2,1,2),childarray(2,2,2),
-     &                          childarray(3,1,2),childarray(3,2,2),
-     &                          childarray(4,1,2),childarray(4,2,2),
-     &                          childarray(5,1,2),childarray(5,2,2),
-     &                                   .TRUE.,nbin,ndirin)
-        CASE(6)
-          CALL procname(tempC%var%array6,
-     &                          childarray(1,1,2),childarray(1,2,2),
-     &                          childarray(2,1,2),childarray(2,2,2),
-     &                          childarray(3,1,2),childarray(3,2,2),
-     &                          childarray(4,1,2),childarray(4,2,2),
-     &                          childarray(5,1,2),childarray(5,2,2),
-     &                          childarray(6,1,2),childarray(6,2,2),
-     &                                   .TRUE.,nbin,ndirin)
-        END SELECT
-      ELSE
-      Call Agrif_nbdim_VarEQvar(tempC%var,pttruetab,cetruetab,
-     &          child%var,childarray(:,1,2),childarray(:,2,2),
-     &                          nbdim)
-      ENDIF
-
-      ENDIF
-
-
-
-C
-C
-#ifdef key_mpp_mpi
-C
-C     tab2 contains the necessary limits of the parent grid for each processor
-
-      IF (Associated(child%var%list_update)) THEN
-      Call Agrif_Find_list_update(child%var%list_update,pttab,petab,
-     &                          pttab_Child,pttab_Parent,nbdim,
-     &       find_list_update,tab4t,tab5t,memberinall,memberinall2,
-     &     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
-      ELSE
-      find_list_update = .FALSE.
-      ENDIF
-      
-      if (.not.find_list_update) then      
-      tab3(:,1) = pttruetab(:)
-      tab3(:,2) = cetruetab(:)
-      tab3(:,3) = pttruetabwhole(:)
-      tab3(:,4) = cetruetabwhole(:)
-C
-C
-      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
-     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
-
-      IF (.not.associated(tempCextend%var)) Allocate(tempCextend%var)
-      DO k=0,Agrif_Nbprocs-1
-       do j=1,4
-         do i=1,nbdim
-         tab4t(i,k,j) = tab4(i,j,k)
-         enddo
-       enddo
-      enddo
-      
-      memberin1(1) = memberin
-      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,
-     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
- 
-       Call Get_External_Data_first(tab4t(:,:,1),
-     &            tab4t(:,:,2),
-     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin,
-     &            memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5),
-     & tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
-               
-      endif
-
-      Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim,
-     &            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),
-     &            tab4t(:,:,7),tab4t(:,:,8),memberin,tempC,
-     &            tempCextend) 
-           
-!      Call Get_External_Data(tempC,tempCextend,tab4t(:,:,1),
-!     &            tab4t(:,:,2),
-!     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin,
-!     &            memberinall)
-
-#else
-      tempCextend%var => tempC%var
-#endif
-
-C
-C
-C     Update of the parent grid (tempP) from the child grid (tempC)
-
-
-      IF (memberin) THEN
-
-      IF (.not.associated(tempP%var)) allocate(tempP%var)
-      Call Agrif_nbdim_allocation(tempP%var,
-     &                 indmin,indmax,nbdim)
-
-      if ( nbdim .EQ. 1 ) then
-         tempP%var%array1 = 0.
-         Call Agrif_Update_1D_recursive(TypeUpdate,
-     &           tempP%var%array1,tempCextend%var%array1,
-     &           indmin,indmax,
-     &           pttruetabwhole,cetruetabwhole,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      endif
-      if ( nbdim .EQ. 2 ) then
-         Call Agrif_Update_2D_recursive(TypeUpdate,
-     &           tempP%var%array2,tempCextend%var%array2,
-     &           indmin,indmax,
-     &           pttruetabwhole,cetruetabwhole,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      endif
-
-      if ( nbdim .EQ. 3 ) then
-         Call Agrif_Update_3D_recursive(TypeUpdate,
-     &           tempP%var%array3,tempCextend%var%array3,
-     &           indmin,indmax,
-     &           pttruetabwhole,cetruetabwhole,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      endif
-      if ( nbdim .EQ. 4 ) then
-         Call Agrif_Update_4D_recursive(TypeUpdate,
-     &           tempP%var%array4,tempCextend%var%array4,
-     &           indmin,indmax,
-     &           pttruetabwhole,cetruetabwhole,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      endif
-      if ( nbdim .EQ. 5 ) then
-         Call Agrif_Update_5D_recursive(TypeUpdate,
-     &           tempP%var%array5,tempCextend%var%array5,
-     &           indmin,indmax,
-     &           pttruetabwhole,cetruetabwhole,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      endif
-      if ( nbdim .EQ. 6 ) then
-         Call Agrif_Update_6D_recursive(TypeUpdate,
-     &           tempP%var%array6,tempCextend%var%array6,
-     &           indmin,indmax,
-     &           pttruetabwhole,cetruetabwhole,
-     &           s_Child_temp,s_Parent_temp,
-     &           ds_Child,ds_Parent,nbdim)
-      endif
-
-      Call Agrif_nbdim_deallocation(tempCextend%var,nbdim)
-C      Deallocate(tempCextend%var)
-
-      ENDIF
-
-#ifdef key_mpp_mpi
-      Call Agrif_nbdim_Get_bound_dimension(parent%var,
-     &                              lowerbound,upperbound,nbdim)
-
-      Call Agrif_ChildGrid_to_ParentGrid()
-C
-      Call Agrif_Childbounds(nbdim,
-     &                       lowerbound,upperbound,
-     &                       indminglob,indmaxglob,
-     &                       indminglob2,indmaxglob2,member)
-C
-      IF (member) THEN
-      Call Agrif_GlobtoLocInd2(parentarray,
-     &                     lowerbound,upperbound,
-     &                     indminglob2,indmaxglob2,
-     &                     nbdim,Agrif_Procrank,
-     &                     member)
-      ENDIF
-
-      Call Agrif_ParentGrid_to_ChildGrid()
-
-      if (.not.find_list_update) then
-      tab3(:,1) = indmin(:)
-      tab3(:,2) = indmax(:)
-      tab3(:,3) = indminglob2(:)
-      tab3(:,4) = indmaxglob2(:)
-C
-      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
-     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
-
-      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var)
-      DO k=0,Agrif_Nbprocs-1
-       do j=1,4
-         do i=1,nbdim
-         tab5t(i,k,j) = tab4(i,j,k)
-         enddo
-       enddo
-      enddo
- 
-      memberin1(1) = member
-      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2,
-     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
- 
-      Call Get_External_Data_first(tab5t(:,:,1),
-     &            tab5t(:,:,2),
-     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member,
-     &            memberinall2,sendtoproc2,recvfromproc2,tab5t(:,:,5),
-     & tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8))
-          
-      Call Agrif_Addto_list_update(child%var%list_update,pttab,petab,
-     &                          pttab_Child,pttab_Parent,nbdim
-     &   ,tab4t,tab5t,memberinall,memberinall2,
-     &   sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2) 
-          
-      endif
-      
-c      Call Get_External_Data(tempP,tempPextend,tab5t(:,:,1),
-c     &            tab5t(:,:,2),
-c     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member,
-c     &            memberinall2)
-     
-      Call ExchangeSameLevel2(sendtoproc2,recvfromproc2,nbdim,
-     &            tab5t(:,:,3),tab5t(:,:,4),tab5t(:,:,5),tab5t(:,:,6),
-     &            tab5t(:,:,7),tab5t(:,:,8),member,tempP,
-     &            tempPextend)     
-
-#else
-      tempPextend%var => tempP%var
-      parentarray(:,1,1) = indmin
-      parentarray(:,2,1) = indmax
-      parentarray(:,1,2) = indmin
-      parentarray(:,2,2) = indmax
-      member = .TRUE.
-#endif
-
-C
-C
-C
-C     Special values on the child grid
-      if (Agrif_UseSpecialValueFineGrid) then
-C
-ccc         noraftab(1:nbdim) =
-ccc     &    child % var % root_var % interptab(1:nbdim) .EQ. 'N'
-C
-#ifdef key_mpp_mpi
-C
-c          Allocate(childvalues% var)
-C
-c          Call Agrif_nbdim_allocation(childvalues%var,
-c     &                      pttruetab,cetruetab,nbdim)
-c          Call Agrif_nbdim_Full_VarEQvar(childvalues% var,
-c     &                                tempC% var,
-c     &                                nbdim)
-c          Call Agrif_CheckMasknD(tempC,childvalues,
-c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
-c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
-c     &                           noraftab(1:nbdim),nbdim)
-c          Call Agrif_nbdim_deallocation(childvalues% var,nbdim)
-c         Deallocate(childvalues % var)
-C
-#else
-C
-c          Call Agrif_nbdim_Get_bound_dimension(child%var,
-c     &                              lowerbound,upperbound,nbdim)
-c          Call Agrif_CheckMasknD(tempC,child,
-c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
-c     &                           lowerbound,
-c     &                           upperbound,
-c     &                           noraftab(1:nbdim),nbdim)
-C
-#endif
-C
-      endif
-
-
-C
-C
-C
-C
-C     Special values on the parent grid
-      if (Agrif_UseSpecialValue) then
-C
-#ifdef key_mpp_mpi
-C
-c          Call GiveAgrif_SpecialValueToTab_mpi(parent%var,tempP%var,
-c     &                 parentarray,
-c     &                 indmin,indmax,
-c     &                 Agrif_SpecialValue,nbdim)
-C
-C
-#else
-C
-c          Call GiveAgrif_SpecialValueToTab(parent%var,tempP%var,
-c     &                  indmin,indmax,
-c     &                  Agrif_SpecialValue,nbdim)
-C
-#endif
-C
-C
-      endif   
-C
-C
-        IF (member) THEN
-
-          IF (present(procname)) THEN
-            CALL Agrif_ChildGrid_to_ParentGrid()
-            SELECT CASE(nbdim)
-            CASE(1)
-            CALL procname(
-     &      tempPextend%var%array1(
-     &                      parentarray(1,1,1):parentarray(1,2,1)),
-     &                      parentarray(1,1,2),parentarray(1,2,2),
-     &                                   .FALSE.,nbin,ndirin
-     &                      )
-            CASE(2)
-            CALL procname(
-     &      tempPextend%var%array2(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1)),
-     &                      parentarray(1,1,2),parentarray(1,2,2),
-     &                      parentarray(2,1,2),parentarray(2,2,2),
-     &                                   .FALSE.,nbin,ndirin
-     &                      )
-            CASE(3)
-            CALL procname(
-     &      tempPextend%var%array3(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1)),
-     &                      parentarray(1,1,2),parentarray(1,2,2),
-     &                      parentarray(2,1,2),parentarray(2,2,2),
-     &                      parentarray(3,1,2),parentarray(3,2,2),
-     &                                   .FALSE.,nbin,ndirin
-     &                      )
-            CASE(4)
-            CALL procname(
-     &      tempPextend%var%array4(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1),
-     &                      parentarray(4,1,1):parentarray(4,2,1)),
-     &                      parentarray(1,1,2),parentarray(1,2,2),
-     &                      parentarray(2,1,2),parentarray(2,2,2),
-     &                      parentarray(3,1,2),parentarray(3,2,2),
-     &                      parentarray(4,1,2),parentarray(4,2,2),
-     &                                   .FALSE.,nbin,ndirin
-     &                      )
-            CASE(5)
-            CALL procname(
-     &      tempPextend%var%array5(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1),
-     &                      parentarray(4,1,1):parentarray(4,2,1),
-     &                      parentarray(5,1,1):parentarray(5,2,1)),
-     &                      parentarray(1,1,2),parentarray(1,2,2),
-     &                      parentarray(2,1,2),parentarray(2,2,2),
-     &                      parentarray(3,1,2),parentarray(3,2,2),
-     &                      parentarray(4,1,2),parentarray(4,2,2),
-     &                      parentarray(5,1,2),parentarray(5,2,2),
-     &                                   .FALSE.,nbin,ndirin
-     &                      )
-            CASE(6)
-            CALL procname(
-     &      tempPextend%var%array6(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1),
-     &                      parentarray(4,1,1):parentarray(4,2,1),
-     &                      parentarray(5,1,1):parentarray(5,2,1),
-     &                      parentarray(6,1,1):parentarray(6,2,1)),
-     &                      parentarray(1,1,2),parentarray(1,2,2),
-     &                      parentarray(2,1,2),parentarray(2,2,2),
-     &                      parentarray(3,1,2),parentarray(3,2,2),
-     &                      parentarray(4,1,2),parentarray(4,2,2),
-     &                      parentarray(5,1,2),parentarray(5,2,2),
-     &                      parentarray(6,1,2),parentarray(6,2,2),
-     &                                   .FALSE.,nbin,ndirin
-     &                      )
-            END SELECT
-            CALL Agrif_ParentGrid_to_ChildGrid()
-          ELSE
-            SELECT CASE(nbdim)
-            CASE(1)
-            parent%var%array1(parentarray(1,1,2):parentarray(1,2,2)) =
-     &      tempPextend%var%array1(
-     &                      parentarray(1,1,1):parentarray(1,2,1))
-            CASE(2)
-            parent%var%array2(parentarray(1,1,2):parentarray(1,2,2),
-     &                      parentarray(2,1,2):parentarray(2,2,2)) =
-     &      tempPextend%var%array2(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1))
-            CASE(3)
-            parent%var%array3(parentarray(1,1,2):parentarray(1,2,2),
-     &                      parentarray(2,1,2):parentarray(2,2,2),
-     &                      parentarray(3,1,2):parentarray(3,2,2)) =
-     &      tempPextend%var%array3(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1))
-            CASE(4)
-            parent%var%array4(parentarray(1,1,2):parentarray(1,2,2),
-     &                      parentarray(2,1,2):parentarray(2,2,2),
-     &                      parentarray(3,1,2):parentarray(3,2,2),
-     &                      parentarray(4,1,2):parentarray(4,2,2)) =
-     &      tempPextend%var%array4(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1),
-     &                      parentarray(4,1,1):parentarray(4,2,1))
-            CASE(5)
-            parent%var%array5(parentarray(1,1,2):parentarray(1,2,2),
-     &                      parentarray(2,1,2):parentarray(2,2,2),
-     &                      parentarray(3,1,2):parentarray(3,2,2),
-     &                      parentarray(4,1,2):parentarray(4,2,2),
-     &                      parentarray(5,1,2):parentarray(5,2,2)) =
-     &      tempPextend%var%array5(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1),
-     &                      parentarray(4,1,1):parentarray(4,2,1),
-     &                      parentarray(5,1,1):parentarray(5,2,1))
-            CASE(6)
-            parent%var%array6(parentarray(1,1,2):parentarray(1,2,2),
-     &                      parentarray(2,1,2):parentarray(2,2,2),
-     &                      parentarray(3,1,2):parentarray(3,2,2),
-     &                      parentarray(4,1,2):parentarray(4,2,2),
-     &                      parentarray(5,1,2):parentarray(5,2,2),
-     &                      parentarray(6,1,2):parentarray(6,2,2)) =
-     &      tempPextend%var%array6(
-     &                      parentarray(1,1,1):parentarray(1,2,1),
-     &                      parentarray(2,1,1):parentarray(2,2,1),
-     &                      parentarray(3,1,1):parentarray(3,2,1),
-     &                      parentarray(4,1,1):parentarray(4,2,1),
-     &                      parentarray(5,1,1):parentarray(5,2,1),
-     &                      parentarray(6,1,1):parentarray(6,2,1))
-            END SELECT
-          ENDIF
-
-        Call Agrif_nbdim_deallocation(tempPextend%var,nbdim)
-       ENDIF
-C
-C
-C     Deallocations
-
-      IF (memberin) THEN
-#ifdef key_mpp_mpi
-      Call Agrif_nbdim_deallocation(tempP%var,nbdim)
-      Call Agrif_nbdim_deallocation(tempC%var,nbdim)
-!      Deallocate(tempC % var)
-#endif
-!      Deallocate(tempP % var)
-      ENDIF
-#ifdef key_mpp_mpi
-!      Deallocate(tempPextend%var)
-!      IF (.Not.memberin) Deallocate(tempCextend%var)
-#endif
-
-C
-C
-      End Subroutine Agrif_UpdatenD
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Prtbounds
-C     **************************************************************************
-C
-      Subroutine Agrif_Prtbounds(nbdim,indmin,indmax,s_Parent_temp,
-     &                              s_Child_temp,s_Child,ds_Child,
-     &                              s_Parent,ds_Parent,
-     &                              pttruetab,cetruetab,pttab_Child,
-     &                              pttab_Parent,
-     &                              posvartab_child,TypeUpdate,
-     &                              loctab_Child
-#ifdef key_mpp_mpi
-     &                 ,pttruetabwhole,cetruetabwhole
-#endif
-     &                 )
-C
-CCC   Description:
-CCC   Subroutine calculating the bounds of the parent grid to be updated
-CCC   by the child grid     
-C
-C
-C     Declarations:
-C
-      
-C
-#ifdef key_mpp_mpi
-cccccccccccccccccccccccccc#include "mpif.h"
-#endif
-C
-C     Arguments
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim) :: indmin,indmax
-      REAL,DIMENSION(nbdim) :: s_Parent_temp,s_child_temp
-      REAL,DIMENSION(nbdim) :: s_Child,ds_child
-      REAL,DIMENSION(nbdim) :: s_Parent,ds_Parent
-      INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
-      INTEGER,DIMENSION(nbdim) :: posvartab_child,TypeUpdate
-      INTEGER,DIMENSION(nbdim) :: loctab_Child
-      INTEGER,DIMENSION(nbdim) :: pttab_Child,pttab_Parent
-C
-C     Local variables
-      INTEGER :: i
-      REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax      
-#ifdef key_mpp_mpi
-      INTEGER,DIMENSION(nbdim)    :: pttruetabwhole,cetruetabwhole
-      REAL :: positionmin,positionmax
-      INTEGER :: imin,imax
-      INTEGER :: coeffraf
-#endif
-C
-C
-      do i = 1,nbdim
-C
-        dim_newmin(i) = s_Child(i) + (pttruetab(i) -
-     &                                pttab_Child(i)) * ds_Child(i)
-C
-        dim_newmax(i) = s_Child(i) + (cetruetab(i) - 
-     &                                pttab_Child(i)) * ds_Child(i)
-C     
-        indmin(i) = pttab_Parent(i) +
-     &        agrif_ceiling((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
-C
-        indmax(i) = pttab_Parent(i) +
-     &        agrif_int((dim_newmax(i)-s_Parent(i))/ds_Parent(i))
-C
-#ifdef key_mpp_mpi
-        positionmin = s_Parent(i) + (indmin(i)-
-     &                          pttab_Parent(i))*ds_Parent(i)
-        IF (loctab_Child(i) .NE. -3) THEN
-        IF (posvartab_child(i) == 1) THEN
-          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN
-          positionmin = positionmin - ds_Parent(i)/2.
-          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
-          positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
-          ENDIF
-        ELSE
-          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN
-        positionmin = positionmin - ds_Parent(i)/2.
-          ELSE
-          coeffraf = nint(ds_Parent(i)/ds_Child(i))
-          if (mod(coeffraf,2) == 1) then
-            positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
-          else
-            positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
-     &                                -ds_Child(i)/2.
-          endif
-        ENDIF
-        ENDIF
-        ENDIF
-        imin = pttab_Child(i) +
-     &        agrif_ceiling((positionmin-s_Child(i))/ds_Child(i))
-
-       positionmin = s_Child(i) + (imin -
-     &                             pttab_Child(i)) * ds_Child(i)
-
-        pttruetabwhole(i) = imin
-
-        positionmax = s_Parent(i) + (indmax(i)-
-     &                          pttab_Parent(i))*ds_Parent(i)
-        IF (loctab_Child(i) .NE. -3) THEN
-        IF (posvartab_child(i) == 1) THEN
-          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN
-        positionmax = positionmax  + ds_Parent(i)/2.
-          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
-          positionmax = positionmax  + (ds_Parent(i)-ds_Child(i))
-          ENDIF
-        ELSE
-          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN        
-        positionmax = positionmax  + ds_Parent(i)/2.
-          ELSE
-          coeffraf = nint(ds_Parent(i)/ds_Child(i))
-          if (mod(coeffraf,2) == 1) then
-            positionmax = positionmax + (ds_Parent(i)-ds_Child(i))
-          else
-            positionmax = positionmax + (ds_Parent(i)-ds_Child(i)) 
-     &                                + ds_Child(i)/2.
-          endif
-
-        ENDIF        
-        ENDIF
-        ENDIF
-        imax = pttab_Child(i) +
-     &        agrif_int((positionmax-s_Child(i))/ds_Child(i))
-
-        positionmax = s_Child(i) + (imax -
-     &                                pttab_Child(i)) * ds_Child(i)
-
-        cetruetabwhole(i) = imax
-
-#endif
-C
-        s_Parent_temp(i) = s_Parent(i) + 
-     &                     (indmin(i) - pttab_Parent(i)) * 
-     &                      ds_Parent(i) 
-C     
-        s_Child_temp(i) = dim_newmin(i)
-
-#ifdef key_mpp_mpi
-        s_Child_temp(i) = positionmin
-#endif
-C
-      enddo
-C
-      Return
-C
-C
-      End Subroutine Agrif_Prtbounds
-C
-C
-C
-C
-
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_Update_2D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Update_2D_recursive(TypeUpdate,tempP,tempC,
-     &                                     indmin,indmax,
-     &                                     pttab_child,petab_child,
-     &                                     s_child,s_parent,
-     &                                     ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine to update a 2D grid variable on the parent grid. 
-CCC   It calls Agrif_Update_1D_Recursive and Agrif_UpdateBase.   
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER                   :: nbdim
-      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim)    :: s_child,s_parent
-      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                indmin(2):indmax(2))           :: tempP
-C      REAL, DIMENSION(pttab_child(1):petab_child(1),
-C     &                pttab_child(2):petab_child(2)) :: tempC
-     
-      REAL, DIMENSION(:,:) :: tempC     
-C
-C     Local variables      
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                 pttab_child(2):petab_child(2)) :: tabtemp
-      REAL, DIMENSION(indmin(2):indmax(2),
-     &                indmin(1):indmax(1))           :: tempP_trsp
-      REAL, DIMENSION(pttab_child(2):petab_child(2),
-     &                 indmin(1):indmax(1)) :: tabtemp_trsp
-      INTEGER :: i,j
-      INTEGER :: coeffraf,locind_child_left
-C
-      tabtemp = 0.
-
-
-      coeffraf = nint ( ds_parent(1) / ds_child(1) ) 
-      IF((TypeUpdate(1) == AGRIF_Update_average) 
-     &                 .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         IF(.NOT. precomputedone(1) ) Call average1Dprecompute2D
-     &       (petab_child(2)-pttab_child(2)+1,
-     &        indmax(1)-indmin(1)+1,
-     &        petab_child(1)-pttab_child(1)+1,
-     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-!---CDIR NEXPAND
-          Call average1Daftercompute
-     &       (  tabtemp, tempC,
-     &          size(tabtemp), size(tempC),
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
- 
-      ELSEIF((TypeUpdate(1) == AGRIF_Update_copy)
-     &                 .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         IF(.NOT. precomputedone(1) ) Call copy1Dprecompute2D
-     &       (petab_child(2)-pttab_child(2)+1,
-     &        indmax(1)-indmin(1)+1,
-     &        petab_child(1)-pttab_child(1)+1,
-     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-!---CDIR NEXPAND
-          Call copy1Daftercompute
-     &       (  tabtemp, tempC,
-     &          size(tabtemp), size(tempC),
-     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-
-      ELSE
-      do j = pttab_child(nbdim),petab_child(nbdim)
-C
-!---CDIR NEXPAND
-        Call Agrif_Update_1D_recursive(TypeUpdate(1:nbdim-1),    
-     &         tabtemp(:,j),
-     &         tempC(:,j-pttab_child(nbdim)+1),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C
-      enddo
-      ENDIF
-      tabtemp_trsp = TRANSPOSE(tabtemp) 
-      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
-    
-!---CDIR NEXPAND
-      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-C
-      
-      tempP_trsp = 0. 
-
-      IF((TypeUpdate(2) == AGRIF_Update_average)
-     &                .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         IF(.NOT. precomputedone(2) ) Call average1Dprecompute2D
-     &      ( indmax(1)-indmin(1)+1,
-     &        indmax(2)-indmin(2)+1,
-     &        petab_child(2)-pttab_child(2)+1,
-     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-!---CDIR NEXPAND
-          Call average1Daftercompute
-     &       (  tempP_trsp, tabtemp_trsp,
-     &          size(tempP_trsp), size(tabtemp_trsp),
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-
-      ELSEIF((TypeUpdate(2) == AGRIF_Update_copy)
-     &                .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         IF(.NOT. precomputedone(2) ) Call copy1Dprecompute2D
-     &      ( indmax(1)-indmin(1)+1,
-     &        indmax(2)-indmin(2)+1,
-     &        petab_child(2)-pttab_child(2)+1,
-     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-!---CDIR NEXPAND
-          Call copy1Daftercompute
-     &       (  tempP_trsp, tabtemp_trsp,
-     &          size(tempP_trsp), size(tabtemp_trsp),
-     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-
-      ELSE
-
-      do i = indmin(1),indmax(1)
-C
-!---CDIR NEXPAND
-        Call Agrif_UpdateBase(TypeUpdate(2),
-     &           tempP_trsp(indmin(nbdim):indmax(nbdim),i),
-     &          tabtemp_trsp(pttab_child(nbdim):petab_child(nbdim),i),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),
-     &                  coeffraf,locind_child_left)
-C        
-      enddo
-      
-      ENDIF
-
-      tempP = TRANSPOSE(tempP_trsp)
-C
-      Return
-C
-C
-      End Subroutine Agrif_Update_2D_recursive
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_Update_3D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Update_3D_recursive(TypeUpdate,tempP,tempC,
-     &                                     indmin,indmax,   
-     &                                     pttab_child,petab_child,
-     &                                     s_child,s_parent,
-     &                                     ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine to update a 3D grid variable on the parent grid. 
-CCC   It calls Agrif_Update_2D_Recursive and Agrif_UpdateBase.   
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER                   :: nbdim
-      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim)    :: s_child,s_parent
-      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                indmin(2):indmax(2),
-     &                indmin(3):indmax(3))           :: tempP
-      REAL, DIMENSION(pttab_child(1):petab_child(1),
-     &                pttab_child(2):petab_child(2),
-     &                pttab_child(3):petab_child(3)) :: tempC
-C
-C     Local variables      
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                 indmin(2):indmax(2), 
-     &                 pttab_child(3):petab_child(3)) :: tabtemp
-      INTEGER :: i,j,k
-      INTEGER :: coeffraf,locind_child_left
-      INTEGER :: kdeb
-C
-C
-      coeffraf = nint ( ds_parent(1) / ds_child(1) )
-      IF((TypeUpdate(1) == AGRIF_Update_average)
-     &                 .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         Call average1Dprecompute2D
-     &       (petab_child(2)-pttab_child(2)+1,
-     &        indmax(1)-indmin(1)+1,
-     &        petab_child(1)-pttab_child(1)+1,
-     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-      precomputedone(1) = .TRUE.
-      ELSEIF((TypeUpdate(1) == AGRIF_Update_copy)
-     &                 .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         Call copy1Dprecompute2D
-     &       (petab_child(2)-pttab_child(2)+1,
-     &        indmax(1)-indmin(1)+1,
-     &        petab_child(1)-pttab_child(1)+1,
-     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
-      precomputedone(1) = .TRUE.
-      ENDIF
-
-      coeffraf = nint ( ds_parent(2) / ds_child(2) )
-      IF((TypeUpdate(2) == AGRIF_Update_average)
-     &                .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         Call average1Dprecompute2D
-     &      ( indmax(1)-indmin(1)+1,
-     &        indmax(2)-indmin(2)+1,
-     &        petab_child(2)-pttab_child(2)+1,
-     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-      precomputedone(2) = .TRUE.
-      ELSEIF((TypeUpdate(2) == AGRIF_Update_copy)
-     &                .AND. (coeffraf /= 1 ))THEN
-!---CDIR NEXPAND
-         Call copy1Dprecompute2D
-     &      ( indmax(1)-indmin(1)+1,
-     &        indmax(2)-indmin(2)+1,
-     &        petab_child(2)-pttab_child(2)+1,
-     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
-      precomputedone(2) = .TRUE.
-      ENDIF
-
-
-      do k = pttab_child(nbdim),petab_child(nbdim)
-C
-        Call Agrif_Update_2D_recursive(TypeUpdate(1:nbdim-1),    
-     &         tabtemp(:,:,k),
-     &         tempC(:,:,k),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C
-      enddo
-C
-      precomputedone(1) = .FALSE.
-      precomputedone(2) = .FALSE.
-      coeffraf = nint ( ds_parent(3) / ds_child(3) )
-
-      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-      
-      IF (coeffraf == 1) THEN
-      
-      kdeb = pttab_child(3)+locind_child_left-2
-      do k=indmin(3),indmax(3)
-      kdeb = kdeb + 1
-      do j = indmin(2),indmax(2)
-        do i = indmin(1),indmax(1)
-        tempP(i,j,k) = tabtemp(i,j,kdeb)
-      enddo
-      enddo
-      enddo
-              
-      ELSE
-      tempP = 0.
-C
-      do j = indmin(2),indmax(2)
-C
-        do i = indmin(1),indmax(1)
-C
-          Call Agrif_UpdateBase(TypeUpdate(3),
-     &           tempP(i,j,:),
-     &          tabtemp(i,j,:),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),
-     &                  coeffraf,locind_child_left)
-C
-        enddo 
-C        
-      enddo
-      ENDIF
-C
-      Return
-C
-C
-      End Subroutine Agrif_Update_3D_recursive
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_Update_4D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Update_4D_recursive(TypeUpdate,tempP,tempC,
-     &                                     indmin,indmax,   
-     &                                     pttab_child,petab_child,
-     &                                     s_child,s_parent,
-     &                                     ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine to update a 4D grid variable on the parent grid. 
-CCC   It calls Agrif_Update_3D_Recursive and Agrif_UpdateBase.    
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER                   :: nbdim
-      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim)    :: s_child,s_parent
-      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                indmin(2):indmax(2),
-     &                indmin(3):indmax(3),
-     &                indmin(4):indmax(4))           :: tempP
-      REAL, DIMENSION(pttab_child(1):petab_child(1),
-     &                pttab_child(2):petab_child(2),
-     &                pttab_child(3):petab_child(3),
-     &                pttab_child(4):petab_child(4)) :: tempC
-C
-C     Local variables      
-      REAL, DIMENSION(:,:,:,:), Allocatable :: tabtemp
-      INTEGER :: i,j,k,l
-      INTEGER :: coeffraf,locind_child_left
-C
-C
-      Allocate(tabtemp(indmin(1):indmax(1),
-     &                 indmin(2):indmax(2),
-     &                 indmin(3):indmax(3), 
-     &                 pttab_child(4):petab_child(4)))
-C
-      do l = pttab_child(nbdim),petab_child(nbdim)
-C
-        Call Agrif_Update_3D_recursive(TypeUpdate(1:nbdim-1),    
-     &         tabtemp(indmin(nbdim-3):indmax(nbdim-3),
-     &                 indmin(nbdim-2):indmax(nbdim-2),
-     &                 indmin(nbdim-1):indmax(nbdim-1),l),
-     &         tempC(pttab_child(nbdim-3):petab_child(nbdim-3),
-     &               pttab_child(nbdim-2):petab_child(nbdim-2),
-     &               pttab_child(nbdim-1):petab_child(nbdim-1),l),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C
-      enddo
-      
-      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-C
-      tempP = 0.
-
-      do k = indmin(3),indmax(3)
-C
-        do j = indmin(2),indmax(2)
-C
-          do i = indmin(1),indmax(1)
-C
-            Call Agrif_UpdateBase(TypeUpdate(4),
-     &           tempP(i,j,k,indmin(nbdim):indmax(nbdim)),
-     &          tabtemp(i,j,k,pttab_child(nbdim):petab_child(nbdim)),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),
-     &                  coeffraf,locind_child_left)
-C
-          enddo 
-C
-        enddo 
-C        
-      enddo
-C
-      Deallocate(tabtemp)
-C
-      Return
-C
-C
-      End Subroutine Agrif_Update_4D_recursive
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_Update_5D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Update_5D_recursive(TypeUpdate,tempP,tempC,
-     &                                     indmin,indmax,   
-     &                                     pttab_child,petab_child,
-     &                                     s_child,s_parent,
-     &                                     ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine to update a 5D grid variable on the parent grid. 
-CCC   It calls Agrif_Update_4D_Recursive and Agrif_UpdateBase.    
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER                   :: nbdim
-      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim)    :: s_child,s_parent
-      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                indmin(2):indmax(2),
-     &                indmin(3):indmax(3),
-     &                indmin(4):indmax(4),
-     &                indmin(5):indmax(5))           :: tempP
-      REAL, DIMENSION(pttab_child(1):petab_child(1),
-     &                pttab_child(2):petab_child(2),
-     &                pttab_child(3):petab_child(3),
-     &                pttab_child(4):petab_child(4),
-     &                pttab_child(5):petab_child(5)) :: tempC
-C
-C     Local variables      
-      REAL, DIMENSION(:,:,:,:,:), Allocatable :: tabtemp
-      INTEGER :: i,j,k,l,m
-      INTEGER :: coeffraf,locind_child_left
-C
-C
-      Allocate(tabtemp(indmin(1):indmax(1),
-     &                 indmin(2):indmax(2),
-     &                 indmin(3):indmax(3),
-     &                 indmin(4):indmax(4),   
-     &                 pttab_child(5):petab_child(5)))
-C
-      do m = pttab_child(nbdim),petab_child(nbdim)
-C
-        Call Agrif_Update_4D_recursive(TypeUpdate(1:nbdim-1),    
-     &         tabtemp(indmin(nbdim-4):indmax(nbdim-4),
-     &                 indmin(nbdim-3):indmax(nbdim-3),
-     &                 indmin(nbdim-2):indmax(nbdim-2),
-     &                 indmin(nbdim-1):indmax(nbdim-1),m),
-     &         tempC(pttab_child(nbdim-4):petab_child(nbdim-4),
-     &               pttab_child(nbdim-3):petab_child(nbdim-3),
-     &               pttab_child(nbdim-2):petab_child(nbdim-2),
-     &               pttab_child(nbdim-1):petab_child(nbdim-1),m),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C
-      enddo
-      
-      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-      tempP = 0.
-C
-      do l = indmin(4),indmax(4)
-C
-        do k = indmin(3),indmax(3)
-C
-          do j = indmin(2),indmax(2)
-C
-            do i = indmin(1),indmax(1)
-C
-              Call Agrif_UpdateBase(TypeUpdate(5),
-     &           tempP(i,j,k,l,indmin(nbdim):indmax(nbdim)),
-     &          tabtemp(i,j,k,l,
-     &                   pttab_child(nbdim):petab_child(nbdim)),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),
-     &                  coeffraf,locind_child_left)
-C
-            enddo
-C
-          enddo 
-C
-        enddo 
-C        
-      enddo
-C
-      Deallocate(tabtemp)
-C
-      Return
-C
-C
-      End Subroutine Agrif_Update_5D_recursive
-C
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_Update_6D_Recursive 
-C     **************************************************************************
-C
-      Subroutine Agrif_Update_6D_recursive(TypeUpdate,tempP,tempC,
-     &                                     indmin,indmax,   
-     &                                     pttab_child,petab_child,
-     &                                     s_child,s_parent,
-     &                                     ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine to update a 6D grid variable on the parent grid. 
-CCC   It calls Agrif_Update_5D_Recursive and Agrif_UpdateBase.    
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C     
-      INTEGER                   :: nbdim
-      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim)    :: s_child,s_parent
-      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
-      REAL, DIMENSION(indmin(1):indmax(1),
-     &                indmin(2):indmax(2),
-     &                indmin(3):indmax(3),
-     &                indmin(4):indmax(4),
-     &                indmin(5):indmax(5),
-     &                indmin(6):indmax(6))           :: tempP
-      REAL, DIMENSION(pttab_child(1):petab_child(1),
-     &                pttab_child(2):petab_child(2),
-     &                pttab_child(3):petab_child(3),
-     &                pttab_child(4):petab_child(4),
-     &                pttab_child(5):petab_child(5),
-     &                pttab_child(6):petab_child(6)) :: tempC
-C
-C     Local variables      
-      REAL, DIMENSION(:,:,:,:,:,:), Allocatable :: tabtemp
-      INTEGER :: i,j,k,l,m,n
-      INTEGER :: coeffraf,locind_child_left
-C
-C
-      Allocate(tabtemp(indmin(1):indmax(1),
-     &                 indmin(2):indmax(2),
-     &                 indmin(3):indmax(3),
-     &                 indmin(4):indmax(4),   
-     &                 indmin(5):indmax(5),   
-     &                 pttab_child(6):petab_child(6)))
-C
-      do n = pttab_child(nbdim),petab_child(nbdim)
-C
-        Call Agrif_Update_5D_recursive(TypeUpdate(1:nbdim-1),    
-     &         tabtemp(indmin(nbdim-5):indmax(nbdim-5),
-     &                 indmin(nbdim-4):indmax(nbdim-4),
-     &                 indmin(nbdim-3):indmax(nbdim-3),
-     &                 indmin(nbdim-2):indmax(nbdim-2),
-     &                 indmin(nbdim-1):indmax(nbdim-1),n),
-     &         tempC(pttab_child(nbdim-5):petab_child(nbdim-5),
-     &               pttab_child(nbdim-4):petab_child(nbdim-4),
-     &               pttab_child(nbdim-3):petab_child(nbdim-3),
-     &               pttab_child(nbdim-2):petab_child(nbdim-2),
-     &               pttab_child(nbdim-1):petab_child(nbdim-1),n),
-     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
-     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
-     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
-     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
-C
-      enddo
-      
-      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-C
-      tempP = 0.
-
-      do m = indmin(5),indmax(5)
-      do l = indmin(4),indmax(4)
-C
-        do k = indmin(3),indmax(3)
-C
-          do j = indmin(2),indmax(2)
-C
-            do i = indmin(1),indmax(1)
-C
-              Call Agrif_UpdateBase(TypeUpdate(6),
-     &           tempP(i,j,k,l,m,indmin(nbdim):indmax(nbdim)),
-     &          tabtemp(i,j,k,l,m,
-     &                   pttab_child(nbdim):petab_child(nbdim)),
-     &           indmin(nbdim),indmax(nbdim),
-     &           pttab_child(nbdim),petab_child(nbdim),
-     &           s_parent(nbdim),s_child(nbdim),
-     &           ds_parent(nbdim),ds_child(nbdim),
-     &                  coeffraf,locind_child_left)
-C
-            enddo
-C
-          enddo 
-C
-        enddo 
-C        
-      enddo
-      enddo
-C
-      Deallocate(tabtemp)
-C
-      Return
-C
-C
-      End Subroutine Agrif_Update_6D_recursive
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Agrif_UpdateBase  
-C     **************************************************************************  
-C  
-      Subroutine Agrif_UpdateBase(TypeUpdate,
-     &                            parenttab,childtab,
-     &                            indmin,indmax,pttab_child,petab_child,
-     &                            s_parent,s_child,ds_parent,ds_child,
-     &                            coeffraf,locind_child_left)
-C
-CCC   Description:
-CCC   Subroutine calling the updating method chosen by the user (copy, average
-CCC   or full-weighting).    
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C
-      INTEGER :: TypeUpdate
-      INTEGER :: indmin,indmax
-      INTEGER :: pttab_child,petab_child
-      REAL,DIMENSION(indmin:indmax)           :: parenttab       
-      REAL,DIMENSION(pttab_child:petab_child) :: childtab      
-      REAL    :: s_parent,s_child
-      REAL    :: ds_parent,ds_child      
-      INTEGER :: coeffraf,locind_child_left
-C
-C
-      if (TypeUpdate == AGRIF_Update_copy) then
-C             
-          Call agrif_copy1D
-     &       (parenttab,childtab,
-     &          indmax-indmin+1,petab_child-pttab_child+1,
-     &          s_parent,s_child,ds_parent,ds_child)     
-C
-        elseif (TypeUpdate == AGRIF_Update_average) then
-C           
-          Call average1D
-     &       (parenttab,childtab,
-     &          indmax-indmin+1,petab_child-pttab_child+1,
-     &          s_parent,s_child,ds_parent,ds_child) 
-C
-        elseif (TypeUpdate == AGRIF_Update_full_weighting) then
-C             
-          Call full_weighting1D
-     &       (parenttab,childtab,
-     &          indmax-indmin+1,petab_child-pttab_child+1,
-     &          s_parent,s_child,ds_parent,ds_child,
-     &          coeffraf,locind_child_left)
-C
-      endif 
-C
-      Return                
-C
-C      
-      End Subroutine Agrif_UpdateBase
-C
-C
-
-      Subroutine Agrif_Compute_nbdim_update(s_parent,s_child,
-     &  ds_parent,ds_child,coeffraf,locind_child_left)
-      real :: s_parent,s_child,ds_parent,ds_child
-      integer :: coeffraf,locind_child_left
-     
-      coeffraf = nint(ds_parent/ds_child)
-      locind_child_left = 1 + agrif_int((s_parent-s_child)/ds_child)
-      
-      End Subroutine Agrif_Compute_nbdim_update
- 
-#if defined key_mpp_mpi      
-      Subroutine Agrif_Find_list_update(list_update,pttab,petab,
-     &                          pttab_Child,pttab_Parent,nbdim,
-     &     find_list_update,tab4t,tab5t,memberinall,memberinall2,
-     &     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)     
-      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
-      LOGICAL :: find_list_update
-      Type(Agrif_List_Interp_loc), Pointer :: parcours
-      INTEGER :: i
-C
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall,memberinall2
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1      
-      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2      
-                    
-      find_list_update = .FALSE.
-      
-      parcours => list_update
-      
-      Find_loop :   Do While (associated(parcours))
-        Do i=1,nbdim
-          IF ((pttab(i) /= parcours%interp_loc%pttab(i)).OR.
-     &        (petab(i) /= parcours%interp_loc%petab(i)).OR.
-     &        (pttab_child(i) /= parcours%interp_loc%pttab_child(i)).OR.
-     &        (pttab_parent(i) /= parcours%interp_loc%pttab_parent(i)))
-     &               THEN
-            parcours=>parcours%suiv
-            Cycle Find_loop
-          ENDIF
-        EndDo
-        
-        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
-        memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
-        
-        tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
-        memberinall2 = 
-     &       parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1)
-        sendtoproc1 = 
-     &       parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)   
-        recvfromproc1 = 
-     &       parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)     
-        sendtoproc2 = 
-     &       parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1)   
-        recvfromproc2 = 
-     &       parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1)          
-        
-        find_list_update = .TRUE.   
-        Exit Find_loop
-      End Do Find_loop  
-                              
-      End Subroutine Agrif_Find_list_update  
-      
-      Subroutine Agrif_AddTo_list_update(list_update,pttab,petab,
-     &                          pttab_Child,pttab_Parent,nbdim
-     &      ,tab4t,tab5t,memberinall,memberinall2,
-     &      sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
-          
-      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update
-      INTEGER :: nbdim
-      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
-      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1, recvfromproc1      
-      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2, recvfromproc2
-
-      Type(Agrif_List_Interp_loc), Pointer :: parcours
-            
-       Allocate(parcours)
-      Allocate(parcours%interp_loc)
-      
-      parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
-      parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
-      parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim)
-      parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
-      Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
-      Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1))
-      
-      Allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,8))
-      Allocate(parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1))
-      Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
-      Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))      
-      Allocate(parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1))
-      Allocate(parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1))            
-            
-      parcours%interp_loc%tab4t=tab4t   
-      parcours%interp_loc%memberinall=memberinall
- 
-      parcours%interp_loc%tab5t=tab5t   
-      parcours%interp_loc%memberinall2=memberinall2
-      parcours%interp_loc%sendtoproc1=sendtoproc1   
-      parcours%interp_loc%recvfromproc1=recvfromproc1      
-      parcours%interp_loc%sendtoproc2=sendtoproc2       
-      parcours%interp_loc%recvfromproc2=recvfromproc2      
-            
-      parcours%suiv => list_update
-      
-      list_update => parcours
-      
-      End Subroutine Agrif_Addto_list_update
-#endif
-           
-
-C     **************************************************************************
-CCC   Subroutine Agrif_Update_1D_Recursive
-C     **************************************************************************
-C
-      Subroutine Agrif_Update_1D_recursive(TypeUpdate,tempP,tempC,
-     &                                     indmin,indmax,
-     &                                     pttab_child,petab_child,
-     &                                     s_child,s_parent,
-     &                                     ds_child,ds_parent,nbdim)
-C
-CCC   Description:
-CCC   Subroutine to update a 1D grid variable on the parent grid.
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C
-C     Arguments
-      INTEGER                   :: nbdim
-      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
-      INTEGER, DIMENSION(nbdim) :: indmin,indmax
-      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
-      REAL, DIMENSION(nbdim)    :: s_child,s_parent
-      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
-      REAL, DIMENSION(indmin(nbdim):indmax(nbdim))           :: tempP
-      REAL, DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tempC
-      INTEGER :: coeffraf,locind_child_left
-C
-C
-      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
-     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
-      
-      Call Agrif_UpdateBase(TypeUpdate(1),
-     &                  tempP(indmin(nbdim):indmax(nbdim)),
-     &                  tempC(pttab_child(nbdim):petab_child(nbdim)),
-     &                  indmin(nbdim),indmax(nbdim),           
-     &                  pttab_child(nbdim),petab_child(nbdim),
-     &                  s_parent(nbdim),s_child(nbdim),
-     &                  ds_parent(nbdim),ds_child(nbdim),
-     &                  coeffraf,locind_child_left)
-
-C
-      Return
-C
-C
-      End Subroutine Agrif_Update_1D_recursive      
-
-      End Module Agrif_Update
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90	(revision 5682)
@@ -0,0 +1,2130 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!> Module Agrif_Update
+!>
+!> This module  contains procedures to update a parent grid from its child grids.
+!
+module Agrif_Update
+!
+    use Agrif_UpdateBasic
+    use Agrif_Arrays
+    use Agrif_CurgridFunctions
+    use Agrif_Mask
+#if defined AGRIF_MPI
+    use Agrif_Mpp
+#endif
+!
+    implicit none
+!
+    logical, private :: precomputedone(7) = .FALSE.
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_UpdateVariable
+!
+!> subroutine to set arguments for Agrif_UpdatenD
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdateVariable ( parent, child, updateinf, updatesup, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),  pointer      :: parent       !< Variable on the parent grid
+    type(Agrif_Variable),  pointer      :: child        !< Variable on the child grid
+    integer, dimension(6), intent(in)   :: updateinf    !< First positions where interpolations are calculated
+    integer, dimension(6), intent(in)   :: updatesup    !< Last  positions where interpolations are calculated
+    procedure()                         :: procname     !< Data recovery procedure
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(6) :: nb_child           ! Number of cells on the child grid
+    integer, dimension(6) :: lb_child
+    integer, dimension(6) :: ub_child
+    integer, dimension(6) :: lb_parent
+    real   , dimension(6) ::  s_child           ! Child  grid position (s_root = 0)
+    real   , dimension(6) ::  s_parent          ! Parent grid position (s_root = 0)
+    real   , dimension(6) :: ds_child           ! Child  grid dx (ds_root = 1)
+    real   , dimension(6) :: ds_parent          ! Parent grid dx (ds_root = 1)
+    logical, dimension(6) :: do_update          ! Indicates if we perform update for each dimension
+    integer, dimension(6) :: posvar             ! Position of the variable on the cell (1 or 2)
+    integer, dimension(6) :: oldparentlbound, oldparentubound
+    integer               :: n, nbdim
+    logical               :: wholeupdate
+    type(Agrif_Variable), pointer :: root   ! Variable on the root grid
+!
+    root => child % root_var
+    nbdim = root % nbdim
+!
+    call PreProcessToInterpOrUpdate( parent,   child,       &
+                                     nb_child, ub_child,    &
+                                     lb_child, lb_parent,   &
+                                      s_child,  s_parent,   &
+                                     ds_child, ds_parent, nbdim, interp=.false. )
+!
+    do_update(:) = .true.
+    posvar(1:nbdim) = root % posvar(1:nbdim)
+!
+    do n = 1,nbdim
+!
+        if ( root % interptab(n) == 'N' ) then
+            posvar(n) = 1
+            do_update(n) = .false.
+            oldparentlbound(n) = parent % lb(n)
+            oldparentubound(n) = parent % ub(n)
+            parent % lb(n) = child % lb(n)
+            parent % ub(n) = child % ub(n)
+        end if
+!
+    enddo
+
+    wholeupdate = .FALSE.
+!
+    do n = 1,nbdim
+        if ( do_update(n) ) then
+            if ( (updateinf(n) > updatesup(n)) .OR. &
+                ((updateinf(n) == -99) .AND. (updatesup(n) == -99)) &
+               ) then
+                wholeupdate = .TRUE.
+            endif
+        endif
+    enddo
+!
+    IF (wholeupdate) THEN
+        call Agrif_UpdateWhole(parent, child,               &
+                updateinf(1:nbdim), updatesup(1:nbdim),     &
+                lb_child(1:nbdim), lb_parent(1:nbdim),      &
+                nb_child(1:nbdim), posvar(1:nbdim),         &
+                do_update(1:nbdim),                         &
+                s_child(1:nbdim),   s_parent(1:nbdim),      &
+                ds_child(1:nbdim), ds_parent(1:nbdim), nbdim, procname)
+    ELSE
+        call Agrif_UpdateBcnD(parent, child,                &
+                updateinf(1:nbdim), updatesup(1:nbdim),     &
+                lb_child(1:nbdim), lb_parent(1:nbdim),      &
+                nb_child(1:nbdim), posvar(1:nbdim),         &
+                do_update(1:nbdim),                         &
+                s_child(1:nbdim),   s_parent(1:nbdim),      &
+                ds_child(1:nbdim), ds_parent(1:nbdim), nbdim, procname)
+    ENDIF
+!
+    do n = 1,nbdim
+!
+        if ( root % interptab(n) == 'N' ) then  ! No space DIMENSION
+            parent % lb(n) = oldparentlbound(n)
+            parent % ub(n) = oldparentubound(n)
+        end if
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdateVariable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_UpdateWhole
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdateWhole ( parent, child, uinf, usup,       &
+                               lb_child, lb_parent,             &
+                               nb_child, posvar,                &
+                               do_update,                       &
+                               s_child,   s_parent,             &
+                               ds_child, ds_parent, nbdim, procname )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    type(Agrif_Variable),      pointer    :: parent         !< Variable on the parent grid
+    type(Agrif_Variable),      pointer    :: child          !< Variable on the child grid
+    integer, dimension(nbdim), intent(in) :: uinf           !< First positions where interpolations are calculated
+    integer, dimension(nbdim), intent(in) :: usup           !< Last  positions where interpolations are calculated
+    integer,                   intent(in) :: nbdim          !< Number of dimensions of the grid variable
+    integer, dimension(nbdim), intent(in) :: lb_child       !< Index of the first point inside the domain for the parent grid variable
+    integer, dimension(nbdim), intent(in) :: lb_parent      !< Index of the first point inside the domain for the child grid variable
+    integer, dimension(nbdim), intent(in) :: nb_child       !< Number of cells of the child grid
+    integer, dimension(nbdim), intent(in) :: posvar         !< Position of the variable on the cell (1 or 2)
+    logical, dimension(nbdim), intent(in) :: do_update      !< Indicates if we update for each dimension
+    real,    dimension(nbdim), intent(in) :: s_child        !< Positions of the child grid
+    real,    dimension(nbdim), intent(in) :: s_parent       !< Positions of the parent grid
+    real,    dimension(nbdim), intent(in) :: ds_child       !< Space steps of the child grid
+    real,    dimension(nbdim), intent(in) :: ds_parent      !< Space steps of the parent grid
+    procedure()                           :: procname       !< Data recovery procedure
+!
+    integer, dimension(nbdim)     :: type_update ! Type of update (copy or average)
+    integer, dimension(nbdim,2)   :: lubglob
+    integer, dimension(nbdim,2,2) :: indtab      ! limits of the child grid that will be used in the update scheme
+    integer, dimension(nbdim,2,2) :: indtruetab  ! grid variable where boundary conditions are
+    integer :: coeffraf, i
+    integer :: uinfloc, usuploc
+!
+    type_update = child % root_var % type_update(1:nbdim)
+!
+    do i = 1, nbdim
+!
+        if ( do_update(i) ) then
+!
+            coeffraf = nint(ds_parent(i)/ds_child(i))
+            uinfloc = 0
+            usuploc = nb_child(i)/coeffraf - 1
+
+            IF (posvar(i) == 1) THEN
+                usuploc = usuploc - 1
+            ENDIF
+
+            IF (uinf(i) > usup(i)) THEN
+                uinfloc = uinf(i)
+                usuploc = usuploc - uinf(i)
+            ENDIF
+
+            indtab(i,1,1) = lb_child(i) + (uinfloc + 1) * coeffraf
+            indtab(i,1,2) = lb_child(i) + (usuploc + 1) * coeffraf
+
+            IF ( posvar(i) == 1 ) THEN
+                IF ( type_update(i) == Agrif_Update_Full_Weighting ) THEN
+                    indtab(i,1,1) = indtab(i,1,1) - (coeffraf - 1)
+                    indtab(i,1,2) = indtab(i,1,2) + (coeffraf - 1)
+                ELSE IF ( type_update(i) /= Agrif_Update_Copy ) THEN
+                    indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
+                    indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
+                ENDIF
+            ELSE
+                indtab(i,1,1) = indtab(i,1,1) - coeffraf
+                indtab(i,1,2) = indtab(i,1,2) - 1
+    ! at this point, indices are OK for an average
+                IF ( type_update(i) == Agrif_Update_Full_Weighting ) THEN
+                    indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
+                    indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
+                ENDIF
+            ENDIF
+!
+        else    ! IF ( .not.do_update(i) ) THEN
+!
+            if ( posvar(i) == 1 ) then
+                indtab(i,1,1) = lb_child(i)
+                indtab(i,1,2) = lb_child(i) + nb_child(i)
+            else
+                indtab(i,1,1) = lb_child(i)
+                indtab(i,1,2) = lb_child(i) + nb_child(i) - 1
+            endif
+!
+        endif
+    enddo
+
+! lubglob contains the global lbound and ubound of the child array
+! lubglob(:,1) : global lbound for each dimension
+! lubglob(:,2) : global lbound for each dimension
+!
+    call Agrif_get_var_global_bounds(child, lubglob, nbdim)
+!
+    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,1,2) = min(indtab(1:nbdim,1,2), lubglob(1:nbdim,2))
+!
+    call Agrif_UpdatenD(type_update, parent, child,                         &
+                        indtruetab(1:nbdim,1,1), indtruetab(1:nbdim,1,2),   &
+                        lb_child(1:nbdim), lb_parent(1:nbdim),              &
+                        s_child(1:nbdim), s_parent(1:nbdim),                &
+                        ds_child(1:nbdim), ds_parent(1:nbdim),              &
+#if defined AGRIF_MPI
+                        posvar, do_update,                                  &
+#endif
+                        nbdim, procname)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdateWhole
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_UpdateBcnd
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdateBcnd ( parent, child, uinf, usup,        &
+                              lb_child, lb_parent,              &
+                              nb_child, posvar,                 &
+                              do_update,                        &
+                              s_child,  s_parent,               &
+                              ds_child, ds_parent, nbdim, procname )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    type(Agrif_Variable), pointer           :: parent       !< Variable on the parent grid
+    type(Agrif_Variable), pointer           :: child        !< Variable on the child grid
+    integer, dimension(nbdim), intent(in)   :: uinf         !< First positions where interpolations are calculated
+    integer, dimension(nbdim), intent(in)   :: usup         !< Last  positions where interpolations are calculated
+    integer                                 :: nbdim        !< Number of dimensions of the grid variable
+    integer, dimension(nbdim), intent(in)   :: lb_child     !< Index of the first point inside the domain for
+                                                            !!   the parent grid variable
+    integer, dimension(nbdim), intent(in)   :: lb_parent    !< Index of the first point inside the domain for
+                                                            !!   the child grid variable
+    integer, dimension(nbdim), intent(in)   :: nb_child     !< Number of cells of the child grid
+    integer, dimension(nbdim), intent(in)   :: posvar       !< Position of the variable on the cell (1 or 2)
+    logical, dimension(nbdim), intent(in)   :: do_update    !< Indicates if we update for each dimension
+    real,    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid
+    real,    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid
+    real,    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid
+    real,    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid
+    procedure()                             :: procname     !< Data recovery procedure
+!
+    integer,dimension(nbdim)     :: type_update ! Type of update (copy or average)
+    integer,dimension(nbdim,2)   :: lubglob
+    integer                      :: i
+    integer,dimension(nbdim,2,2) :: indtab         ! Arrays indicating the limits of the child
+    integer,dimension(nbdim,2,2) :: indtruetab     ! grid variable where boundary conditions are
+    integer,dimension(nbdim,2,2,nbdim)   :: ptres  ! calculated
+    integer                      :: nb, ndir
+    integer :: coeffraf
+!
+    type_update = child % root_var % type_update(1:nbdim)
+!
+    DO i = 1, nbdim
+        coeffraf = nint(ds_parent(i)/ds_child(i))
+        indtab(i,1,1) = lb_child(i) + (uinf(i) + 1) * coeffraf
+        indtab(i,1,2) = lb_child(i) + (usup(i) + 1) * coeffraf
+
+        indtab(i,2,1) = lb_child(i) + nb_child(i) - (usup(i)+1) *  coeffraf
+        indtab(i,2,2) = lb_child(i) + nb_child(i) - (uinf(i)+1) *  coeffraf
+
+        IF (posvar(i) == 1) THEN
+            IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
+                indtab(i,:,1) = indtab(i,:,1) - (coeffraf - 1)
+                indtab(i,:,2) = indtab(i,:,2) + (coeffraf - 1)
+            ELSE IF (type_update(i) /= Agrif_Update_Copy) THEN
+                indtab(i,:,1) = indtab(i,:,1) - coeffraf / 2
+                indtab(i,:,2) = indtab(i,:,2) + coeffraf / 2
+            ENDIF
+        ELSE
+            indtab(i,1,1) = indtab(i,1,1) - coeffraf
+            indtab(i,1,2) = indtab(i,1,2) - 1
+            indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1
+            IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
+                indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
+                indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
+                indtab(i,2,1) = indtab(i,2,1) - coeffraf/2
+                indtab(i,2,2) = indtab(i,2,2) + coeffraf/2
+            ENDIF
+        ENDIF
+    ENDDO
+!
+    call Agrif_get_var_global_bounds(child,lubglob,nbdim)
+!
+    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),lubglob(1:nbdim,2))
+    indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),lubglob(1:nbdim,2))
+!
+    do nb = 1,nbdim
+        if ( do_update(nb) ) then
+            do ndir = 1,2
+                ptres(nb,1,ndir,nb) = indtruetab(nb,ndir,1)
+                ptres(nb,2,ndir,nb) = indtruetab(nb,ndir,2)
+                do i = 1,nbdim
+                    if ( i /= nb ) then
+                        if ( do_update(i) ) then
+                            ptres(i,1,ndir,nb) = indtruetab(i,1,1)
+                            ptres(i,2,ndir,nb) = indtruetab(i,2,2)
+                        else
+                            if (posvar(i) == 1) then
+                                ptres(i,1,ndir,nb) = lb_child(i)
+                                ptres(i,2,ndir,nb) = lb_child(i) + nb_child(i)
+                            else
+                                ptres(i,1,ndir,nb) = lb_child(i)
+                                ptres(i,2,ndir,nb) = lb_child(i) + nb_child(i) - 1
+                            endif
+                        endif
+                    endif
+                enddo
+            enddo
+        endif
+    enddo
+!
+    do nb = 1,nbdim
+        if ( do_update(nb) ) then
+            do ndir = 1,2
+                call Agrif_UpdatenD(type_update, parent, child,             &
+                        ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),  &
+                        lb_child(1:nbdim),lb_parent(1:nbdim),               &
+                        s_child(1:nbdim),s_parent(1:nbdim),                 &
+                        ds_child(1:nbdim),ds_parent(1:nbdim),               &
+#if defined AGRIF_MPI
+                        posvar,do_update,                                   &
+#endif
+                        nbdim,procname,nb,ndir)
+            enddo
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdateBcnd
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_UpdatenD
+!
+!> updates a 2D grid variable on the parent grid of the current grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdatenD ( type_update, parent, child,     &
+                            pttab, petab,                   &
+                            lb_child, lb_parent,            &
+                            s_child,  s_parent,             &
+                            ds_child, ds_parent,            &
+#if defined AGRIF_MPI
+                            posvar, do_update,              &
+#endif
+                            nbdim, procname, nb, ndir )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    integer, dimension(6),     intent(in)   :: type_update  !< Type of update (copy or average)
+    type(Agrif_Variable), pointer           :: parent       !< Variable of the parent grid
+    type(Agrif_Variable), pointer           :: child        !< Variable of the child grid
+    integer,                   intent(in)   :: nbdim
+    integer, dimension(nbdim), intent(in)   :: pttab        !< Index of the first point inside the domain
+    integer, dimension(nbdim), intent(in)   :: petab        !< Index of the first point inside the domain
+    integer, dimension(nbdim), intent(in)   :: lb_child  !< Index of the first point inside the domain for the child
+                                                            !!    grid variable
+    integer, dimension(nbdim), intent(in)   :: lb_parent !< Index of the first point inside the domain for the parent
+                                                            !!    grid variable
+    real,    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid
+    real,    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid
+    real,    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid
+    real,    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid
+    procedure()                             :: procname     !< Data recovery procedure
+    integer, optional,         intent(in)   :: nb, ndir
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(nbdim)       :: pttruetab, cetruetab
+#if defined AGRIF_MPI
+    integer, dimension(nbdim)       :: posvar  !< Position of the variable on the cell (1 or 2)
+    logical, dimension(nbdim)       :: do_update
+#endif
+    integer, dimension(nbdim)       :: coords
+    integer, dimension(nbdim)       :: indmin, indmax
+    integer, dimension(nbdim)       :: indminglob, indmaxglob
+    real   , dimension(nbdim)       :: s_Child_temp, s_Parent_temp
+    integer, dimension(nbdim)       :: lowerbound,upperbound
+    integer, dimension(nbdim)       :: pttruetabwhole, cetruetabwhole
+    integer, dimension(nbdim,2,2)   :: childarray
+    integer, dimension(nbdim,2,2)   :: parentarray
+    integer,dimension(nbdim)     :: type_update_temp
+    logical :: memberin, member
+    integer :: nbin, ndirin
+!
+#if defined AGRIF_MPI
+!
+    integer,dimension(nbdim)    :: indminglob2,indmaxglob2
+    logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
+    logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2
+    integer                               :: code, local_proc
+    integer                               :: i,j,k
+    integer, dimension(nbdim,4)           :: tab3
+    integer, dimension(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
+    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t
+    logical :: find_list_update
+    logical, dimension(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
+    logical, dimension(1) :: memberin1
+!
+#endif
+!
+    type(Agrif_Variable), pointer, save :: tempC => NULL()       ! Temporary child grid variable
+    type(Agrif_Variable), pointer, save :: tempP => NULL()       ! Temporary parent grid variable
+    type(Agrif_Variable), pointer, save :: tempCextend => NULL() ! Temporary child
+    type(Agrif_Variable), pointer, save :: tempPextend => NULL() ! Temporary parent
+    type(Agrif_Variable), pointer :: tempP_indic, tempP_average
+    type(Agrif_Variable), pointer :: tempC_indic
+    logical :: compute_average
+    real :: coeff_multi
+    integer :: nb_dimensions
+!
+!   Get local lower and upper bound of the child variable
+    call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim)
+
+! here pttab and petab corresponds to the (global) indices of the points needed in the update
+! pttruetab and cetruetab contains only indices that are present on the local processor
+!
+    coords = child % root_var % coords
+!
+    call Agrif_Childbounds( nbdim, lowerbound, upperbound, pttab, petab, Agrif_Procrank,    &
+                            coords, pttruetab, cetruetab, memberin )
+    call Agrif_Prtbounds( nbdim, indminglob, indmaxglob, s_Parent_temp, s_Child_temp,       &
+                         s_child, ds_child, s_parent, ds_parent,                            &
+                         pttab, petab, lb_child, lb_parent                                  &
+#if defined AGRIF_MPI
+                       , posvar, type_update, do_update, pttruetabwhole, cetruetabwhole     &
+#endif
+            )
+
+#if defined AGRIF_MPI
+!
+    IF (memberin) THEN
+        call Agrif_GlobalToLocalBounds(childarray,lowerbound,upperbound,    &
+                                       pttruetab,cetruetab, coords,         &
+                                       nbdim, Agrif_Procrank, member)
+    ENDIF
+
+    call Agrif_Prtbounds(nbdim, indmin, indmax,                     &
+                         s_Parent_temp, s_Child_temp,               &
+                         s_child, ds_child, s_parent, ds_parent,    &
+                         pttruetab, cetruetab, lb_child, lb_parent, &
+                         posvar, type_update, do_update,            &
+                         pttruetabwhole, cetruetabwhole)
+!
+#else
+    indmin = indminglob
+    indmax = indmaxglob
+    pttruetabwhole = pttruetab
+    cetruetabwhole = cetruetab
+    childarray(:,1,2) = pttruetab
+    childarray(:,2,2) = cetruetab
+#endif
+
+    IF (.not.present(nb)) THEN
+        nbin=0
+        ndirin=0
+    ELSE
+        nbin = nb
+        ndirin = ndir
+    ENDIF
+
+    IF (memberin) THEN
+!
+        IF ( .not.associated(tempC) )  allocate(tempC)
+!
+        call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim)
+        call Agrif_var_set_array_tozero(tempC,nbdim)
+
+        SELECT CASE (nbdim)
+        CASE(1)
+            CALL procname(tempC%array1,                 &
+                      childarray(1,1,2),childarray(1,2,2),.TRUE.,nbin,ndirin)
+        CASE(2)
+            CALL procname(tempC%array2,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),.TRUE.,nbin,ndirin)
+        CASE(3)
+            CALL procname(tempC%array3,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),  &
+                      childarray(3,1,2),childarray(3,2,2),.TRUE.,nbin,ndirin)
+        CASE(4)
+            CALL procname(tempC%array4,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),  &
+                      childarray(3,1,2),childarray(3,2,2),  &
+                      childarray(4,1,2),childarray(4,2,2),.TRUE.,nbin,ndirin)
+        CASE(5)
+            CALL procname(tempC%array5,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),  &
+                      childarray(3,1,2),childarray(3,2,2),  &
+                      childarray(4,1,2),childarray(4,2,2),  &
+                      childarray(5,1,2),childarray(5,2,2),.TRUE.,nbin,ndirin)
+        CASE(6)
+            CALL procname(tempC%array6,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),  &
+                      childarray(3,1,2),childarray(3,2,2),  &
+                      childarray(4,1,2),childarray(4,2,2),  &
+                      childarray(5,1,2),childarray(5,2,2),  &
+                      childarray(6,1,2),childarray(6,2,2),.TRUE.,nbin,ndirin)
+        END SELECT
+!
+    ENDIF
+!
+#if defined AGRIF_MPI
+!
+!     tab2 contains the necessary limits of the parent grid for each processor
+
+    if (Associated(child%list_update)) then
+        call Agrif_Find_list_update(child%list_update,pttab,petab,                      &
+                                    lb_child,lb_parent,nbdim,                         &
+                                    find_list_update,tab4t,tab5t,memberinall,memberinall2,  &
+                                    sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
+    else
+        find_list_update = .FALSE.
+    endif
+
+    if (.not.find_list_update) then
+        tab3(:,1) = pttruetab(:)
+        tab3(:,2) = cetruetab(:)
+        tab3(:,3) = pttruetabwhole(:)
+        tab3(:,4) = cetruetabwhole(:)
+!
+        call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
+
+        if ( .not.associated(tempCextend) ) allocate(tempCextend)
+        do k=0,Agrif_Nbprocs-1
+            do j=1,4
+                do i=1,nbdim
+                    tab4t(i,k,j) = tab4(i,j,k)
+                enddo
+            enddo
+        enddo
+
+        memberin1(1) = memberin
+        call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,1,MPI_LOGICAL,Agrif_mpi_comm,code)
+
+        call Get_External_Data_first(tab4t(:,:,1),tab4t(:,:,2),tab4t(:,:,3),tab4t(:,:,4),   &
+                                     nbdim, memberinall, coords,                            &
+                                     sendtoproc1,recvfromproc1,                             &
+                                     tab4t(:,:,5),tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
+    endif
+
+    call ExchangeSameLevel(sendtoproc1,recvfromproc1,nbdim,         &
+            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),    &
+            tab4t(:,:,7),tab4t(:,:,8),memberin,tempC,tempCextend)
+
+#else
+    tempCextend => tempC
+#endif
+!
+!     Update of the parent grid (tempP) from the child grid (tempC)
+!
+    IF (memberin) THEN
+!
+        IF ( .not.associated(tempP) ) allocate(tempP)
+!
+        call Agrif_array_allocate(tempP,indmin,indmax,nbdim)
+!
+        if ( nbdim == 1 ) then
+            tempP % array1 = 0.
+            call Agrif_Update_1D_Recursive( type_update(1),  &
+                                            tempP%array1,   &
+                                            tempCextend%array1, &
+                                            indmin(1), indmax(1),   &
+                                            pttruetabwhole(1), cetruetabwhole(1),   &
+                                            s_Child_temp(1), s_Parent_temp(1),      &
+                                            ds_child(1), ds_parent(1) )
+                                            
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array1),ubound(tempCextend%array1),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array1),ubound(tempP%array1),nbdim)
+
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update(1:nbdim) == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array1),ubound(tempP%array1),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_1D_Recursive( type_update_temp(1),   &
+                                            tempP_average%array1,       &
+                                            tempCextend%array1, &
+                                            indmin(1), indmax(1),   &
+                                            pttruetabwhole(1), cetruetabwhole(1),   &
+                                            s_Child_temp(1), s_Parent_temp(1),      &
+                                            ds_child(1), ds_parent(1) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array1 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array1 = 0.
+            ELSEWHERE
+              tempC_indic%array1 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_1D_Recursive( type_update_temp(1),   &
+                                            tempP_indic%array1,       &
+                                            tempC_indic%array1, &
+                                            indmin(1), indmax(1),   &
+                                            pttruetabwhole(1), cetruetabwhole(1),   &
+                                            s_Child_temp(1), s_Parent_temp(1),      &
+                                            ds_child(1), ds_parent(1) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array1 == 0.)
+                  tempP%array1 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array1 == coeff_multi).AND.(tempP%array1 /= Agrif_SpecialValueFineGrid))
+                  tempP%array1 = tempP%array1 /tempP_indic%array1
+               ELSEWHERE
+                  tempP%array1 = tempP_average%array1 /tempP_indic%array1
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array1 == 0.)
+                  tempP%array1 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array1 = tempP%array1 /tempP_indic%array1
+               END WHERE
+            ENDIF
+           
+            deallocate(tempP_indic%array1)
+            deallocate(tempC_indic%array1)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array1)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 2 ) then
+            call Agrif_Update_2D_Recursive( type_update(1:2),   &
+                                            tempP%array2,       &
+                                            tempCextend%array2, &
+                                            indmin(1:2), indmax(1:2),   &
+                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   &
+                                            s_Child_temp(1:2), s_Parent_temp(1:2),      &
+                                            ds_child(1:2), ds_parent(1:2) )
+
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array2),ubound(tempCextend%array2),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array2),ubound(tempP%array2),nbdim)
+ 
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array2),ubound(tempP%array2),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_2D_Recursive( type_update_temp(1:2),   &
+                                            tempP_average%array2,       &
+                                            tempCextend%array2, &
+                                            indmin(1:2), indmax(1:2),   &
+                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   &
+                                            s_Child_temp(1:2), s_Parent_temp(1:2),      &
+                                            ds_child(1:2), ds_parent(1:2) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array2 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array2 = 0.
+            ELSEWHERE
+              tempC_indic%array2 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+            
+            call Agrif_Update_2D_Recursive( type_update_temp(1:2),   &
+                                            tempP_indic%array2,       &
+                                            tempC_indic%array2, &
+                                            indmin(1:2), indmax(1:2),   &
+                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   &
+                                            s_Child_temp(1:2), s_Parent_temp(1:2),      &
+                                            ds_child(1:2), ds_parent(1:2) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array2 == 0.)
+                  tempP%array2 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array2 == coeff_multi).AND.(tempP%array2 /= Agrif_SpecialValueFineGrid))
+                  tempP%array2 = tempP%array2 /tempP_indic%array2
+               ELSEWHERE
+                  tempP%array2 = tempP_average%array2 /tempP_indic%array2
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array2 == 0.)
+                  tempP%array2 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array2 = tempP%array2 /tempP_indic%array2
+               END WHERE
+            ENDIF
+           
+            deallocate(tempP_indic%array2)
+            deallocate(tempC_indic%array2)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array2)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 3 ) then
+            call Agrif_Update_3D_Recursive( type_update(1:3),   &
+                                            tempP%array3,       &
+                                            tempCextend%array3, &
+                                            indmin(1:3), indmax(1:3),   &
+                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   &
+                                            s_Child_temp(1:3), s_Parent_temp(1:3),      &
+                                            ds_child(1:3), ds_parent(1:3) )
+                                            
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array3),ubound(tempCextend%array3),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array3),ubound(tempP%array3),nbdim)
+
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array3),ubound(tempP%array3),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_3D_Recursive( type_update_temp(1:3),   &
+                                            tempP_average%array3,       &
+                                            tempCextend%array3, &
+                                            indmin(1:3), indmax(1:3),   &
+                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   &
+                                            s_Child_temp(1:3), s_Parent_temp(1:3),      &
+                                            ds_child(1:3), ds_parent(1:3) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array3 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array3 = 0.
+            ELSEWHERE
+              tempC_indic%array3 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_3D_Recursive( type_update_temp(1:3),   &
+                                            tempP_indic%array3,       &
+                                            tempC_indic%array3, &
+                                            indmin(1:3), indmax(1:3),   &
+                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   &
+                                            s_Child_temp(1:3), s_Parent_temp(1:3),      &
+                                            ds_child(1:3), ds_parent(1:3) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array3 == 0.)
+                  tempP%array3 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array3 == coeff_multi).AND.(tempP%array3 /= Agrif_SpecialValueFineGrid))
+                  tempP%array3 = tempP%array3 /tempP_indic%array3
+               ELSEWHERE
+                  tempP%array3 = tempP_average%array3 /tempP_indic%array3
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array3 == 0.)
+                  tempP%array3 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array3 = tempP%array3 /tempP_indic%array3
+               END WHERE
+            ENDIF
+           
+            deallocate(tempP_indic%array3)
+            deallocate(tempC_indic%array3)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array3)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 4 ) then
+            call Agrif_Update_4D_Recursive( type_update(1:4),   &
+                                            tempP%array4,       &
+                                            tempCextend%array4, &
+                                            indmin(1:4), indmax(1:4),   &
+                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   &
+                                            s_Child_temp(1:4), s_Parent_temp(1:4),      &
+                                            ds_child(1:4), ds_parent(1:4) )
+                                            
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array4),ubound(tempCextend%array4),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array4),ubound(tempP%array4),nbdim)
+           
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array4),ubound(tempP%array4),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_4D_Recursive( type_update_temp(1:4),   &
+                                            tempP_average%array4,       &
+                                            tempCextend%array4, &
+                                            indmin(1:4), indmax(1:4),   &
+                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   &
+                                            s_Child_temp(1:4), s_Parent_temp(1:4),      &
+                                            ds_child(1:4), ds_parent(1:4) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array4 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array4 = 0.
+            ELSEWHERE
+              tempC_indic%array4 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_4D_Recursive( type_update_temp(1:4),   &
+                                            tempP_indic%array4,       &
+                                            tempC_indic%array4, &
+                                            indmin(1:4), indmax(1:4),   &
+                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   &
+                                            s_Child_temp(1:4), s_Parent_temp(1:4),      &
+                                            ds_child(1:4), ds_parent(1:4) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+           
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array4 == 0.)
+                  tempP%array4 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array4 == coeff_multi).AND.(tempP%array4 /= Agrif_SpecialValueFineGrid))
+                  tempP%array4 = tempP%array4 /tempP_indic%array4
+               ELSEWHERE
+                  tempP%array4 = tempP_average%array4 /tempP_indic%array4
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array4 == 0.)
+                  tempP%array4 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array4 = tempP%array4 /tempP_indic%array4
+               END WHERE
+            ENDIF
+            deallocate(tempP_indic%array4)
+            deallocate(tempC_indic%array4)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array4)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 5 ) then
+            call Agrif_Update_5D_Recursive( type_update(1:5),   &
+                                            tempP%array5,       &
+                                            tempCextend%array5, &
+                                            indmin(1:5), indmax(1:5),   &
+                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   &
+                                            s_Child_temp(1:5), s_Parent_temp(1:5),      &
+                                            ds_child(1:5), ds_parent(1:5) )
+                                            
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array5),ubound(tempCextend%array5),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array5),ubound(tempP%array5),nbdim)
+
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array5),ubound(tempP%array5),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_5D_Recursive( type_update_temp(1:5),   &
+                                            tempP_average%array5,       &
+                                            tempCextend%array5, &
+                                            indmin(1:5), indmax(1:5),   &
+                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   &
+                                            s_Child_temp(1:5), s_Parent_temp(1:5),      &
+                                            ds_child(1:5), ds_parent(1:5) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array5 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array5 = 0.
+            ELSEWHERE
+              tempC_indic%array5 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_5D_Recursive( type_update_temp(1:5),   &
+                                            tempP_indic%array5,       &
+                                            tempC_indic%array5, &
+                                            indmin(1:5), indmax(1:5),   &
+                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   &
+                                            s_Child_temp(1:5), s_Parent_temp(1:5),      &
+                                            ds_child(1:5), ds_parent(1:5) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array5 == 0.)
+                  tempP%array5 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array5 == coeff_multi).AND.(tempP%array5 /= Agrif_SpecialValueFineGrid))
+                  tempP%array5 = tempP%array5 /tempP_indic%array5
+               ELSEWHERE
+                  tempP%array5 = tempP_average%array5 /tempP_indic%array5
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array5 == 0.)
+                  tempP%array5 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array5 = tempP%array5 /tempP_indic%array5
+               END WHERE
+            ENDIF
+           
+            deallocate(tempP_indic%array5)
+            deallocate(tempC_indic%array5)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array5)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 6 ) then
+            call Agrif_Update_6D_Recursive( type_update(1:6),   &
+                                            tempP%array6,       &
+                                            tempCextend%array6, &
+                                            indmin(1:6), indmax(1:6),   &
+                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
+                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
+                                            ds_child(1:6), ds_parent(1:6) )
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array6),ubound(tempCextend%array6),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array6),ubound(tempP%array6),nbdim)
+
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array6),ubound(tempP%array6),nbdim)
+              type_update_temp(1:nbdim) = type_update
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_6D_Recursive( type_update_temp(1:6),   &
+                                            tempP_average%array6,       &
+                                            tempCextend%array6, &
+                                            indmin(1:6), indmax(1:6),   &
+                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
+                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
+                                            ds_child(1:6), ds_parent(1:6) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array6 == 0.)
+                  tempP%array6 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array6 == coeff_multi).AND.(tempP%array6 /= Agrif_SpecialValueFineGrid))
+                  tempP%array6 = tempP%array6 /tempP_indic%array6
+               ELSEWHERE
+                  tempP%array6 = tempP_average%array6 /tempP_indic%array6
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array6 == 0.)
+                  tempP%array6 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array6 = tempP%array6 /tempP_indic%array6
+               END WHERE
+            ENDIF
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_6D_Recursive( type_update_temp(1:6),   &
+                                            tempP_indic%array6,       &
+                                            tempC_indic%array6, &
+                                            indmin(1:6), indmax(1:6),   &
+                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
+                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
+                                            ds_child(1:6), ds_parent(1:6) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+           
+            WHERE (tempP_indic%array6 == 0.)
+              tempP%array6 = Agrif_SpecialValueFineGrid
+            ELSEWHERE
+              tempP%array6 = tempP%array6 /tempP_indic%array6
+            END WHERE
+           
+            deallocate(tempP_indic%array6)
+            deallocate(tempC_indic%array6)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array6)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+        endif
+!
+        call Agrif_array_deallocate(tempCextend,nbdim)
+!
+    ENDIF
+
+#if defined AGRIF_MPI
+    local_proc = Agrif_Procrank
+    call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
+    call Agrif_ChildGrid_to_ParentGrid()
+    call Agrif_Childbounds(nbdim, lowerbound, upperbound,                   &
+                           indminglob,  indmaxglob,  local_proc, coords,    &
+                           indminglob2, indmaxglob2, member)
+!
+    IF (member) THEN
+        call Agrif_GlobalToLocalBounds(parentarray, lowerbound, upperbound, &
+                                       indminglob2, indmaxglob2, coords,    &
+                                       nbdim, local_proc, member)
+    ENDIF
+
+    call Agrif_ParentGrid_to_ChildGrid()
+
+    if (.not.find_list_update) then
+        tab3(:,1) = indmin(:)
+        tab3(:,2) = indmax(:)
+        tab3(:,3) = indminglob2(:)
+        tab3(:,4) = indmaxglob2(:)
+!
+        call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
+
+        IF ( .not.associated(tempPextend) ) allocate(tempPextend)
+        DO k=0,Agrif_Nbprocs-1
+            do j=1,4
+                do i=1,nbdim
+                    tab5t(i,k,j) = tab4(i,j,k)
+                enddo
+            enddo
+        enddo
+
+        memberin1(1) = member
+        call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2,1,MPI_LOGICAL,Agrif_mpi_comm,code)
+        call Get_External_Data_first(tab5t(:,:,1),tab5t(:,:,2),tab5t(:,:,3),tab5t(:,:,4),   &
+                                     nbdim, memberinall2, coords,                           &
+                                     sendtoproc2, recvfromproc2,                            &
+                                     tab5t(:,:,5),tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8))
+
+        call Agrif_Addto_list_update(child%list_update,pttab,petab,lb_child,lb_parent,      &
+                                     nbdim,tab4t,tab5t,memberinall,memberinall2,            &
+                                     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
+
+    endif
+
+    call ExchangeSameLevel(sendtoproc2,recvfromproc2,nbdim,                     &
+                            tab5t(:,:,3),tab5t(:,:,4),tab5t(:,:,5),tab5t(:,:,6),&
+                            tab5t(:,:,7),tab5t(:,:,8),member,tempP,tempPextend)
+#else
+    tempPextend => tempP
+    parentarray(:,1,1) = indmin
+    parentarray(:,2,1) = indmax
+    parentarray(:,1,2) = indmin
+    parentarray(:,2,2) = indmax
+    member = .TRUE.
+#endif
+!
+!   Special values on the child grid
+    if ( Agrif_UseSpecialValueFineGrid ) then
+!
+!cc         noraftab(1:nbdim) =
+!cc     &    child % root_var % interptab(1:nbdim) == 'N'
+!
+#if defined AGRIF_MPI
+!
+!          allocate(childvalues% var)
+!
+!          Call Agrif_array_allocate(childvalues%var,
+!     &                      pttruetab,cetruetab,nbdim)
+!          Call Agrif_var_full_copy_array(childvalues% var,
+!     &                                tempC,
+!     &                                nbdim)
+!          Call Agrif_CheckMasknD(tempC,childvalues,
+!     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+!     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+!     &                           noraftab(1:nbdim),nbdim)
+!          Call Agrif_array_deallocate(childvalues% var,nbdim)
+!         Deallocate(childvalues % var)
+!
+#else
+!
+!          Call Agrif_get_var_bounds_array(child,
+!     &                              lowerbound,upperbound,nbdim)
+!          Call Agrif_CheckMasknD(tempC,child,
+!     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+!     &                           lowerbound,
+!     &                           upperbound,
+!     &                           noraftab(1:nbdim),nbdim)
+!
+#endif
+!
+    endif
+!
+!   Special values on the parent grid
+    if (Agrif_UseSpecialValue) then
+!
+#if defined AGRIF_MPI
+!
+!          Call GiveAgrif_SpecialValueToTab_mpi(parent,tempP,
+!     &                 parentarray,
+!     &                 Agrif_SpecialValue,nbdim)
+!
+!
+#else
+!
+!          Call GiveAgrif_SpecialValueToTab(parent,tempP,
+!     &                  indmin,indmax,
+!     &                  Agrif_SpecialValue,nbdim)
+!
+#endif
+!
+    endif
+!
+    IF (member) THEN
+
+        call Agrif_ChildGrid_to_ParentGrid()
+!
+        SELECT CASE(nbdim)
+        CASE(1)
+            call procname( tempPextend % array1(            &
+                    parentarray(1,1,1):parentarray(1,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),.FALSE.,nbin,ndirin)
+        CASE(2)
+            call procname( tempPextend % array2(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),.FALSE.,nbin,ndirin)
+        CASE(3)
+            call procname( tempPextend % array3(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1),  &
+                    parentarray(3,1,1):parentarray(3,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),  &
+                    parentarray(3,1,2),parentarray(3,2,2),.FALSE.,nbin,ndirin)
+        CASE(4)
+            call procname( tempPextend % array4(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1),  &
+                    parentarray(3,1,1):parentarray(3,2,1),  &
+                    parentarray(4,1,1):parentarray(4,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),  &
+                    parentarray(3,1,2),parentarray(3,2,2),  &
+                    parentarray(4,1,2),parentarray(4,2,2),.FALSE.,nbin,ndirin)
+        CASE(5)
+            call procname( tempPextend % array5(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1),  &
+                    parentarray(3,1,1):parentarray(3,2,1),  &
+                    parentarray(4,1,1):parentarray(4,2,1),  &
+                    parentarray(5,1,1):parentarray(5,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),  &
+                    parentarray(3,1,2),parentarray(3,2,2),  &
+                    parentarray(4,1,2),parentarray(4,2,2),  &
+                    parentarray(5,1,2),parentarray(5,2,2),.FALSE.,nbin,ndirin)
+        CASE(6)
+            call procname( tempPextend % array6(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1),  &
+                    parentarray(3,1,1):parentarray(3,2,1),  &
+                    parentarray(4,1,1):parentarray(4,2,1),  &
+                    parentarray(5,1,1):parentarray(5,2,1),  &
+                    parentarray(6,1,1):parentarray(6,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),  &
+                    parentarray(3,1,2),parentarray(3,2,2),  &
+                    parentarray(4,1,2),parentarray(4,2,2),  &
+                    parentarray(5,1,2),parentarray(5,2,2),  &
+                    parentarray(6,1,2),parentarray(6,2,2),.FALSE.,nbin,ndirin)
+        END SELECT
+!
+        call Agrif_ParentGrid_to_ChildGrid()
+!
+        call Agrif_array_deallocate(tempPextend,nbdim)
+!
+    ENDIF
+!
+#if defined AGRIF_MPI
+    IF (memberin) THEN
+        call Agrif_array_deallocate(tempP,nbdim)
+        call Agrif_array_deallocate(tempC,nbdim)
+    ENDIF
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdatenD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Prtbounds
+!
+!> calculates the bounds of the parent grid to be updated by the child grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Prtbounds ( nbdim, indmin, indmax, s_Parent_temp, s_Child_temp,        &
+                             s_child, ds_child, s_parent, ds_parent,                    &
+                             pttruetab, cetruetab, lb_child, lb_parent            &
+#if defined AGRIF_MPI
+                            ,posvar, type_update, do_update,                &
+                             pttruetabwhole, cetruetabwhole                             &
+#endif
+                )
+!---------------------------------------------------------------------------------------------------
+    integer,                   intent(in)   :: nbdim
+    integer, dimension(nbdim), intent(out)  :: indmin, indmax
+    real,    dimension(nbdim), intent(out)  :: s_Parent_temp, s_Child_temp
+    real,    dimension(nbdim), intent(in)   :: s_child,  ds_child
+    real,    dimension(nbdim), intent(in)   :: s_parent, ds_parent
+    integer, dimension(nbdim), intent(in)   :: pttruetab, cetruetab
+    integer, dimension(nbdim), intent(in)   :: lb_child, lb_parent
+#if defined AGRIF_MPI
+    integer, dimension(nbdim), intent(in)   :: posvar   !< Position of the variable on the cell (1 or 2)
+    integer, dimension(nbdim), intent(in)   :: type_update
+    logical, dimension(nbdim), intent(in)   :: do_update
+    integer,dimension(nbdim), intent(out)   :: pttruetabwhole, cetruetabwhole
+#endif
+!
+    real,dimension(nbdim) :: dim_newmin,dim_newmax
+    integer :: i
+#if defined AGRIF_MPI
+    real    :: positionmin, positionmax
+    integer :: imin, imax
+    integer :: coeffraf
+#endif
+!
+    do i = 1,nbdim
+!
+        dim_newmin(i) = s_child(i) + (pttruetab(i) - lb_child(i)) * ds_child(i)
+        dim_newmax(i) = s_child(i) + (cetruetab(i) - lb_child(i)) * ds_child(i)
+!
+        indmin(i) = lb_parent(i) + agrif_ceiling((dim_newmin(i)-s_parent(i))/ds_parent(i))
+        indmax(i) = lb_parent(i) + agrif_int(    (dim_newmax(i)-s_parent(i))/ds_parent(i))
+!
+#if defined AGRIF_MPI
+        positionmin = s_parent(i) + (indmin(i)-lb_parent(i))*ds_parent(i)
+        IF ( do_update(i) ) THEN
+            IF (posvar(i) == 1) THEN
+                IF      (type_update(i) == Agrif_Update_Average) THEN
+                    positionmin = positionmin - ds_parent(i)/2.
+                ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
+                    positionmin = positionmin - (ds_parent(i)-ds_child(i))
+                ENDIF
+            ELSE
+                IF (type_update(i) /= Agrif_Update_Full_Weighting) THEN
+                    positionmin = positionmin - ds_parent(i)/2.
+                ELSE
+                    coeffraf = nint(ds_parent(i)/ds_child(i))
+                    if (mod(coeffraf,2) == 1) then
+                        positionmin = positionmin - (ds_parent(i)-ds_child(i))
+                    else
+                        positionmin = positionmin - (ds_parent(i)-ds_child(i))-ds_child(i)/2.
+                    endif
+                ENDIF
+            ENDIF
+        ENDIF
+!
+        imin = lb_child(i) + agrif_ceiling((positionmin-s_child(i))/ds_child(i))
+        positionmin = s_child(i)  + (imin - lb_child(i)) * ds_child(i)
+        positionmax = s_parent(i) + (indmax(i)-lb_parent(i))*ds_parent(i)
+        pttruetabwhole(i) = imin
+
+        IF ( do_update(i) ) THEN
+            IF (posvar(i) == 1) THEN
+                IF      (type_update(i) == Agrif_Update_Average) THEN
+                    positionmax = positionmax  + ds_parent(i)/2.
+                ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
+                    positionmax = positionmax  + (ds_parent(i)-ds_child(i))
+                ENDIF
+            ELSE
+                IF (type_update(i) /= Agrif_Update_Full_Weighting) THEN
+                    positionmax = positionmax  + ds_parent(i)/2.
+                ELSE
+                    coeffraf = nint(ds_parent(i)/ds_child(i))
+                    if (mod(coeffraf,2) == 1) then
+                        positionmax = positionmax + (ds_parent(i)-ds_child(i))
+                    else
+                        positionmax = positionmax + (ds_parent(i)-ds_child(i)) + ds_child(i)/2.
+                    endif
+                ENDIF
+            ENDIF
+        ENDIF
+
+        imax = lb_child(i) +agrif_int((positionmax-s_child(i))/ds_child(i))
+        positionmax = s_child(i) + (imax - lb_child(i)) * ds_child(i)
+        cetruetabwhole(i) = imax
+#endif
+!
+        s_Parent_temp(i) = s_parent(i) + (indmin(i) - lb_parent(i)) * ds_parent(i)
+        s_Child_temp(i)  = dim_newmin(i)
+
+#if defined AGRIF_MPI
+        s_Child_temp(i) = positionmin
+#endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Prtbounds
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_1D_Recursive
+!
+!> Updates a 1D grid variable on the parent grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_1D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                       s_child,  s_parent,  &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer,                            intent(in)  :: type_update            !< Type of update (copy or average)
+    integer,                            intent(in)  :: indmin, indmax
+    integer,                            intent(in)  :: lb_child, ub_child
+    real,                               intent(in)  ::  s_child,  s_parent
+    real,                               intent(in)  :: ds_child, ds_parent
+    real, dimension(indmin:indmax),     intent(out) :: tempP
+    real, dimension(lb_child:ub_child), intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    call Agrif_UpdateBase(type_update,              &
+                          tempP(indmin:indmax),     &
+                          tempC(lb_child:ub_child), &
+                          indmin, indmax,           &
+                          lb_child, ub_child,       &
+                          s_parent, s_child,        &
+                          ds_parent, ds_child)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_1D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_2D_Recursive
+!
+!> updates a 2D grid variable on the parent grid.
+!! Calls #Agrif_Update_1D_Recursive and #Agrif_UpdateBase
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_2D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(2),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(2),          intent(in)  :: indmin, indmax
+    integer, dimension(2),          intent(in)  :: lb_child, ub_child
+    real,    dimension(2),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(2),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2)),       intent(out) :: tempP
+    real,    dimension(:,:),        intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp
+    real, dimension(indmin(2):indmax(2), indmin(1):indmax(1))     :: tempP_trsp
+    real, dimension(lb_child(2):ub_child(2), indmin(1):indmax(1)) :: tabtemp_trsp
+    integer :: i, j
+    integer :: coeffraf
+!
+    tabtemp = 0.
+    coeffraf = nint ( ds_parent(1) / ds_child(1) )
+!
+    IF((type_update(1) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) THEN
+!---CDIR NEXPAND
+        if ( .NOT. precomputedone(1) ) then
+            call Average1dPrecompute( ub_child(2)-lb_child(2)+1,    &
+                                      indmax(1)-indmin(1)+1,              &
+                                      ub_child(1)-lb_child(1)+1,    &
+                                      s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!            precomputedone(1) = .TRUE.
+        endif
+!---CDIR NEXPAND
+        call Average1dAfterCompute( tabtemp, tempC, size(tabtemp), size(tempC), &
+                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!
+    ELSE IF ((type_update(1) == Agrif_Update_Copy) .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         if ( .NOT. precomputedone(1) ) then
+            call Agrif_basicupdate_copy1d_before( ub_child(2)-lb_child(2)+1, &
+                                   indmax(1)-indmin(1)+1,           &
+                                   ub_child(1)-lb_child(1)+1, &
+                                   s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!            precomputedone(1) = .TRUE.
+        endif
+!---CDIR NEXPAND
+        call Agrif_basicupdate_copy1d_after(tabtemp,tempC,size(tabtemp),size(tempC),1)
+!
+    ELSE
+        do j = lb_child(2),ub_child(2)
+!
+!---CDIR NEXPAND
+            call Agrif_Update_1D_Recursive( type_update(1),             &
+                                            tabtemp(:,j),               &
+                                            tempC(:,j-lb_child(2)+1),   &
+                                            indmin(1), indmax(1),       &
+                                            lb_child(1),ub_child(1),    &
+                                            s_child(1),  s_parent(1),   &
+                                            ds_child(1),ds_parent(1))
+        enddo
+    ENDIF
+!
+    tabtemp_trsp = TRANSPOSE(tabtemp)
+    coeffraf = nint(ds_parent(2)/ds_child(2))
+!
+    tempP_trsp = 0.
+!
+    IF((type_update(2) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) THEN
+!---CDIR NEXPAND
+        if ( .NOT. precomputedone(2) ) then
+            call Average1dPrecompute( indmax(1)-indmin(1)+1,          &
+                                      indmax(2)-indmin(2)+1,          &
+                                      ub_child(2)-lb_child(2)+1,&
+                                      s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!            precomputedone(2) = .TRUE.
+        endif
+!---CDIR NEXPAND
+        call Average1dAfterCompute( tempP_trsp, tabtemp_trsp, size(tempP_trsp), size(tabtemp_trsp),&
+                s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!
+    ELSE IF ((type_update(2) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) THEN
+!---CDIR NEXPAND
+        if ( .NOT. precomputedone(2) ) then
+            call Agrif_basicupdate_copy1d_before( indmax(1)-indmin(1)+1,             &
+                                   indmax(2)-indmin(2)+1,             &
+                                   ub_child(2)-lb_child(2)+1,   &
+                                   s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!            precomputedone(2) = .TRUE.
+        endif
+!---CDIR NEXPAND
+        call Agrif_basicupdate_copy1d_after( tempP_trsp, tabtemp_trsp, size(tempP_trsp), size(tabtemp_trsp),2)
+!
+    ELSE
+        do i = indmin(1),indmax(1)
+!
+!---CDIR NEXPAND
+            call Agrif_UpdateBase(type_update(2),                                       &
+                                  tempP_trsp(indmin(2):indmax(2),i),            &
+                                  tabtemp_trsp(lb_child(2):ub_child(2),i),&
+                                  indmin(2),indmax(2),                          &
+                                  lb_child(2),ub_child(2),                &
+                                  s_parent(2),s_child(2),                       &
+                                  ds_parent(2),ds_child(2))
+!
+        enddo
+    ENDIF
+!
+    tempP = TRANSPOSE(tempP_trsp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_2D_Recursive
+!===================================================================================================
+!
+subroutine Agrif_Update_2D_Recursive_ok ( type_update, &
+                                        tempP, tempC, &
+                                        indmin, indmax,   &
+                                       lb_child, ub_child,                    &
+                                       s_child, s_parent, ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, DIMENSION(2), intent(in)   :: type_update            !< Type of update (copy or average)
+    INTEGER, DIMENSION(2), intent(in)   :: indmin, indmax
+    INTEGER, DIMENSION(2), intent(in)   :: lb_child, ub_child
+    REAL,    DIMENSION(2), intent(in)   :: s_child,  s_parent
+    REAL,    DIMENSION(2), intent(in)   :: ds_child, ds_parent
+    REAL,    DIMENSION(                 &
+                indmin(1):indmax(1),    &
+                indmin(2):indmax(2)),           intent(out) :: tempP
+    REAL, DIMENSION(                            &
+                lb_child(1):ub_child(1),  &
+                lb_child(2):ub_child(2)), intent(in)  :: tempC
+!
+    REAL, DIMENSION(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp
+    INTEGER :: i
+!
+    do i = lb_child(2),ub_child(2)
+        call Agrif_Update_1D_Recursive(type_update(1),                              &
+                                       tabtemp(:, i),          &
+                                       tempC(:,i),  &
+                                       indmin(1),indmax(1),                 &
+                                       lb_child(1),ub_child(1),       &
+                                       s_child(1), s_parent(1),             &
+                                      ds_child(1),ds_parent(1))
+    enddo
+!
+    tempP = 0.
+!
+    do i = indmin(1),indmax(1)
+        call Agrif_UpdateBase(type_update(2),                                       &
+                              tempP(i,:),             &
+                              tabtemp(i,:), &
+                              indmin(2),indmax(2),                          &
+                              lb_child(2),ub_child(2),                &
+                              s_parent(2),s_child(2),                       &
+                             ds_parent(2),ds_child(2))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_2D_Recursive_ok
+!===================================================================================================
+
+!
+!===================================================================================================
+!  subroutine Agrif_Update_3D_Recursive
+!
+!> Updates a 3D grid variable on the parent grid.
+!! Calls #Agrif_Update_2D_Recursive and #Agrif_UpdateBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_3D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(3),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(3),          intent(in)  :: indmin, indmax
+    integer, dimension(3),          intent(in)  :: lb_child, ub_child
+    real,    dimension(3),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(3),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2),     &
+        indmin(3):indmax(3)),       intent(out) :: tempP
+    real, dimension(             &
+        lb_child(1):ub_child(1), &
+        lb_child(2):ub_child(2), &
+        lb_child(3):ub_child(3)),   intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(            &
+        indmin(1):indmax(1),    &
+        indmin(2):indmax(2),    &
+        lb_child(3):ub_child(3))    :: tabtemp
+    integer :: i,j,k
+    integer :: coeffraf,locind_child_left
+    integer :: kuinf
+!
+    coeffraf = nint ( ds_parent(1) / ds_child(1) )
+!
+    if ((type_update(1) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) then
+!---CDIR NEXPAND
+        call Average1dPrecompute(ub_child(2)-lb_child(2)+1,&
+                                 indmax(1)-indmin(1)+1,&
+                                 ub_child(1)-lb_child(1)+1,&
+                                 s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+        precomputedone(1) = .TRUE.
+    else if ((type_update(1) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) then
+!---CDIR NEXPAND
+         call Agrif_basicupdate_copy1d_before(ub_child(2)-lb_child(2)+1, &
+                               indmax(1)-indmin(1)+1,           &
+                               ub_child(1)-lb_child(1)+1, &
+                               s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+        precomputedone(1) = .TRUE.
+    endif
+!
+    coeffraf = nint ( ds_parent(2) / ds_child(2) )
+!
+    if ((type_update(2) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) then
+!---CDIR NEXPAND
+        call Average1dPrecompute(indmax(1)-indmin(1)+1,&
+                                 indmax(2)-indmin(2)+1,&
+                                 ub_child(2)-lb_child(2)+1,&
+                                 s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+        precomputedone(2) = .TRUE.
+    else if ((type_update(2) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) then
+!---CDIR NEXPAND
+        call Agrif_basicupdate_copy1d_before( indmax(1)-indmin(1)+1,           &
+                               indmax(2)-indmin(2)+1,           &
+                               ub_child(2)-lb_child(2)+1, &
+                               s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+        precomputedone(2) = .TRUE.
+    endif
+!
+    do k = lb_child(3),ub_child(3)
+        call Agrif_Update_2D_Recursive( type_update(1:2),tabtemp(:,:,k),tempC(:,:,k), &
+                                        indmin(1:2),indmax(1:2),                &
+                                        lb_child(1:2),ub_child(1:2),      &
+                                        s_child(1:2),s_parent(1:2),             &
+                                        ds_child(1:2),ds_parent(1:2) )
+    enddo
+!
+    precomputedone(1) = .FALSE.
+    precomputedone(2) = .FALSE.
+!
+    coeffraf = nint ( ds_parent(3) / ds_child(3) )
+    locind_child_left = 1 + agrif_int((s_parent(3)-s_child(3))/ds_child(3))
+!
+    if (coeffraf == 1) then
+        kuinf = lb_child(3)+locind_child_left-2
+        do k=indmin(3),indmax(3)
+            kuinf = kuinf + 1
+            do j = indmin(2),indmax(2)
+            do i = indmin(1),indmax(1)
+                tempP(i,j,k) = tabtemp(i,j,kuinf)
+            enddo
+            enddo
+        enddo
+    else
+        tempP = 0.
+        do j = indmin(2),indmax(2)
+        do i = indmin(1),indmax(1)
+            call Agrif_UpdateBase(type_update(3),tempP(i,j,:),tabtemp(i,j,:),   &
+                                  indmin(3),indmax(3),                  &
+                                  lb_child(3),ub_child(3),        &
+                                  s_parent(3),s_child(3),               &
+                                  ds_parent(3),ds_child(3))
+!
+        enddo
+        enddo
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_3D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_4D_Recursive
+!
+!> Updates a 4D grid variable on the parent grid.
+!! Calls #Agrif_Update_3D_Recursive and #Agrif_UpdateBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_4D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(4),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(4),          intent(in)  :: indmin, indmax
+    integer, dimension(4),          intent(in)  :: lb_child, ub_child
+    real,    dimension(4),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(4),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2),     &
+        indmin(3):indmax(3),     &
+        indmin(4):indmax(4)),       intent(out) :: tempP
+    real, dimension(             &
+        lb_child(1):ub_child(1), &
+        lb_child(2):ub_child(2), &
+        lb_child(3):ub_child(3), &
+        lb_child(4):ub_child(4)),   intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:,:), allocatable       :: tabtemp
+    integer :: i,j,k,l
+!
+    allocate(tabtemp(indmin(1):indmax(1), &
+                     indmin(2):indmax(2), &
+                     indmin(3):indmax(3), &
+                     lb_child(4):ub_child(4)))
+!
+    do l = lb_child(4), ub_child(4)
+        call Agrif_Update_3D_Recursive(type_update(1:3),                    &
+                                       tabtemp(indmin(1):indmax(1),         &
+                                               indmin(2):indmax(2),         &
+                                               indmin(3):indmax(3), l),     &
+                                       tempC(lb_child(1):ub_child(1),       &
+                                             lb_child(2):ub_child(2),       &
+                                             lb_child(3):ub_child(3), l),   &
+                                       indmin(1:3), indmax(1:3),            &
+                                       lb_child(1:3), ub_child(1:3),        &
+                                        s_child(1:3),  s_parent(1:3),       &
+                                       ds_child(1:3), ds_parent(1:3))
+    enddo
+!
+    tempP = 0.
+!
+    do k = indmin(3), indmax(3)
+    do j = indmin(2), indmax(2)
+    do i = indmin(1), indmax(1)
+        call Agrif_UpdateBase(type_update(4),                               &
+                              tempP(i,j,k,indmin(4):indmax(4)),             &
+                              tabtemp(i,j,k,lb_child(4):ub_child(4)),       &
+                              indmin(4), indmax(4),                         &
+                              lb_child(4), ub_child(4),                     &
+                               s_parent(4), s_child(4),                     &
+                              ds_parent(4),ds_child(4) )
+    enddo
+    enddo
+    enddo
+!
+    deallocate(tabtemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_4D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_5D_Recursive
+!
+!> Updates a 5D grid variable on the parent grid.
+!! Calls #Agrif_Update_4D_Recursive and #Agrif_UpdateBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_5D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(5),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(5),          intent(in)  :: indmin, indmax
+    integer, dimension(5),          intent(in)  :: lb_child, ub_child
+    real,    dimension(5),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(5),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2),     &
+        indmin(3):indmax(3),     &
+        indmin(4):indmax(4),     &
+        indmin(5):indmax(5)),       intent(out) :: tempP
+    real, dimension(             &
+        lb_child(1):ub_child(1), &
+        lb_child(2):ub_child(2), &
+        lb_child(3):ub_child(3), &
+        lb_child(4):ub_child(4), &
+        lb_child(5):ub_child(5)),   intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:,:,:), allocatable     :: tabtemp
+    integer :: i,j,k,l,m
+!
+    allocate(tabtemp(indmin(1):indmax(1), &
+                     indmin(2):indmax(2), &
+                     indmin(3):indmax(3), &
+                     indmin(4):indmax(4), &
+                     lb_child(5):ub_child(5)))
+!
+    do m = lb_child(5), ub_child(5)
+        call Agrif_Update_4D_Recursive(type_update(1:4),                    &
+                                       tabtemp(indmin(1):indmax(1),         &
+                                               indmin(2):indmax(2),         &
+                                               indmin(3):indmax(3),         &
+                                               indmin(4):indmax(4), m),     &
+                                       tempC(lb_child(1):ub_child(1),       &
+                                             lb_child(2):ub_child(2),       &
+                                             lb_child(3):ub_child(3),       &
+                                             lb_child(4):ub_child(4), m),   &
+                                       indmin(1:4),indmax(1:4),             &
+                                       lb_child(1:4), ub_child(1:4),        &
+                                        s_child(1:4), s_parent(1:4),        &
+                                       ds_child(1:4), ds_parent(1:4))
+    enddo
+!
+    tempP = 0.
+!
+    do l = indmin(4), indmax(4)
+    do k = indmin(3), indmax(3)
+    do j = indmin(2), indmax(2)
+    do i = indmin(1), indmax(1)
+        call Agrif_UpdateBase( type_update(5),                              &
+                               tempP(i,j,k,l,indmin(5):indmax(5)),          &
+                               tabtemp(i,j,k,l,lb_child(5):ub_child(5)),    &
+                               indmin(5), indmax(5),                        &
+                               lb_child(5), ub_child(5),                    &
+                                s_parent(5), s_child(5),                    &
+                               ds_parent(5),ds_child(5) )
+    enddo
+    enddo
+    enddo
+    enddo
+!
+    deallocate(tabtemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_5D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_6D_Recursive
+!
+!> Updates a 6D grid variable on the parent grid.
+!! Calls #Agrif_Update_5D_Recursive and #Agrif_UpdateBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_6D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(6),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(6),          intent(in)  :: indmin, indmax
+    integer, dimension(6),          intent(in)  :: lb_child, ub_child
+    real,    dimension(6),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(6),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2),     &
+        indmin(3):indmax(3),     &
+        indmin(4):indmax(4),     &
+        indmin(5):indmax(5),     &
+        indmin(6):indmax(6)),       intent(out) :: tempP
+    real, dimension(             &
+        lb_child(1):ub_child(1), &
+        lb_child(2):ub_child(2), &
+        lb_child(3):ub_child(3), &
+        lb_child(4):ub_child(4), &
+        lb_child(5):ub_child(5), &
+        lb_child(6):ub_child(6)),   intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:,:,:,:), allocatable   :: tabtemp
+    integer :: i,j,k,l,m,n
+!
+    allocate(tabtemp(indmin(1):indmax(1), &
+                     indmin(2):indmax(2), &
+                     indmin(3):indmax(3), &
+                     indmin(4):indmax(4), &
+                     indmin(5):indmax(5), &
+                     lb_child(6):ub_child(6)))
+!
+    do n = lb_child(6),ub_child(6)
+        call Agrif_Update_5D_Recursive(type_update(1:5),                    &
+                                       tabtemp(indmin(1):indmax(1),         &
+                                               indmin(2):indmax(2),         &
+                                               indmin(3):indmax(3),         &
+                                               indmin(4):indmax(4),         &
+                                               indmin(5):indmax(5), n),     &
+                                       tempC(lb_child(1):ub_child(1),       &
+                                             lb_child(2):ub_child(2),       &
+                                             lb_child(3):ub_child(3),       &
+                                             lb_child(4):ub_child(4),       &
+                                             lb_child(5):ub_child(5), n),   &
+                                       indmin(1:5), indmax(1:5),            &
+                                       lb_child(1:5),ub_child(1:5),         &
+                                       s_child(1:5), s_parent(1:5),         &
+                                      ds_child(1:5),ds_parent(1:5))
+    enddo
+!
+    tempP = 0.
+!
+    do m = indmin(5), indmax(5)
+    do l = indmin(4), indmax(4)
+    do k = indmin(3), indmax(3)
+    do j = indmin(2), indmax(2)
+    do i = indmin(1), indmax(1)
+        call Agrif_UpdateBase( type_update(6),                              &
+                               tempP(i,j,k,l,m,indmin(6):indmax(6)),        &
+                               tabtemp(i,j,k,l,m,lb_child(6):ub_child(6)),  &
+                               indmin(6), indmax(6),                        &
+                               lb_child(6),  ub_child(6),                   &
+                                s_parent(6),  s_child(6),                   &
+                               ds_parent(6), ds_child(6) )
+    enddo
+    enddo
+    enddo
+    enddo
+    enddo
+!
+    deallocate(tabtemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_6D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_UpdateBase
+!
+!> Calls the updating method chosen by the user (copy, average or full-weighting).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdateBase ( type_update,              &
+                              parent_tab, child_tab,    &
+                              indmin, indmax,           &
+                              lb_child, ub_child,       &
+                              s_parent, s_child,        &
+                              ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,                            intent(in) :: type_update
+    integer,                            intent(in) :: indmin, indmax
+    integer,                            intent(in) :: lb_child, ub_child
+    real, dimension(indmin:indmax),     intent(out):: parent_tab
+    real, dimension(lb_child:ub_child), intent(in) :: child_tab
+    real,                               intent(in) :: s_parent,  s_child
+    real,                               intent(in) :: ds_parent, ds_child
+!---------------------------------------------------------------------------------------------------
+    integer :: np       ! Length of parent array
+    integer :: nc       ! Length of child  array
+!
+    np = indmax - indmin + 1
+    nc = ub_child - lb_child + 1
+!
+    if     ( type_update == Agrif_Update_Copy ) then
+!
+        call Agrif_basicupdate_copy1d(              &
+                    parent_tab, child_tab,          &
+                    np,         nc,                 &
+                    s_parent,  s_child,             &
+                    ds_parent, ds_child )
+!
+    elseif ( type_update == Agrif_Update_Average ) then
+!
+        call Agrif_basicupdate_average1d(           &
+                    parent_tab, child_tab,          &
+                    np,         nc,                 &
+                     s_parent,  s_child,            &
+                    ds_parent, ds_child )
+!
+    elseif ( type_update == Agrif_Update_Full_Weighting ) then
+!
+        call Agrif_basicupdate_full_weighting1D(    &
+                    parent_tab, child_tab,          &
+                    np,         nc,                 &
+                    s_parent,  s_child,             &
+                    ds_parent, ds_child )
+!
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdateBase
+!===================================================================================================
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!  subroutine Agrif_Find_list_update
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Find_list_update ( list_update, pttab, petab, lb_child, lb_parent, nbdim, &
+                                    find_list_update, tab4t, tab5t, memberinall, memberinall2,   &
+                                    sendtoproc1, recvfromproc1, sendtoproc2, recvfromproc2 )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_List_Interp_Loc),                   pointer     :: list_update
+    INTEGER,                                       intent(in)  :: nbdim
+    INTEGER, DIMENSION(nbdim),                     intent(in)  :: pttab, petab
+    INTEGER, DIMENSION(nbdim),                     intent(in)  :: lb_child, lb_parent
+    LOGICAL,                                       intent(out) :: find_list_update
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab4t
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab5t
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: memberinall,memberinall2
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: sendtoproc1,recvfromproc1
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: sendtoproc2,recvfromproc2
+!
+    Type(Agrif_List_Interp_Loc), Pointer :: parcours
+    INTEGER :: i
+!
+    find_list_update = .FALSE.
+!
+    parcours => list_update
+
+    Find_loop :  do while ( associated(parcours) )
+        do i = 1,nbdim
+            IF ((pttab(i) /= parcours%interp_loc%pttab(i)) .OR. &
+                (petab(i) /= parcours%interp_loc%petab(i)) .OR. &
+                (lb_child(i)  /= parcours%interp_loc%pttab_child(i)) .OR. &
+                (lb_parent(i) /= parcours%interp_loc%pttab_parent(i))) THEN
+                parcours => parcours%suiv
+                cycle Find_loop
+            ENDIF
+        enddo
+!
+        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        memberinall  =  parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
+        memberinall2 =  parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1)
+        sendtoproc1 =   parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)
+        sendtoproc2 =   parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1)
+        recvfromproc1 = parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)
+        recvfromproc2 = parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1)
+!
+        find_list_update = .TRUE.
+        exit Find_loop
+!
+    enddo Find_loop
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Find_list_update
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_AddTo_list_update
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_AddTo_list_update ( list_update, pttab, petab, lb_child, lb_parent,  &
+                                     nbdim, tab4t, tab5t, memberinall, memberinall2,        &
+                                     sendtoproc1, recvfromproc1, sendtoproc2, recvfromproc2 )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_List_Interp_Loc), pointer :: list_update
+    INTEGER,                                        intent(in) :: nbdim
+    INTEGER, DIMENSION(nbdim),                      intent(in) :: pttab, petab
+    INTEGER, DIMENSION(nbdim),                      intent(in) :: lb_child, lb_parent
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8),  intent(in) :: tab4t
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8),  intent(in) :: tab5t
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),          intent(in) :: memberinall, memberinall2
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),          intent(in) :: sendtoproc1, recvfromproc1
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),          intent(in) :: sendtoproc2, recvfromproc2
+!
+    Type(Agrif_List_Interp_Loc), pointer :: parcours
+!
+    allocate(parcours)
+    allocate(parcours%interp_loc)
+
+    parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
+    parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
+    parcours%interp_loc%pttab_child(1:nbdim)  = lb_child(1:nbdim)
+    parcours%interp_loc%pttab_parent(1:nbdim) = lb_parent(1:nbdim)
+
+    allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
+    allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,8))
+
+    allocate(parcours%interp_loc%memberinall (0:Agrif_Nbprocs-1))
+    allocate(parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1))
+
+    allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))
+    allocate(parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1))
+    allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
+    allocate(parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1))
+
+    parcours%interp_loc%tab4t = tab4t
+    parcours%interp_loc%tab5t = tab5t
+    parcours%interp_loc%memberinall   = memberinall
+    parcours%interp_loc%memberinall2  = memberinall2
+    parcours%interp_loc%sendtoproc1   = sendtoproc1
+    parcours%interp_loc%sendtoproc2   = sendtoproc2
+    parcours%interp_loc%recvfromproc1 = recvfromproc1
+    parcours%interp_loc%recvfromproc2 = recvfromproc2
+
+    parcours%suiv => list_update
+    list_update => parcours
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Addto_list_update
+!===================================================================================================
+#endif
+!
+end module Agrif_Update
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F	(revision 5659)
+++ 	(revision )
@@ -1,659 +1,0 @@
-!
-! $Id$
-!
-C     AGRIF (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Updatebasic
-C      
-C
-      Module Agrif_Updatebasic
-C
-CCC   Description:
-CCC   Module containing different procedures of update (copy,average,
-CCC   full_weighting) used in the Agrif_Update module.
-C
-C     Modules used:
-C
-      USE Agrif_types
-      
-      IMPLICIT NONE
-      
-      integer,dimension(:,:),allocatable :: indchildcopy
-      integer,dimension(:,:),allocatable :: indchildaverage
-C             
-
-      CONTAINS
-C     Define procedures contained in this module
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Copy1d  
-C     ************************************************************************** 
-C
-      Subroutine agrif_copy1d(x,y,np,nc,
-     &                  s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do a copy on a parent grid (vector x) from its child grid 
-CCC   (vector y).  
-C
-CC    Method:
-C
-C     Declarations:
-C
-      
-C        
-C     Arguments
-      INTEGER             :: np,nc      
-      REAL, DIMENSION(np) :: x      
-      REAL, DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-C
-      if (coeffraf == 1) then
-C
-          locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
-C        
-!CDIR ALTCODE
-          x(1:np) = y(locind_child_left:locind_child_left+np-1)
-C
-          return
-C
-      endif
-C
-      
-      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
-      
-!CDIR ALTCODE
-      do i = 1,np
-C      
-         x(i) = y(locind_child_left)
-C
-         locind_child_left = locind_child_left + coeffraf
-C         
-      enddo    
-       
-C
-      Return 
-C
-C
-      End Subroutine agrif_copy1d
-
-C     **************************************************************************  
-CCC   Subroutine Copy1dprecompute  
-C     ************************************************************************** 
-C
-      Subroutine copy1dprecompute2d(nc2,np,nc,
-     &                  s_parent,s_child,ds_parent,ds_child,dir)
-C
-CCC   Description:
-CCC   Subroutine to precompute index for a copy on a parent grid (vector x) from
-CCC   its child grid (vector y).
-C
-CC    Method:
-C
-C     Declarations:
-C
-
-C        
-C     Arguments
-      INTEGER             :: nc2,np,nc
-      INTEGER             :: dir   
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER,DIMENSION(:,:),ALLOCATABLE :: indchildcopy_tmp
-      INTEGER :: i,locind_child_left,coeffraf
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-C
-      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
-
-      if (.not.allocated(indchildcopy)) then
-      allocate(indchildcopy(np*nc2,3))
-      else
-      if (size(indchildcopy,1)<np*nc2) then
-      allocate( indchildcopy_tmp(
-     &         size(indchildcopy,1),size(indchildcopy,2)))
-      indchildcopy_tmp = indchildcopy
-      deallocate(indchildcopy)
-      allocate(indchildcopy(np*nc2,3))
-      indchildcopy(1:size(indchildcopy_tmp,1),
-     &              1:size(indchildcopy_tmp,2)) = indchildcopy_tmp
-      deallocate(indchildcopy_tmp)
-      endif
-      endif
-
-
-      do i = 1,np
-C      
-         indchildcopy(i,dir) = locind_child_left
-         locind_child_left = locind_child_left + coeffraf
-C         
-      enddo
-
-      do i =2, nc2
-        indchildcopy(1+(i-1)*np:i*np,dir)=
-     &       indchildcopy(1+(i-2)*np:(i-1)*np,dir) + nc 
-      enddo
-
-C
-      Return
-C
-C
-      End Subroutine copy1dprecompute2d
-
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Copy1dprecompute  
-C     ************************************************************************** 
-C
-      Subroutine copy1dprecompute(np,nc,
-     &                  s_parent,s_child,ds_parent,ds_child,dir)
-C
-CCC   Description:
-CCC   Subroutine to precompute index for a copy on a parent grid (vector x) from
-CCC   its child grid (vector y).
-C
-CC    Method:
-C
-C     Declarations:
-C
-
-C        
-C     Arguments
-      INTEGER             :: np,nc
-      INTEGER             :: dir
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-C
-      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
-
-      if (.not.allocated(indchildcopy)) then
-      allocate(indchildcopy(np,1))
-      else
-      if (size(indchildcopy)<np) then
-      deallocate(indchildcopy)
-      allocate(indchildcopy(np,1))
-      endif
-      endif
-
-!CDIR ALTCODE
-      do i = 1,np
-C      
-         indchildcopy(i,1) = locind_child_left
-         locind_child_left = locind_child_left + coeffraf
-C         
-      enddo
-
-C
-      Return
-C
-C
-      End Subroutine copy1dprecompute
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Copy1daftercompute  
-C     ************************************************************************** 
-C
-      Subroutine copy1daftercompute(x,y,np,nc,
-     &                  s_parent,s_child,ds_parent,ds_child,dir)
-C
-CCC   Description:
-CCC   Subroutine to do a copy on a parent grid (vector x) from its child grid 
-CCC   (vector y) using precomputed index.  
-C
-CC    Method:
-C
-C     Declarations:
-C
-  
-C        
-C     Arguments
-      INTEGER             :: np,nc
-      INTEGER             :: dir
-      REAL, DIMENSION(np) :: x
-      REAL, DIMENSION(nc) :: y
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i
-C 
-C
-      
-!CDIR ALTCODE
-      do i = 1,np
-C      
-         x(i) = y(indchildcopy(i,dir))
-C
-      enddo
-  
-C
-      Return
-C
-C
-      End Subroutine copy1daftercompute
-
-
-C
-C     **************************************************************************  
-CCC   Subroutine Average1d  
-C     ************************************************************************** 
-C   
-      Subroutine average1d(x,y,np,nc,
-     &                     s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
-CCC   child grid (vector y).
-C
-C     Arguments
-      INTEGER             :: np,nc      
-      REAL, DIMENSION(np) :: x      
-      REAL, DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf,ii
-      REAL    :: xpos, invcoeffraf 
-      INTEGER :: nbnonnuls
-      INTEGER :: diffmod
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-      invcoeffraf = 1./coeffraf
-C
-      if (coeffraf == 1) then
-C
-          locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
-C        
-          x(1:np) = y(locind_child_left:locind_child_left+np-1)
-C
-          return
-C
-      endif
-C
-      xpos = s_parent      
-      
-      x = 0.
-C
-      diffmod = 0
-      
-      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
-
-        locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
-C
-      IF (Agrif_UseSpecialValueInUpdate) THEN
-
-      do i = 1,np
-          nbnonnuls = 0
-!CDIR NOVECTOR
-          Do ii = -coeffraf/2+locind_child_left+diffmod,
-     &                coeffraf/2+locind_child_left
-C 
-               IF (y(ii) .NE. Agrif_SpecialValueFineGrid) THEN
-               nbnonnuls = nbnonnuls + 1
-               x(i) = x(i) + y(ii)
-               ENDIF
-          End Do
-               IF (nbnonnuls .NE. 0) THEN
-                  x(i) = x(i)/nbnonnuls
-               ELSE
-                  x(i) = Agrif_SpecialValueFineGrid
-               ENDIF
-        locind_child_left = locind_child_left + coeffraf
-      enddo
-
-      ELSE 
-
-!CDIR ALTCODE
-      do i = 1,np
-!CDIR NOVECTOR
-          Do ii = -coeffraf/2+locind_child_left+diffmod,
-     &                coeffraf/2+locind_child_left
-C 
-               x(i) = x(i) + y(ii)
-          End Do
-                 x(i) = x(i)*invcoeffraf
-        locind_child_left = locind_child_left + coeffraf
-      enddo
-
-      ENDIF
-
-      Return 
-C            
-C     
-      End Subroutine average1d
-      
-      Subroutine average1dprecompute2d(nc2,np,nc,
-     &                     s_parent,s_child,ds_parent,ds_child,dir)
-C
-CCC   Description:
-CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
-CCC   child grid (vector y).
-C
-C     Arguments
-      INTEGER             :: nc2,np,nc,dir
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf,ii
-      INTEGER,DIMENSION(:,:),ALLOCATABLE :: indchildaverage_tmp
-      REAL    :: xpos, invcoeffraf
-      INTEGER :: nbnonnuls
-      INTEGER :: diffmod
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-C
-      xpos = s_parent
-C
-      diffmod = 0
-
-      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
-
-      locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
-
-      if (.not.allocated(indchildaverage)) then
-      allocate(indchildaverage(np*nc2,3))
-      else
-      if (size(indchildaverage,1)<np*nc2) then
-      allocate( indchildaverage_tmp(
-     &         size(indchildaverage,1),size(indchildaverage,2)))
-      indchildaverage_tmp = indchildaverage
-      deallocate(indchildaverage)
-      allocate(indchildaverage(np*nc2,3))
-      indchildaverage(1:size(indchildaverage_tmp,1),
-     &              1:size(indchildaverage_tmp,2)) = indchildaverage_tmp
-      deallocate(indchildaverage_tmp)
-      endif
-      endif
-
-      do i = 1,np
-        indchildaverage(i,dir)= -coeffraf/2+locind_child_left
-     &                                    +diffmod
-        locind_child_left = locind_child_left + coeffraf
-      enddo
-      do i = 2,nc2
-        indchildaverage(1+(i-1)*np:i*np,dir)= 
-     &                 indchildaverage(1+(i-2)*np:(i-1)*np,dir) + nc 
-      enddo
-
-      Return 
-C            
-C     
-      End Subroutine average1dprecompute2d
-      
-
-      Subroutine average1dprecompute(np,nc,
-     &                     s_parent,s_child,ds_parent,ds_child) 
-C
-CCC   Description:
-CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
-CCC   child grid (vector y).
-C
-C     Arguments
-      INTEGER             :: np,nc 
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf,ii
-      REAL    :: xpos, invcoeffraf 
-      INTEGER :: nbnonnuls
-      INTEGER :: diffmod
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-
-C
-      if (coeffraf == 1) then
-C
-          return
-C
-      endif
-            
-C
-      xpos = s_parent
-C
-      diffmod = 0
-      
-      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
-
-        locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
-
-      if (.not.allocated(indchildaverage)) then
-      allocate(indchildaverage(np,1))
-      else
-      if (size(indchildaverage,1)<np) then
-      deallocate(indchildaverage)
-      allocate(indchildaverage(np,1))
-      endif
-      endif
-      
-!CDIR ALTCODE
-      do i = 1,np
-C 
-        indchildaverage(i,1)=-coeffraf/2+locind_child_left+diffmod
-        locind_child_left = locind_child_left + coeffraf
-      enddo
-
-      Return 
-C            
-C     
-      End Subroutine average1dprecompute
-      
-      Subroutine average1daftercompute(x,y,np,nc,
-     &                     s_parent,s_child,ds_parent,ds_child,dir) 
-C
-CCC   Description:
-CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
-CCC   child grid (vector y).
-C
-C     Arguments
-      INTEGER             :: np,nc,dir      
-      REAL, DIMENSION(np) :: x      
-      REAL, DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf,ii,j
-      REAL    :: xpos, invcoeffraf 
-      REAL, PARAMETER :: one_third=1./3.
-      INTEGER, DIMENSION(np) :: nbnonnuls
-      INTEGER :: diffmod
-      REAL, DIMENSION(0:5) :: invcoeff=(/1.,1.,0.5,one_third,0.25,0.2/)
-C 
-C
-      coeffraf = nint(ds_parent/ds_child)
-      invcoeffraf = 1./coeffraf      
-C      
-C
-      IF (Agrif_UseSpecialValueInUpdate) THEN
-
-      nbnonnuls = 0
-      do  j =1, coeffraf
-          do i=1, np
-               IF (y(indchildaverage(i,dir) + j -1) .NE. 
-     &               Agrif_SpecialValueFineGrid) THEN
-               nbnonnuls(i) = nbnonnuls(i) + 1
-               x(i) = x(i) +  y(indchildaverage(i,dir) + j -1 )
-               ENDIF
-          End Do
-      enddo
-      do i=1,np
-      x(i)= x(i)*invcoeff(nbnonnuls(i)) 
-      enddo
-
-      ELSE
-!CDIR NOLOOPCHG
-      do  j =1, coeffraf
-!CDIR VECTOR
-          do i=1, np
-             x(i) = x(i) + y(indchildaverage(i,dir) + j -1 )
-          enddo
-      enddo
-       x = x * invcoeffraf
-      ENDIF
-
-      Return 
-C            
-C     
-      End Subroutine average1daftercompute            
-C
-C
-C
-C     **************************************************************************  
-CCC   Subroutine Full_weighting1d  
-C     **************************************************************************  
-C
-      Subroutine full_weighting1D(x,y,np,nc,
-     &                            s_parent,s_child,ds_parent,ds_child,
-     &                            coeffraf,locind_child_left) 
-C
-CCC   Description:
-CCC   Subroutine to do an update by full_weighting on a parent grid (vector x) 
-CCC   from its child grid (vector y).
-C 
-C     Arguments
-      INTEGER             :: np,nc      
-      REAL, DIMENSION(np) :: x      
-      REAL, DIMENSION(nc) :: y  
-      REAL                :: s_parent,s_child
-      REAL                :: ds_parent,ds_child
-C
-C     Local variables
-      INTEGER :: i,locind_child_left,coeffraf
-      REAL    :: xpos,sumweight,weight
-      INTEGER :: ii,diffmod
-      REAL :: xposfin
-      INTEGER :: it1,it2
-      INTEGER :: i1,i2
-      REAL :: invsumweight
-      REAL :: weights(-(coeffraf):coeffraf)
-      
-C
-C
-      if (coeffraf == 1) then
-C        
-          x(1:np) = y(locind_child_left:locind_child_left+np-1)
-C
-          return
-C
-      endif
-C
-      xpos = s_parent      
-      
-       x = 0.
-
-       xposfin = s_child + ds_child * (locind_child_left - 1)
-       IF (abs(xposfin - xpos).LT.0.001) THEN
-          diffmod = 0
-       ELSE
-          diffmod = 1
-       ENDIF
-C
-             
-      if (diffmod == 1) THEN
-        invsumweight=1./(2.*coeffraf**2)
-        do i=-coeffraf,-1
-          weights(i) = invsumweight*(2*(coeffraf+i)+1)
-        enddo
-        do i=0,coeffraf-1
-          weights(i)=weights(-(i+1))
-        enddo
-        it1 = -coeffraf
-        i1 = -(coeffraf-1)+locind_child_left
-        i2 = 2*coeffraf - 1
-      else
-      invsumweight=1./coeffraf**2
-      do i=-(coeffraf-1),0
-        weights(i) = invsumweight*(coeffraf + i)
-      enddo
-      do i=1,coeffraf-1
-        weights(i) = invsumweight*(coeffraf - i)
-      enddo
-        it1 = -(coeffraf-1)
-        i1 = -(coeffraf-1)+locind_child_left
-        i2 = 2*coeffraf - 2
-      endif
-
-      sumweight = 0                    
-      do i = 1,np
-C
-          it2 = it1
-          Do ii = i1,i1+i2
-C
-           IF (Agrif_UseSpecialValueInUpdate) THEN
-            IF (y(ii) .NE. Agrif_SpecialValueFineGrid) THEN
-               x(i) = x(i) + weights(it2)*y(ii)
-               sumweight = sumweight+weights(it2)
-            ENDIF
-           ELSE           
-               x(i) = x(i) + weights(it2)*y(ii)
-           ENDIF           
-           
-          it2 = it2+1
-          End Do
-
-           IF (Agrif_UseSpecialValueInUpdate) THEN          
-                 IF (sumweight .NE. 0.) THEN
-                    x(i) = x(i)/sumweight
-                    sumweight = 0
-                 ELSE
-                    x(i) = Agrif_SpecialValueFineGrid
-                 ENDIF
-           ENDIF
-        
-        i1 = i1 + coeffraf
-C
-      enddo    
-C
-
-      Return 
-C            
-C
-      End Subroutine full_weighting1D 
-
-C
-      End module AGRIF_updatebasic
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90	(revision 5682)
@@ -0,0 +1,434 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!
+!> Module containing different procedures of update (copy, average, full_weighting)
+!! used in the #Agrif_Update module.
+!===================================================================================================
+!
+module Agrif_UpdateBasic
+!
+    use Agrif_Types
+
+    implicit none
+
+    integer, dimension(:,:), allocatable :: indchildcopy
+    integer, dimension(:,:), allocatable :: indchildaverage
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_copy1d
+!
+!> Carries out a copy on a parent grid (vector x) from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_copy1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(out)    :: x            !< Coarse output data to parent
+    real, dimension(nc), intent(in)     :: y            !< Fine input data from child
+    integer,             intent(in)     :: np           !< Length of parent array
+    integer,             intent(in)     :: nc           !< Length of child  array
+    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
+    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
+    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
+    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
+!---------------------------------------------------------------------------------------------------
+    integer :: i, locind_child_left, coeffraf
+!
+    coeffraf = nint(ds_parent/ds_child)
+    locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+!
+    if ( coeffraf == 1 ) then
+!CDIR ALTCODE
+        x(1:np) = y(locind_child_left:locind_child_left+np-1)
+        return
+    endif
+!
+!CDIR ALTCODE
+    do i = 1,np
+        x(i) = y(locind_child_left)
+        locind_child_left = locind_child_left + coeffraf
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_copy1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_copy1d_before
+!
+!> Precomputes index for a copy on a parent grid (vector x) from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_copy1d_before ( nc2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: nc2          !< Length of parent array
+    integer,             intent(in)     :: np           !< Length of parent array
+    integer,             intent(in)     :: nc           !< Length of child  array
+    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
+    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
+    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
+    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
+    integer,             intent(in)     :: dir          !< Direction
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(:,:), allocatable    :: indchildcopy_tmp
+    integer :: i, n_old, locind_child_left, coeffraf
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+
+    if ( .not.allocated(indchildcopy) ) then
+        allocate(indchildcopy(np*nc2, 3))
+    else
+        n_old = size(indchildcopy,1)
+        if ( n_old < np*nc2 ) then
+            allocate( indchildcopy_tmp(1:n_old, 3))
+            indchildcopy_tmp = indchildcopy
+            deallocate(indchildcopy)
+            allocate(indchildcopy(np*nc2, 3))
+            indchildcopy(1:n_old,:) = indchildcopy_tmp
+            deallocate(indchildcopy_tmp)
+        endif
+    endif
+!
+    do i = 1,np
+        indchildcopy(i,dir) = locind_child_left
+        locind_child_left = locind_child_left + coeffraf
+    enddo
+!
+    do i = 2,nc2
+        indchildcopy(1+(i-1)*np:i*np,dir) = indchildcopy(1+(i-2)*np:(i-1)*np,dir) + nc
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_copy1d_before
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_copy1d_after
+!
+!> Carries out a copy on a parent grid (vector x) from its child grid (vector y)
+!! using precomputed index.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_copy1d_after ( x, y, np, nc, dir )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(out)    :: x            !< Coarse output data to parent
+    real, dimension(nc), intent(in)     :: y            !< Fine input data from child
+    integer,             intent(in)     :: np           !< Length of parent array
+    integer,             intent(in)     :: nc           !< Length of child  array
+    integer,             intent(in)     :: dir          !< Direction
+!---------------------------------------------------------------------------------------------------
+    integer :: i
+!
+!CDIR ALTCODE
+    do i = 1,np
+        x(i) = y(indchildcopy(i,dir))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_copy1d_after
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_average1d
+!
+!> Carries out an update by average on a parent grid (vector x)from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_average1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    REAL, DIMENSION(np), intent(out)    :: x
+    REAL, DIMENSION(nc), intent(in)     :: y
+    INTEGER,             intent(in)     :: np,nc
+    REAL,                intent(in)     :: s_parent,  s_child
+    REAL,                intent(in)     :: ds_parent, ds_child
+!
+    INTEGER :: i, ii, locind_child_left, coeffraf
+    REAL    :: xpos, invcoeffraf
+    INTEGER :: nbnonnuls
+    INTEGER :: diffmod
+!
+    coeffraf = nint(ds_parent/ds_child)
+    invcoeffraf = 1./coeffraf
+!
+    if (coeffraf == 1) then
+        locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+        x(1:np) = y(locind_child_left:locind_child_left+np-1)
+        return
+    endif
+!
+    xpos = s_parent
+    x = 0.
+!
+    diffmod = 0
+!
+    IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+!
+    locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+!
+    IF (Agrif_UseSpecialValueInUpdate) THEN
+        do i = 1,np
+            nbnonnuls = 0
+!CDIR NOVECTOR
+            do ii = -coeffraf/2+locind_child_left+diffmod, &
+                     coeffraf/2+locind_child_left
+                IF (y(ii) /= Agrif_SpecialValueFineGrid) THEN
+!                    nbnonnuls = nbnonnuls + 1
+                    x(i) = x(i) + y(ii)
+                ENDIF
+            enddo
+!            IF (nbnonnuls /= 0) THEN
+!                x(i) = x(i)/nbnonnuls
+!            ELSE
+!                x(i) = Agrif_SpecialValueFineGrid
+!            ENDIF
+            locind_child_left = locind_child_left + coeffraf
+        enddo
+    ELSE
+!
+!CDIR ALTCODE
+        do i = 1,np
+!CDIR NOVECTOR
+            do ii = -coeffraf/2+locind_child_left+diffmod, &
+                     coeffraf/2+locind_child_left
+                x(i) = x(i) + y(ii)
+            enddo
+!            x(i) = x(i)*invcoeffraf
+            locind_child_left = locind_child_left + coeffraf
+        enddo
+        IF (.not.Agrif_Update_Weights) THEN
+           x = x * invcoeffraf
+        ENDIF
+    ENDIF
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_average1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Average1dPrecompute
+!
+!> Carries out an update by average on a parent grid (vector x)from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Average1dPrecompute ( nc2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, intent(in) :: nc2, np, nc
+    REAL,    intent(in) :: s_parent,  s_child
+    REAL,    intent(in) :: ds_parent, ds_child
+    INTEGER, intent(in) :: dir
+!
+    INTEGER, DIMENSION(:,:), ALLOCATABLE :: indchildaverage_tmp
+    INTEGER :: i, locind_child_left, coeffraf
+    REAL    :: xpos
+    INTEGER :: diffmod
+!
+    coeffraf = nint(ds_parent/ds_child)
+    xpos = s_parent
+    diffmod = 0
+!
+    IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+!
+    locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+!
+    if (.not.allocated(indchildaverage)) then
+        allocate(indchildaverage(np*nc2,3))
+    else
+        if (size(indchildaverage,1)<np*nc2) then
+            allocate( indchildaverage_tmp(size(indchildaverage,1),size(indchildaverage,2)))
+            indchildaverage_tmp = indchildaverage
+            deallocate(indchildaverage)
+            allocate(indchildaverage(np*nc2,3))
+            indchildaverage(1:size(indchildaverage_tmp,1),1:size(indchildaverage_tmp,2)) = indchildaverage_tmp
+            deallocate(indchildaverage_tmp)
+        endif
+    endif
+!
+    do i = 1,np
+        indchildaverage(i,dir)= -coeffraf/2+locind_child_left+diffmod
+        locind_child_left = locind_child_left + coeffraf
+    enddo
+!
+    do i = 2,nc2
+        indchildaverage(1+(i-1)*np:i*np,dir) = indchildaverage(1+(i-2)*np:(i-1)*np,dir) + nc
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Average1dPrecompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Average1dAfterCompute
+!
+!> Carries out an update by average on a parent grid (vector x) from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Average1dAfterCompute ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    REAL, DIMENSION(np), intent(inout)  :: x
+    REAL, DIMENSION(nc), intent(in)     :: y
+    INTEGER,             intent(in)     :: np, nc
+    REAL,                intent(in)     :: s_parent,  s_child
+    REAL,                intent(in)     :: ds_parent, ds_child
+    INTEGER,             intent(in)     :: dir
+!
+    REAL    :: invcoeffraf
+    INTEGER :: i, j, coeffraf
+    INTEGER, DIMENSION(np) :: nbnonnuls
+    REAL, DIMENSION(0:7), parameter :: invcoeff = (/1.,1.,0.5,1./3.,0.25,0.2,1./6.,1./7./)
+!
+    coeffraf = nint(ds_parent/ds_child)
+    invcoeffraf = 1./coeffraf
+!
+    IF (Agrif_UseSpecialValueInUpdate) THEN
+!
+!        nbnonnuls = 0
+        do  j = 1,coeffraf
+            do i = 1,np
+                IF (y(indchildaverage(i,dir) + j -1) /= Agrif_SpecialValueFineGrid) THEN
+!                    nbnonnuls(i) = nbnonnuls(i) + 1
+                    x(i) = x(i) +  y(indchildaverage(i,dir) + j-1 )
+                ENDIF
+            enddo
+        enddo
+        do i=1,np
+  !          x(i) = x(i)*invcoeff(nbnonnuls(i))
+  !          if (nbnonnuls(i) == 0) x(i) = Agrif_SpecialValueFineGrid
+        enddo
+!
+    ELSE
+!
+!CDIR NOLOOPCHG
+        do  j = 1,coeffraf
+!CDIR VECTOR
+            do i= 1,np
+                x(i) = x(i) + y(indchildaverage(i,dir) + j-1 )
+            enddo
+        enddo
+        IF (.not.Agrif_Update_Weights) THEN
+           x = x * invcoeffraf
+        ENDIF
+!
+    ENDIF
+
+!---------------------------------------------------------------------------------------------------
+end subroutine Average1dAfterCompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_full_weighting1D
+!
+!> Carries out an update by full_weighting on a parent grid (vector x) from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_full_weighting1D ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(out)    :: x
+    real, dimension(nc), intent(in)     :: y
+    integer,             intent(in)     :: np, nc
+    real,                intent(in)     :: s_parent,  s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!---------------------------------------------------------------------------------------------------
+    REAL    :: xpos, xposfin
+    INTEGER :: i, ii, diffmod
+    INTEGER :: it1, it2
+    INTEGER :: i1,  i2
+    INTEGER :: coeffraf
+    INTEGER :: locind_child_left
+    REAL    :: sumweight, invsumweight
+    REAL    :: weights(-Agrif_MaxRaff:Agrif_MaxRaff)
+
+    coeffraf = nint(ds_parent/ds_child)
+    locind_child_left = 1 + agrif_int((s_parent-s_child)/ds_child)
+!
+    if (coeffraf == 1) then
+        x(1:np) = y(locind_child_left:locind_child_left+np-1)
+        return
+    endif
+!
+    xpos = s_parent
+    x = 0.
+!
+    xposfin = s_child + ds_child * (locind_child_left - 1)
+    IF (abs(xposfin - xpos) < 0.001) THEN
+        diffmod = 0
+    ELSE
+        diffmod = 1
+    ENDIF
+!
+    if (diffmod == 1) THEN
+        invsumweight=1./(2.*coeffraf**2)
+        do i = -coeffraf,-1
+            weights(i) = invsumweight*(2*(coeffraf+i)+1)
+        enddo
+        do i = 0,coeffraf-1
+            weights(i) = weights(-(i+1))
+        enddo
+        it1 = -coeffraf
+        i1 = -(coeffraf-1)+locind_child_left
+        i2 = 2*coeffraf - 1
+        
+    else
+        invsumweight=1./coeffraf**2
+        do i = -(coeffraf-1),0
+            weights(i) = invsumweight*(coeffraf + i)
+        enddo
+        do i=1,coeffraf-1
+            weights(i) = invsumweight*(coeffraf - i)
+        enddo
+        it1 = -(coeffraf-1)
+        i1 = -(coeffraf-1)+locind_child_left
+        i2 = 2*coeffraf - 2
+
+    endif
+!
+    sumweight = 0.
+    MYLOOP : do i = 1,np
+!
+        it2 = it1
+
+!    sumweight = 0.
+    
+        do ii = i1,i1+i2
+!
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+                IF (y(ii) /= Agrif_SpecialValueFineGrid) THEN
+                    x(i) = x(i) + weights(it2)*y(ii)
+!                    sumweight = sumweight+weights(it2)
+                ELSE
+                    x(i) = Agrif_SpecialValueFineGrid
+                    i1=i1+coeffraf
+                    CYCLE MYLOOP
+                ENDIF
+            ELSE
+                x(i) = x(i) + weights(it2)*y(ii)
+            ENDIF
+
+            it2 = it2+1
+!
+        enddo
+!
+        i1 = i1 + coeffraf
+!
+        enddo MYLOOP
+        
+        IF (Agrif_UseSpecialValueInUpdate) THEN
+          x = x * coeffraf ! x will be divided by coeffraf later in modupdate.F90
+        ENDIF
+        
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_full_weighting1D
+!===================================================================================================
+!
+end module Agrif_UpdateBasic
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F	(revision 5659)
+++ 	(revision )
@@ -1,864 +1,0 @@
-!
-! $Id$
-!
-C     Agrif (Adaptive Grid Refinement In Fortran)
-C
-C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
-C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
-C
-C     This program is free software; you can redistribute it and/or modify
-C     it under the terms of the GNU General Public License as published by
-C     the Free Software Foundation; either version 2 of the License, or
-C     (at your option) any later version.
-C
-C     This program is distributed in the hope that it will be useful,
-C     but WITHOUT ANY WARRANTY; without even the implied warranty of
-C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-C     GNU General Public License for more details.
-C
-C     You should have received a copy of the GNU General Public License
-C     along with this program; if not, write to the Free Software
-C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
-C
-C
-C
-CCC   Module Agrif_Util 
-C 
-      Module Agrif_Util 
-C
-C
-CCC   Description:   
-CCC   This module contains the two procedures called in the main program : 
-CCC   Agrif_Init_Grids allowing the initialization of the root coarse grid, and
-CCC   Agrif_Step allowing the creation of the grid hierarchy and the management
-CCC   of the time integration. 
-C
-C     Modules used:
-C
-      Use Agrif_Clustering    
-      Use Agrif_bcfunction
-C      
-      IMPLICIT NONE
-C
-      Contains
-C     Definition of procedures contained in this module.
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Step
-C     **************************************************************************
-C 
-      Subroutine Agrif_Step(procname) 
-C
-CCC   Description:
-CCC   Subroutine to create the grid hierarchy and to manage the time integration 
-CCC   procedure. It is called in the main program.
-C
-CC    Method:
-CC    Call on subroutines Agrif_Regrid and Agrif_Integrate.
-C
-C     Declarations:
-C
-      Optional :: procname
-      External :: procname
-C
-#ifdef key_mpp_mpi
-      INCLUDE 'mpif.h'
-      Integer      :: code, ierr
-      Logical      :: mpi_was_called
-C
-C
-      Call Agrif_comm_def(MPI_COMM_AGRIF)
-
-      CALL mpi_initialized ( mpi_was_called, code )
-      IF( code /= MPI_SUCCESS ) THEN
-         WRITE(*, *) ': Error in routine mpi_initialized'
-         CALL mpi_abort( mpi_comm_world, code, ierr )
-      ENDIF
-
-      IF( .NOT. mpi_was_called ) THEN
-         CALL mpi_comm_dup( mpi_comm_world, MPI_COMM_AGRIF, code)
-         IF( code /= MPI_SUCCESS ) THEN
-            WRITE(*, *) ' Agrif_Step: Error in routine mpi_comm_dup'
-            CALL mpi_abort( mpi_comm_world, code, ierr )
-         ENDIF
-      ENDIF
-
-      If (Agrif_Mygrid % ngridstep == 0) Then
-          Call MPI_COMM_SIZE(MPI_COMM_AGRIF,Agrif_Nbprocs,code)
-          Call MPI_COMM_RANK(MPI_COMM_AGRIF,Agrif_ProcRank,code)
-          Call MPI_COMM_GROUP(MPI_COMM_AGRIF,Agrif_Group,code)
-      endif
-#endif
-C
-C     Creation and initialization of the grid hierarchy 
-C
-C  
-C    Set the clustering variables
-C
-      Call Agrif_clustering_def()
-C      
-      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
-C     
-         If (Agrif_Mygrid % ngridstep == 0) then
-C
-            Call Agrif_Regrid
-C 
-            Call Agrif_Instance           
-     &          (Agrif_Mygrid)           
-         endif
-C
-      else
-C    
-         If (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then
-C
-            Call Agrif_Regrid
-C  
-            Call Agrif_Instance           
-     &          (Agrif_Mygrid)  
-C            
-         endif
-C
-      endif
-C
-C     Time integration of the grid hierarchy
-C
-      If (present(procname)) Then
-         Call Agrif_Integrate (Agrif_Mygrid,procname)
-      Else
-         Call Agrif_Integrate (Agrif_Mygrid)      
-      endif
-C    
-      If (associated(Agrif_Mygrid%child_grids)) 
-     &   Call Agrif_Instance (Agrif_Mygrid)
-C
-      Return
-C             
-      End Subroutine Agrif_Step      
-
-C     **************************************************************************
-CCC   Subroutine Agrif_Step_Child
-C     **************************************************************************
-C
-      Subroutine Agrif_Step_Child(procname)
-C
-CCC   Description:
-CCC   Subroutine to create the grid hierarchy and to manage the time integration
-CCC   procedure. It is called in the main program.
-C
-CC    Method:
-CC    Call on subroutines Agrif_Regrid and Agrif_Integrate.
-C
-C     Declarations:
-C
-      Optional :: procname
-      External :: procname
-C
-C     Time integration of the grid hierarchy
-C
-      If (present(procname)) Then
-         Call Agrif_Integrate_Child (Agrif_Mygrid,procname)
-      Else
-         Call Agrif_Integrate_Child (Agrif_Mygrid)
-      endif
-C    
-      If (associated(Agrif_Mygrid%child_grids))
-     &   Call Agrif_Instance (Agrif_Mygrid)
-C
-      Return
-C
-      End Subroutine Agrif_Step_Child
-
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Regrid
-C     **************************************************************************
-C
-      Subroutine Agrif_Regrid
-C
-CCC   Description:
-CCC   Subroutine to create the grid hierarchy from fixed grids and 
-CC       adaptive mesh refinement.
-C
-CC    Method:        
-C
-C     Declarations:
-C
-C     Local variables      
-      Type(Agrif_Rectangle), Pointer     :: coarsegrid_fixed
-      Type(Agrif_Rectangle), Pointer     :: coarsegrid_moving  
-      INTEGER                            :: j
-      INTEGER :: nunit
-      INTEGER                            :: iii
-      Logical :: BEXIST
-C 
-      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 )
-     &   Call Agrif_detect_all(Agrif_Mygrid) ! Detection of areas to be refined
-C
-      Allocate(coarsegrid_fixed)
-      Allocate(coarsegrid_moving)
-C
-      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) 
-     &    Call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering
-C
-      if ( Agrif_USE_FIXED_GRIDS .EQ. 1 .OR. 
-     &     Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
-C
-      If (Agrif_Mygrid % ngridstep == 0) Then
-          nunit = Agrif_Get_Unit()
-          open(nunit,file='AGRIF_FixedGrids.in',form='formatted',
-     &           status="old",ERR=99) ! Opening of the Agrif_FixedGrids.in file
-          j = 1
-C         Creation of the grid hierarchy from the Agrif_FixedGrids.in file 
-            do iii = 1 , Agrif_Probdim
-               coarsegrid_fixed % imin(iii) = 1
-               coarsegrid_fixed % imax(iii) = Agrif_Mygrid % nb(iii) + 1
-            enddo
-C      
-            Call Agrif_Read_Fix_Grd (coarsegrid_fixed,j,nunit)     
-            close(nunit) ! Closing of the Agrif_FixedGrids.in file 
-C
-          Nullify(Agrif_oldmygrid)
-          Nullify(Agrif_Mygrid  % child_grids)
-C        
-C         Creation of the grid hierarchy from coarsegrid_fixed
-            Call Agrif_Create_Grids (Agrif_Mygrid,coarsegrid_fixed)
-        Else        
-          Agrif_oldmygrid => Agrif_Mygrid % child_grids
-         endif
-      else
-      Agrif_oldmygrid => Agrif_Mygrid % child_grids
-      Nullify(Agrif_Mygrid  % child_grids)
-      endif
-C
-      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
-C
-      Call Agrif_Save_All(Agrif_oldmygrid)      
-C      
-      Call Agrif_Free_before_All(Agrif_oldmygrid)
-C 
-C     Creation of the grid hierarchy from coarsegrid_moving    
-      Call Agrif_Create_Grids
-     &     (Agrif_Mygrid,coarsegrid_moving)
-C
-      endif
-C
-C     Initialization of the grid hierarchy by copy or interpolation
-C
-      Call Agrif_Init_Hierarchy(Agrif_Mygrid)
-C
-      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) 
-     &        Call Agrif_Free_after_All(Agrif_oldmygrid)
-C
-      Deallocate(coarsegrid_fixed)
-      Deallocate(coarsegrid_moving)
-C      
-      Return
-C
-C     Opening error
-C
-   99 INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
-      If (.not. BEXIST) Then
-          print*,'ERROR : File AGRIF_FixedGrids.in not found.'
-          STOP 
-        Else
-          print*,'Error opening file AGRIF_FixedGrids.in'
-          STOP         
-      endif     
-C      
-      End Subroutine Agrif_Regrid
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_detect_All
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_detect_all(g)
-C
-CCC   Description:
-CCC   Subroutine to detect areas to be refined.
-C
-CC    Method:        
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      TYPE(Agrif_Grid) ,pointer  :: g        ! Pointer on the current grid
-C      
-C     Local variables
-      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
-                                             ! procedure      
-      INTEGER, DIMENSION(3)      :: size
-      INTEGER                    :: iii
-      Real :: g_eps     
-C
-      parcours => g % child_grids
-C  
-C     To be positioned on the finer grids of the grid hierarchy          
-C  
-      do while (associated(parcours))       
-         Call Agrif_detect_all (parcours % gr)  
-        parcours => parcours % next             
-      enddo
-C
-      g_eps = huge(1.)
-      do iii = 1 , Agrif_Probdim
-         g_eps=min(g_eps,g%Agrif_d(iii))
-      enddo
-C
-      g_eps = g_eps/100.
-C          
-      if ( Agrif_Probdim .EQ. 1 ) g%tabpoint1D=0
-      if ( Agrif_Probdim .EQ. 2 ) g%tabpoint2D=0
-      if ( Agrif_Probdim .EQ. 3 ) g%tabpoint3D=0
-C      
-      do iii = 1 , Agrif_Probdim
-         if (g%Agrif_d(iii)/Agrif_coeffref(iii).LT.
-     &                     (Agrif_mind(iii)-g_eps)) Return
-      enddo
-C                                       
-      Call Agrif_instance(g)
-C  
-C     Detection (Agrif_detect is a user s routine)
-C      
-     
-      do iii = 1 , Agrif_Probdim
-         size(iii) = g%nb(iii) + 1
-      enddo
-C
-      SELECT CASE (Agrif_Probdim)
-      CASE (1) 
-         Call Agrif_detect(g%tabpoint1D,size)
-      CASE (2) 
-         Call Agrif_detect(g%tabpoint2D,size)
-      CASE (3) 
-         Call Agrif_detect(g%tabpoint3D,size)
-      END SELECT
-C
-C     Addition of the areas detected on the child grids
-C      
-      parcours => g % child_grids 
-C           
-      Do while (associated(parcours))
-        Call Agrif_Add_detected_areas (g,parcours % gr)
-        parcours => parcours % next 
-      enddo
-C     
-      Return      
-C
-      End Subroutine Agrif_detect_all
-C      
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Add_detected_areas
-C     **************************************************************************
-C      
-      Subroutine Agrif_Add_detected_areas(parentgrid,childgrid)
-C
-CCC   Description:
-CCC   Subroutine to add on the parent grid the areas detected 
-CC       on its child grids.
-C
-CC    Method:        
-C
-C     Declarations:
-C
-      
-C 
-      Type(Agrif_Grid),pointer   :: parentgrid,childgrid
-C      
-      Integer :: i,j,k
-C
-      do i = 1,childgrid%nb(1)+1
-         if ( Agrif_Probdim .EQ. 1 ) then
-            If (childgrid%tabpoint1D(i).EQ.1) Then
-                parentgrid%tabpoint1D(childgrid%ix(1)+
-     &                 (i-1)/Agrif_Coeffref(1)) = 1
-            endif
-         else
-            do j=1,childgrid%nb(2)+1
-               if (Agrif_Probdim.EQ.2) then
-              If (childgrid%tabpoint2D(i,j).EQ.1) Then
-                  parentgrid%tabpoint2D(
-     &                  childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
-     &                  childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1
-                  endif
-               else
-                  do k=1,childgrid%nb(3)+1
-                If (childgrid%tabpoint3D(i,j,k).EQ.1) Then
-                    parentgrid%tabpoint3D(
-     &                     childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
-     &                     childgrid%ix(2)+(j-1)/Agrif_Coeffref(2),
-     &                     childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1
-                     endif
-                  enddo
-               endif
-            enddo
-         endif
-      enddo
-C      
-      Return
-C
-      End Subroutine Agrif_Add_detected_areas   
-C      
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Free_before_All
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Free_before_All(g)
-C
-CCC   Description:
-C
-CC    Method:        
-C
-C     Declarations:
-C
-C     Pointer argument    
-      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid
-C
-C     Local pointer
-      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
-                                             ! procedure      
-C
-C
-      parcours => g        
-C      
-      Do while (associated(parcours))     
-        If (.not. parcours%gr%fixed) Then
-            Call Agrif_Free_data_before(parcours%gr)
-            parcours % gr % oldgrid = .TRUE.        
-        endif
-C
-        Call Agrif_Free_before_all (parcours % gr % child_grids)
-C  
-        parcours => parcours % next             
-      enddo
-C     
-      Return      
-C
-C
-      End Subroutine Agrif_Free_before_All
-C     **************************************************************************
-CCC   Subroutine Agrif_Save_All
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Save_All(g)
-C
-CCC   Description:
-C
-CC    Method:        
-C
-C     Declarations:
-C
-C     Pointer argument    
-      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid
-C
-C     Local pointer
-      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
-                                             ! procedure      
-C
-C
-      parcours => g        
-C      
-      Do while (associated(parcours))     
-        If (.not. parcours%gr%fixed) Then
-            Call Agrif_Instance(parcours%gr)
-            Call Agrif_Before_Regridding()
-            parcours % gr % oldgrid = .TRUE.        
-        endif
-C
-        Call Agrif_Save_All (parcours % gr % child_grids)
-C  
-        parcours => parcours % next             
-      enddo
-C     
-      Return      
-C
-C
-      End Subroutine Agrif_Save_All      
-C
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Free_after_All
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Free_after_All(g)
-C
-CCC   Description:
-C
-CC    Method:        
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      Type(Agrif_pgrid),pointer   :: g       ! Pointer on the current grid
-C
-C     Local pointers
-      TYPE(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive proced
-      Type(Agrif_pgrid),pointer  :: preparcours   
-      Type(Agrif_pgrid),pointer  :: preparcoursini 
-C
-C
-      Allocate(preparcours)
-C 
-      preparcoursini => preparcours
-C 
-      Nullify(preparcours % gr)
-C 
-      preparcours % next => g
-C
-      parcours => g
-C      
-      Do while (associated(parcours))
-C
-         if ( (.NOT. parcours% gr% fixed) .AND.
-     &        (parcours% gr% oldgrid    ) ) then
-          Call Agrif_Free_data_after(parcours%gr)
-         endif
-C
-         Call Agrif_Free_after_all (parcours % gr % child_grids)
-C
-      If (parcours % gr % oldgrid) Then
-          Deallocate(parcours % gr)
-          preparcours % next => parcours % next
-          Deallocate(parcours)
-          parcours => preparcours % next
-        Else
-          preparcours => preparcours % next
-          parcours => parcours % next 
-         endif       
-      enddo
-C
-      Deallocate(preparcoursini)
-C     
-      Return      
-C
-      End Subroutine Agrif_Free_after_All
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Integrate
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Integrate(g, procname)         
-C
-CCC   Description:
-CCC   Subroutine to manage the time integration of the grid hierarchy.
-C
-CC    Method:
-CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step
-C
-C     Declarations:
-C
-      
-C      
-C     Pointer argument    
-      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
-C
-C     main procedure name
-      Optional :: procname
-      External :: procname      
-C      
-C     Local pointer
-      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
-                                             ! procedure
-C
-C     Local scalars
-      INTEGER                    :: nbt      ! Number of time steps 
-                                             ! of the current grid
-      INTEGER                    :: k        
-      INTEGER                    :: iii
-C  
-C     Instanciation of the variables of the current grid
-      If (g%fixedrank .NE.0) Then      
-      Call Agrif_Instance
-     &     (g)
-      End If
-C       
-C     One step on the current grid      
-C
-      If (present(procname)) Then
-         Call procname ()      
-      Else
-        write(*,*) 'The name of the step subroutine has not '
-        write(*,*) 'been given in the subroutine Agrif_Integrate'
-        stop
-      endif
-C
-C     Number of time steps on the current grid      
-C
-      g%ngridstep = g % ngridstep + 1
-C      
-      parcours => g % child_grids
-C    
-C     Recursive procedure for the time integration of the grid hierarchy      
-      Do while (associated(parcours))
-C
-C       Instanciation of the variables of the current grid            
-        Call Agrif_Instance
-     &           (parcours % gr)
-C       
-C       Number of time steps
-        nbt = 1
-        do iii = 1 , Agrif_Probdim
-           nbt = max(nbt, parcours % gr % timeref(iii))
-        enddo
-C       
-        Do k = 1,nbt
-C       
-           If (present(procname)) Then
-                 Call Agrif_Integrate (parcours % gr, procname)
-           Else
-                 Call Agrif_Integrate (parcours % gr)      
-           endif
-C       
-        enddo     
-C  
-        parcours => parcours % next
-C     
-      enddo
-C
-C      
-      End Subroutine Agrif_Integrate 
-
-C     **************************************************************************
-CCC   Subroutine Agrif_Integrate_Child
-C     **************************************************************************
-C
-      Recursive Subroutine Agrif_Integrate_Child(g,procname)
-C
-CCC   Description:
-CCC   Subroutine to manage the time integration of the grid hierarchy.
-C
-CC    Method:
-CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
-C
-C     Declarations:
-C
-
-C
-C     Pointer argument
-      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
-C
-C     main procedure name
-      Optional :: procname
-      External :: procname
-C
-C     Local pointer
-      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
-                                             ! procedure
-C
-C     One step on the current grid
-C
-      If (present(procname)) Then
-         Call procname ()      
-      Else
-        write(*,*) 'The name of the step subroutine has not '
-        write(*,*) 'been given in the subroutine Agrif_Integrate'
-        stop
-      endif
-C
-C     Number of time steps on the current grid
-C
-C
-      parcours => g % child_grids
-C
-C     Recursive procedure for the time integration of the grid hierarchy      
-      Do while (associated(parcours))
-C
-C       Instanciation of the variables of the current grid
-        Call Agrif_Instance
-     &           (parcours % gr)
-
-C       
-           If (present(procname)) Then
-                 Call Agrif_Integrate_Child (parcours % gr, procname)
-           Else
-                 Call Agrif_Integrate_Child (parcours % gr)
-           endif
-C  
-        parcours => parcours % next
-C     
-      enddo
-C
-C
-      End Subroutine Agrif_Integrate_Child
-
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Init_Grids
-C     **************************************************************************
-C      
-      Subroutine Agrif_Init_Grids
-C
-CCC   Description:
-CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
-CCC   It is called in the main program.
-C
-C     Declarations:
-C
-C
-      INTEGER :: iii
-C
-C             definition of the probdim and modtypes variables
-C
-#ifdef key_mpp_mpi
-      INCLUDE 'mpif.h'
-      Agrif_MPIPREC = MPI_DOUBLE_PRECISION
-#endif
-      Call Agrif_probdim_modtype_def()
-C      
-      Agrif_UseSpecialValue = .FALSE.
-      Agrif_UseSpecialValueFineGrid = .FALSE.
-      Agrif_SpecialValue = 0.
-      Agrif_SpecialValueFineGrid = 0.
-C      
-C     Allocation of Agrif_Mygrid
-      allocate(Agrif_Mygrid)
-C      
-C     Space and time refinement factors are set to 1 on the root grid
-C
-      do iii = 1 , Agrif_Probdim
-         Agrif_Mygrid % spaceref(iii) = 1
-         Agrif_Mygrid % timeref(iii) = 1
-      enddo
-C      
-C     Initialization of the number of time steps    
-      Agrif_Mygrid % ngridstep = 0
-      Agrif_Mygrid % grid_id = 0
-C
-C     No parent grid for the root coarse grid
-      Nullify(Agrif_Mygrid % parent)
-C      
-C     Initialization of the minimum positions, global abscissa and space steps  
-      do iii= 1 ,  Agrif_Probdim
-         Agrif_Mygrid % ix(iii) = 1            
-         Agrif_Mygrid % Agrif_x(iii) = 0.
-         Agrif_Mygrid % Agrif_d(iii) = 1. 
-C     Borders of the root coarse grid 
-         Agrif_Mygrid % NearRootBorder(iii) = .true.  
-         Agrif_Mygrid % DistantRootBorder(iii) = .true.      
-      enddo
-C  
-C     The root coarse grid is a fixed grid
-      Agrif_Mygrid % fixed = .TRUE.
-C     Level of the root grid
-      Agrif_Mygrid % level = 0
-C     Maximum level in the hierarchy
-      Agrif_MaxLevelLoc = 0
-      
-C      
-C     Number of the grid pointed by Agrif_Mygrid (root coarse grid)
-      Agrif_Mygrid % rank = 1      
-C 
-C     Number of the root grid as a fixed grid   
-      Agrif_Mygrid % fixedrank = 0  
-C 
-C     Initialization of some fields of the root grid variables     
-      Call Agrif_Create_Var (Agrif_Mygrid)
-C      
-C     Initialization of the other fields of the root grid variables (number of 
-C     cells, positions, number and type of its dimensions, ...)  
-      Call Agrif_Set_numberofcells(Agrif_Mygrid)
-C      
-      Call Agrif_Instance (Agrif_Mygrid)        
-C
-      Call Agrif_Set_numberofcells(Agrif_Mygrid)          
-C             
-C     Allocation of the array containing the values of the grid variables
-      Call Agrif_Allocation (Agrif_Mygrid)
-C        
-      Call Agrif_initialisations(Agrif_Mygrid)    
-C      
-      nullify(Agrif_Mygrid % child_grids)
-C 
-C     Total number of fixed grids   
-      Agrif_nbfixedgrids = 0         
-C      
-      Call Agrif_Instance (Agrif_Mygrid)
-C        
-      End Subroutine Agrif_Init_Grids  
-C
-C
-C     **************************************************************************
-CCC   Subroutine Agrif_Deallocation
-C     **************************************************************************
-C      
-      Subroutine Agrif_Deallocation
-C
-CCC   Description:
-CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
-CCC   It is called in the main program.
-C
-C     Declarations:
-C
-C
-      INTEGER :: nb
-C
-C             definition of the probdim and modtypes variables
-C
-      do nb = 1, Agrif_NbVariables
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array1) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array1)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array2) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array2)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array3) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array3)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array4) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array4)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array5) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array5)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array6) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array6)
-C
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray1) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray1)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray2) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray2)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray3) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray3)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray4) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray4)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray5) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray5)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray6) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray6)
-C
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray1) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray1)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray2) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray2)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray3) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray3)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray4) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray4)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray5) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray5)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray6) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray6)
-C
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray1) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray1)
-          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray2) ) 
-     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray2)
-      enddo
-C
-      do nb = 1, Agrif_NbVariables
-        Deallocate(Agrif_Mygrid % tabvars(nb) % var)
-      enddo
-C
-      Deallocate(Agrif_Mygrid % tabvars)
-C
-      Deallocate(Agrif_Mygrid)
-C
-      End Subroutine  Agrif_Deallocation 
-C
-      End module Agrif_Util 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90	(revision 5682)
@@ -0,0 +1,1108 @@
+!
+! $Id$
+!
+!     Agrif (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+!
+!> Module Agrif_Util
+!!
+!! This module contains the two procedures called in the main program :
+!! - #Agrif_Init_Grids allows the initialization of the root coarse grid
+!! - #Agrif_Step allows the creation of the grid hierarchy and the management of the time integration.
+!
+module Agrif_Util
+!
+    use Agrif_Clustering
+    use Agrif_BcFunction
+    use Agrif_seq
+!
+    implicit none
+!
+    abstract interface
+        subroutine step_proc()
+        end subroutine step_proc
+    end interface
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Step
+!
+!> Creates the grid hierarchy and manages the time integration procedure.
+!> It is called in the main program.
+!> Calls subroutines #Agrif_Regrid and #Agrif_Integrate.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Step ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)    :: procname     !< subroutine to call on each grid
+    type(agrif_grid), pointer :: ref_grid
+!
+! Set the clustering variables
+    call Agrif_clustering_def()
+!
+! Creation and initialization of the grid hierarchy
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
+!
+        if ( (Agrif_Mygrid % ngridstep == 0) .AND. (.not. Agrif_regrid_has_been_done) ) then
+            call Agrif_Regrid()
+            Agrif_regrid_has_been_done = .TRUE.
+        endif
+!
+    else
+!
+        if (mod(Agrif_Mygrid % ngridstep,Agrif_Regridding) == 0) then
+            call Agrif_Regrid()
+        endif
+!
+    endif
+!
+! Time integration of the grid hierarchy
+    if (agrif_coarse) then
+      ref_grid => agrif_coarsegrid
+    else
+      ref_grid => agrif_mygrid
+    endif
+    if ( Agrif_Parallel_sisters ) then
+        call Agrif_Integrate_Parallel(ref_grid,procname)
+    else
+        call Agrif_Integrate(ref_grid,procname)
+    endif
+!
+    if ( ref_grid%child_list%nitems > 0 ) call Agrif_Instance(ref_grid)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Step
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Step_Child
+!
+!> Apply 'procname' to each grid of the hierarchy
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Step_Child ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)    :: procname     !< subroutine to call on each grid
+!
+    if ( Agrif_Parallel_sisters ) then
+        call Agrif_Integrate_Child_Parallel(Agrif_Mygrid,procname)
+    else
+        call Agrif_Integrate_Child(Agrif_Mygrid,procname)
+    endif
+!
+    if ( Agrif_Mygrid%child_list%nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Step_Child
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Regrid
+!
+!> Creates the grid hierarchy from fixed grids and adaptive mesh refinement.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Regrid ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(init_proc), optional    :: procname     !< Initialisation subroutine (Default: Agrif_InitValues)
+!
+    type(Agrif_Rectangle), pointer     :: coarsegrid_fixed
+    type(Agrif_Rectangle), pointer     :: coarsegrid_moving
+    integer                            :: i, j
+    integer :: nunit
+    logical :: BEXIST
+    TYPE(Agrif_Rectangle)            :: newrect    ! Pointer on a new grid
+    integer :: is_coarse, rhox, rhoy, rhoz, rhot
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) &
+        call Agrif_detect_all(Agrif_Mygrid)     ! Detection of areas to be refined
+!
+    allocate(coarsegrid_fixed)
+    allocate(coarsegrid_moving)
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) &
+        call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering
+!
+    if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
+!
+        if (Agrif_Mygrid % ngridstep == 0) then
+!            
+            nunit = Agrif_Get_Unit()
+            open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=99)
+            if (agrif_coarse) then ! SKIP the coarse grid declaration
+                if (Agrif_Probdim == 3) then
+                    read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot
+                elseif (Agrif_Probdim == 2) then
+                    read(nunit,*) is_coarse, rhox, rhoy, rhot
+                elseif (Agrif_Probdim == 2) then
+                    read(nunit,*) is_coarse, rhox, rhot
+                endif
+            endif
+!           Creation of the grid hierarchy from the Agrif_FixedGrids.in file
+            do i = 1,Agrif_Probdim
+                coarsegrid_fixed % imin(i) = 1
+                coarsegrid_fixed % imax(i) = Agrif_Mygrid % nb(i) + 1
+            enddo
+            j = 1
+            call Agrif_Read_Fix_Grd(coarsegrid_fixed,j,nunit)
+            close(nunit)
+!
+            call Agrif_gl_clear(Agrif_oldmygrid)
+!
+!           Creation of the grid hierarchy from coarsegrid_fixed
+            call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_fixed)
+            
+        else
+            call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list)
+        endif
+    else
+        call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list)
+        call Agrif_gl_clear(Agrif_Mygrid % child_list)
+    endif
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+!
+        call Agrif_Save_All(Agrif_oldmygrid)
+        call Agrif_Free_before_All(Agrif_oldmygrid)
+!
+!       Creation of the grid hierarchy from coarsegrid_moving
+        call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_moving)
+!
+    endif
+!
+!   Initialization of the grid hierarchy by copy or interpolation
+!
+#if defined AGRIF_MPI
+    if ( Agrif_Parallel_sisters ) then
+        call Agrif_Init_Hierarchy_Parallel_1(Agrif_Mygrid)
+        call Agrif_Init_Hierarchy_Parallel_2(Agrif_Mygrid,procname)
+    else
+        call Agrif_Init_Hierarchy(Agrif_Mygrid,procname)
+    endif
+#else
+        call Agrif_Init_Hierarchy(Agrif_Mygrid,procname)
+#endif
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) call Agrif_Free_after_All(Agrif_oldmygrid)
+!
+    Agrif_regrid_has_been_done = .TRUE.
+!
+    call Agrif_Instance( Agrif_Mygrid )
+!
+    deallocate(coarsegrid_fixed)
+    deallocate(coarsegrid_moving)
+!
+    return
+!
+!     Opening error
+!
+99  INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
+    if (.not. BEXIST) then
+        print*,'ERROR : File AGRIF_FixedGrids.in not found.'
+        STOP
+    else
+        print*,'Error opening file AGRIF_FixedGrids.in'
+        STOP
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Regrid
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_detect_All
+!
+!> Detects areas to be refined.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_detect_all ( g )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid),  pointer  :: g        !< Pointer on the current grid
+!
+    Type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    integer, DIMENSION(3)       :: size
+    integer                     :: i
+    real                        :: g_eps
+!
+    parcours => g % child_list % first
+!
+!   To be positioned on the finer grids of the grid hierarchy
+!
+    do while (associated(parcours))
+        call Agrif_detect_all(parcours % gr)
+        parcours => parcours % next
+    enddo
+!
+    g_eps = huge(1.)
+    do i = 1,Agrif_Probdim
+        g_eps = min(g_eps, g % Agrif_dx(i))
+    enddo
+!
+    g_eps = g_eps / 100.
+!
+    if ( Agrif_Probdim == 1 ) g%tabpoint1D = 0
+    if ( Agrif_Probdim == 2 ) g%tabpoint2D = 0
+    if ( Agrif_Probdim == 3 ) g%tabpoint3D = 0
+!
+    do i = 1,Agrif_Probdim
+        if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps) ) return
+    enddo
+!
+    call Agrif_instance(g)
+!
+!   Detection (Agrif_detect is a users routine)
+!
+    do i = 1,Agrif_Probdim
+        size(i) = g % nb(i) + 1
+    enddo
+!
+    SELECT CASE (Agrif_Probdim)
+    CASE (1)
+        call Agrif_detect(g%tabpoint1D,size)
+    CASE (2)
+        call Agrif_detect(g%tabpoint2D,size)
+    CASE (3)
+        call Agrif_detect(g%tabpoint3D,size)
+    END SELECT
+!
+!   Addition of the areas detected on the child grids
+!
+    parcours => g % child_list % first
+!
+    do while (associated(parcours))
+        call Agrif_Add_detected_areas(g,parcours % gr)
+        parcours => parcours % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_detect_all
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Add_detected_areas
+!
+!> Adds on the parent grid the areas detected on its child grids
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Add_detected_areas ( parentgrid, childgrid )
+!---------------------------------------------------------------------------------------------------
+    Type(Agrif_Grid), pointer   :: parentgrid
+    Type(Agrif_Grid), pointer   :: childgrid
+!
+    integer :: i,j,k
+!
+    do i = 1,childgrid%nb(1)+1
+        if ( Agrif_Probdim == 1 ) then
+            if (childgrid%tabpoint1D(i)==1) then
+                parentgrid%tabpoint1D(childgrid%ix(1)+(i-1)/Agrif_Coeffref(1)) = 1
+            endif
+        else
+            do j=1,childgrid%nb(2)+1
+                if (Agrif_Probdim==2) then
+                    if (childgrid%tabpoint2D(i,j)==1) then
+                        parentgrid%tabpoint2D(                       &
+                            childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), &
+                            childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1
+                    endif
+                else
+                    do k=1,childgrid%nb(3)+1
+                        if (childgrid%tabpoint3D(i,j,k)==1) then
+                            parentgrid%tabpoint3D(                       &
+                                childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), &
+                                childgrid%ix(2)+(j-1)/Agrif_Coeffref(2), &
+                                childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1
+                        endif
+                    enddo
+                endif
+            enddo
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Add_detected_areas
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_before_All
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Free_before_All ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    Type(Agrif_Grid_List), intent(inout)    :: gridlist !< Grid list
+!
+    Type(Agrif_PGrid), pointer   :: parcours ! Pointer for the recursive procedure
+!
+    parcours => gridlist % first
+!
+    do while (associated(parcours))
+!
+        if (.not. parcours%gr%fixed) then
+            call Agrif_Free_data_before(parcours%gr)
+            parcours % gr % oldgrid = .TRUE.
+        endif
+!
+        call Agrif_Free_before_all (parcours % gr % child_list)
+!
+        parcours => parcours % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_before_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_All
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Save_All ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(inout)    :: gridlist !< Grid list
+!
+    type(Agrif_PGrid), pointer   :: parcours ! Pointer for the recursive procedure
+!
+    parcours => gridlist % first
+!
+    do while (associated(parcours))
+!
+        if (.not. parcours%gr%fixed) then
+            call Agrif_Instance(parcours%gr)
+            call Agrif_Before_Regridding()
+            parcours % gr % oldgrid = .TRUE.
+        endif
+!
+        call Agrif_Save_All(parcours % gr % child_list)
+!
+        parcours => parcours % next
+!
+      enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_after_All
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Free_after_All ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    Type(Agrif_Grid_List), intent(inout)    :: gridlist       !< Grid list to free
+!
+    Type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive proced
+    Type(Agrif_PGrid), pointer  :: preparcours
+    Type(Agrif_PGrid), pointer  :: preparcoursini
+!
+    allocate(preparcours)
+!
+    preparcoursini => preparcours
+!
+    nullify(preparcours % gr)
+!
+    preparcours % next => gridlist % first
+    parcours => gridlist % first
+!
+    do while (associated(parcours))
+!
+        if ( (.NOT. parcours%gr % fixed) .AND. (parcours%gr % oldgrid) ) then
+            call Agrif_Free_data_after(parcours%gr)
+        endif
+!
+        call Agrif_Free_after_all( parcours%gr % child_list )
+!
+        if (parcours % gr % oldgrid) then
+            deallocate(parcours % gr)
+            preparcours % next => parcours % next
+            deallocate(parcours)
+            parcours => preparcours % next
+        else
+            preparcours => preparcours % next
+            parcours => parcours % next
+        endif
+!
+    enddo
+!
+    deallocate(preparcoursini)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_after_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate
+!
+!> Manages the time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    integer                     :: nbt      ! Number of time steps of the current grid
+    integer                     :: i, k
+!
+!   Instanciation of the variables of the current grid
+!    if ( g % fixedrank /= 0 ) then
+        call Agrif_Instance(g)
+!    endif
+!
+!   One step on the current grid
+!
+    call procname ()
+!
+!   Number of time steps on the current grid
+!
+    g%ngridstep = g % ngridstep + 1
+    parcours => g % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!       Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+!
+!       Number of time steps
+        nbt = 1
+        do i = 1,Agrif_Probdim
+            nbt = max(nbt, parcours % gr % timeref(i))
+        enddo
+!
+        do k = 1,nbt
+            call Agrif_Integrate(parcours % gr, procname)
+        enddo
+!
+        parcours => parcours % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_Parallel
+!
+!> Manages the time integration of the grid hierarchy in parallel
+!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_Parallel ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+#if defined AGRIF_MPI
+    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
+    integer                     :: nbt      ! Number of time steps of the current grid
+    integer                     :: i, k, is
+!
+!   Instanciation of the variables of the current grid
+    if ( g % fixedrank /= 0 ) then
+        call Agrif_Instance(g)
+    endif
+!
+! One step on the current grid
+    call procname ()
+!
+! Number of time steps on the current grid
+    g % ngridstep = g % ngridstep + 1
+!
+! Continue only if the grid has defined sequences of child integrations.
+    if ( .not. associated(g % child_seq) ) return
+!
+    do is = 1, g % child_seq % nb_seqs
+!
+!     For each sequence, a given processor does integrate only on grid.
+        gridp => Agrif_seq_select_child(g,is)
+!
+!     Instanciation of the variables of the current grid
+        call Agrif_Instance(gridp % gr)
+!
+!     Number of time steps
+        nbt = 1
+        do i = 1,Agrif_Probdim
+            nbt = max(nbt, gridp % gr % timeref(i))
+        enddo
+!
+        do k = 1,nbt
+            call Agrif_Integrate_Parallel(gridp % gr, procname)
+        enddo
+!
+    enddo
+#else
+    call Agrif_Integrate( g, procname )
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_Parallel
+!===================================================================================================
+!
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_ChildGrids
+!
+!> Manages the time integration of the grid hierarchy.
+!! Call the subroutine procname on each child grid of the current grid
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_ChildGrids ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    integer                     :: nbt      ! Number of time steps of the current grid
+    integer                     :: i, k, is
+    type(Agrif_Grid)                    , pointer :: save_grid
+    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
+    
+    save_grid => Agrif_Curgrid
+
+! Number of time steps on the current grid
+    save_grid % ngridstep = save_grid % ngridstep + 1
+    
+#ifdef AGRIF_MPI
+    if ( .not. Agrif_Parallel_sisters ) then
+#endif
+    parcours => save_grid % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!       Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+!
+!       Number of time steps
+        nbt = 1
+        do i = 1,Agrif_Probdim
+            nbt = max(nbt, parcours % gr % timeref(i))
+        enddo
+!
+        do k = 1,nbt
+            call procname()
+        enddo
+!
+        parcours => parcours % next
+!
+    enddo
+
+#ifdef AGRIF_MPI
+    else
+#endif    
+! Continue only if the grid has defined sequences of child integrations.
+    if ( .not. associated(save_grid % child_seq) ) return
+!
+    do is = 1, save_grid % child_seq % nb_seqs
+!
+!     For each sequence, a given processor does integrate only on grid.
+        gridp => Agrif_seq_select_child(save_grid,is)
+!
+!     Instanciation of the variables of the current grid
+        call Agrif_Instance(gridp % gr)
+!
+!     Number of time steps
+        nbt = 1
+        do i = 1,Agrif_Probdim
+            nbt = max(nbt, gridp % gr % timeref(i))
+        enddo
+!
+        do k = 1,nbt
+            call procname()
+        enddo
+!
+    enddo
+#ifdef AGRIF_MPI
+    endif
+#endif 
+
+    call Agrif_Instance(save_grid)
+    
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_ChildGrids
+!===================================================================================================
+!===================================================================================================
+!  subroutine Agrif_Integrate_Child
+!
+!> Manages the time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_Child ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+!
+!   One step on the current grid
+!
+    call procname ()
+!
+!   Number of time steps on the current grid
+!
+    parcours => g % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!       Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+        call Agrif_Integrate_Child (parcours % gr, procname)
+        parcours => parcours % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_Child
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_Child_Parallel
+!
+!> Manages the time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_Child_Parallel ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+#if defined AGRIF_MPI
+    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
+    integer                     :: is
+!
+! Instanciation of the variables of the current grid
+    call Agrif_Instance(g)
+!
+! One step on the current grid
+    call procname ()
+!
+! Continue only if the grid has defined sequences of child integrations.
+    if ( .not. associated(g % child_seq) ) return
+!
+    do is = 1, g % child_seq % nb_seqs
+!
+!     For each sequence, a given processor does integrate only on grid.
+        gridp => Agrif_seq_select_child(g,is)
+        call Agrif_Integrate_Child_Parallel(gridp % gr, procname)
+!
+    enddo
+!
+    call Agrif_Instance(g)
+#else
+    call Agrif_Integrate_Child( g, procname )
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_Child_Parallel
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Init_Grids
+!
+!> Initializes the root coarse grid pointed by Agrif_Mygrid. It is called in the main program.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Init_Grids ( procname1, procname2 )
+!---------------------------------------------------------------------------------------------------
+    procedure(typedef_proc), optional   :: procname1 !< (Default: Agrif_probdim_modtype_def)
+    procedure(alloc_proc),   optional   :: procname2 !< (Default: Agrif_Allocationcalls)
+!
+    integer :: i, ierr_allocate, nunit
+    integer :: is_coarse, rhox,rhoy,rhoz,rhot
+    logical :: BEXIST
+!
+    if (present(procname1)) Then
+        call procname1()
+    else
+        call Agrif_probdim_modtype_def()
+    endif
+!
+
+! TEST FOR COARSE GRID (GRAND MOTHER GRID) in AGRIF_FixedGrids.in
+    nunit = Agrif_Get_Unit()
+    open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=98)
+    if (Agrif_Probdim == 3) then
+       read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot
+    elseif (Agrif_Probdim == 2) then
+       read(nunit,*) is_coarse, rhox, rhoy, rhot
+    elseif (Agrif_Probdim == 2) then
+       read(nunit,*) is_coarse, rhox, rhot
+    endif
+    if (is_coarse == -1) then
+       agrif_coarse = .TRUE.
+       if (Agrif_Probdim == 3) then
+          coarse_spaceref(1:3)=(/rhox,rhoy,rhoz/)
+       elseif (Agrif_Probdim == 2) then
+          coarse_spaceref(1:2)=(/rhox,rhoy/)
+       elseif (Agrif_Probdim == 2) then
+          coarse_spaceref(1:1)=(/rhox/)
+       endif
+       coarse_timeref(1:Agrif_Probdim) = rhot
+    endif
+    close(nunit)
+    
+    Agrif_UseSpecialValue = .FALSE.
+    Agrif_UseSpecialValueFineGrid = .FALSE.
+    Agrif_SpecialValue = 0.
+    Agrif_SpecialValueFineGrid = 0.
+!
+    allocate(Agrif_Mygrid)
+    allocate(Agrif_OldMygrid)
+!
+!   Space and time refinement factors are set to 1 on the root grid
+!
+    do i = 1,Agrif_Probdim
+        Agrif_Mygrid % spaceref(i) = coarse_spaceref(i)
+        Agrif_Mygrid % timeref(i)  = coarse_timeref(i)
+    enddo
+!
+!   Initialization of the number of time steps
+    Agrif_Mygrid % ngridstep = 0
+    Agrif_Mygrid % grid_id   = 0
+!
+!   No parent grid for the root coarse grid
+    nullify(Agrif_Mygrid % parent)
+!
+!   Initialization of the minimum positions, global abscissa and space steps
+    do i = 1, Agrif_Probdim
+        Agrif_Mygrid % ix(i) = 1
+        Agrif_Mygrid % Agrif_x(i)  = 0.
+        Agrif_Mygrid % Agrif_dx(i) = 1./Agrif_Mygrid % spaceref(i)
+        Agrif_Mygrid % Agrif_dt(i) = 1./Agrif_Mygrid % timeref(i)
+!       Borders of the root coarse grid
+        Agrif_Mygrid % NearRootBorder(i) = .true.
+        Agrif_Mygrid % DistantRootBorder(i) = .true.
+    enddo
+!
+!   The root coarse grid is a fixed grid
+    Agrif_Mygrid % fixed = .TRUE.
+!   Level of the root grid
+    Agrif_Mygrid % level = 0
+!   Maximum level in the hierarchy
+    Agrif_MaxLevelLoc = 0
+!
+!   Number of the grid pointed by Agrif_Mygrid (root coarse grid)
+    Agrif_Mygrid % rank = 1
+!
+!   Number of the root grid as a fixed grid
+    Agrif_Mygrid % fixedrank = 0
+!
+!   Initialization of some fields of the root grid variables
+    ierr_allocate = 0
+    if( Agrif_NbVariables(0) > 0 ) allocate(Agrif_Mygrid % tabvars(Agrif_NbVariables(0)),stat=ierr_allocate)
+    if( Agrif_NbVariables(1) > 0 ) allocate(Agrif_Mygrid % tabvars_c(Agrif_NbVariables(1)),stat=ierr_allocate)
+    if( Agrif_NbVariables(2) > 0 ) allocate(Agrif_Mygrid % tabvars_r(Agrif_NbVariables(2)),stat=ierr_allocate)
+    if( Agrif_NbVariables(3) > 0 ) allocate(Agrif_Mygrid % tabvars_l(Agrif_NbVariables(3)),stat=ierr_allocate)
+    if( Agrif_NbVariables(4) > 0 ) allocate(Agrif_Mygrid % tabvars_i(Agrif_NbVariables(4)),stat=ierr_allocate)
+    if (ierr_allocate /= 0) THEN
+      STOP "*** ERROR WHEN ALLOCATING TABVARS ***"
+    endif
+!
+!   Initialization of the other fields of the root grid variables (number of
+!   cells, positions, number and type of its dimensions, ...)
+    call Agrif_Instance(Agrif_Mygrid)
+    call Agrif_Set_numberofcells(Agrif_Mygrid)
+!
+!   Allocation of the array containing the values of the grid variables
+    call Agrif_Allocation(Agrif_Mygrid, procname2)
+    call Agrif_initialisations(Agrif_Mygrid)
+!
+!   Total number of fixed grids
+    Agrif_nbfixedgrids = 0
+    
+! If a grand mother grid is declared
+
+    if (agrif_coarse) then
+      allocate(Agrif_Coarsegrid)
+
+      Agrif_Coarsegrid % ngridstep = 0
+      Agrif_Coarsegrid % grid_id   = -9999
+      
+    do i = 1, Agrif_Probdim
+        Agrif_Coarsegrid%spaceref(i) = coarse_spaceref(i)
+        Agrif_Coarsegrid%timeref(i) = coarse_timeref(i)
+        Agrif_Coarsegrid % ix(i) = 1
+        Agrif_Coarsegrid % Agrif_x(i)  = 0.
+        Agrif_Coarsegrid % Agrif_dx(i) = 1.
+        Agrif_Coarsegrid % Agrif_dt(i) = 1.
+!       Borders of the root coarse grid
+        Agrif_Coarsegrid % NearRootBorder(i) = .true.
+        Agrif_Coarsegrid % DistantRootBorder(i) = .true.
+        Agrif_Coarsegrid % nb(i) =Agrif_mygrid%nb(i) / coarse_spaceref(i)
+    enddo      
+
+!   The root coarse grid is a fixed grid
+    Agrif_Coarsegrid % fixed = .TRUE.
+!   Level of the root grid
+    Agrif_Coarsegrid % level = -1
+    
+    Agrif_Coarsegrid % grand_mother_grid = .true.
+
+!   Number of the grid pointed by Agrif_Mygrid (root coarse grid)
+    Agrif_Coarsegrid % rank = -9999
+!
+!   Number of the root grid as a fixed grid
+    Agrif_Coarsegrid % fixedrank = -9999
+    
+      Agrif_Mygrid%parent => Agrif_Coarsegrid
+      
+! Not used but required to prevent seg fault
+      Agrif_Coarsegrid%parent => Agrif_Mygrid
+      
+      call Agrif_Create_Var(Agrif_Coarsegrid)
+
+! Reset to null
+      Nullify(Agrif_Coarsegrid%parent)
+      
+      Agrif_Coarsegrid%child_list%nitems = 1
+      allocate(Agrif_Coarsegrid%child_list%first)
+      allocate(Agrif_Coarsegrid%child_list%last)
+      Agrif_Coarsegrid%child_list%first%gr => Agrif_Mygrid
+      Agrif_Coarsegrid%child_list%last%gr => Agrif_Mygrid
+
+    endif
+    
+    return
+
+98  INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
+    if (.not. BEXIST) then
+        print*,'ERROR : File AGRIF_FixedGrids.in not found.'
+        STOP
+    else
+        print*,'Error opening file AGRIF_FixedGrids.in'
+        STOP
+    endif
+    
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_Grids
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Deallocation
+!
+!> Deallocates all data arrays.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Deallocation
+!---------------------------------------------------------------------------------------------------
+    integer                         :: nb
+    type(Agrif_Variable), pointer   :: var
+    type(Agrif_Variable_c), pointer   :: var_c
+    type(Agrif_Variable_l), pointer   :: var_l
+    type(Agrif_Variable_i), pointer   :: var_i
+!
+    do nb = 1,Agrif_NbVariables(0)
+!
+        var => Agrif_Mygrid % tabvars(nb)
+!
+        if ( allocated(var % array1) ) deallocate(var % array1)
+        if ( allocated(var % array2) ) deallocate(var % array2)
+        if ( allocated(var % array3) ) deallocate(var % array3)
+        if ( allocated(var % array4) ) deallocate(var % array4)
+        if ( allocated(var % array5) ) deallocate(var % array5)
+        if ( allocated(var % array6) ) deallocate(var % array6)
+!
+        if ( allocated(var % sarray1) ) deallocate(var % sarray1)
+        if ( allocated(var % sarray2) ) deallocate(var % sarray2)
+        if ( allocated(var % sarray3) ) deallocate(var % sarray3)
+        if ( allocated(var % sarray4) ) deallocate(var % sarray4)
+        if ( allocated(var % sarray5) ) deallocate(var % sarray5)
+        if ( allocated(var % sarray6) ) deallocate(var % sarray6)
+!
+        if ( allocated(var % darray1) ) deallocate(var % darray1)
+        if ( allocated(var % darray2) ) deallocate(var % darray2)
+        if ( allocated(var % darray3) ) deallocate(var % darray3)
+        if ( allocated(var % darray4) ) deallocate(var % darray4)
+        if ( allocated(var % darray5) ) deallocate(var % darray5)
+        if ( allocated(var % darray6) ) deallocate(var % darray6)
+!
+    enddo
+!
+    do nb = 1,Agrif_NbVariables(1)
+!
+        var_c => Agrif_Mygrid % tabvars_c(nb)
+!
+        if ( allocated(var_c % carray1) ) deallocate(var_c % carray1)
+        if ( allocated(var_c % carray2) ) deallocate(var_c % carray2)
+!
+    enddo
+
+    do nb = 1,Agrif_NbVariables(3)
+!
+        var_l => Agrif_Mygrid % tabvars_l(nb)
+!
+        if ( allocated(var_l % larray1) ) deallocate(var_l % larray1)
+        if ( allocated(var_l % larray2) ) deallocate(var_l % larray2)
+        if ( allocated(var_l % larray3) ) deallocate(var_l % larray3)
+        if ( allocated(var_l % larray4) ) deallocate(var_l % larray4)
+        if ( allocated(var_l % larray5) ) deallocate(var_l % larray5)
+        if ( allocated(var_l % larray6) ) deallocate(var_l % larray6)
+!
+    enddo
+!
+    do nb = 1,Agrif_NbVariables(4)
+!
+        var_i => Agrif_Mygrid % tabvars_i(nb)
+!
+        if ( allocated(var_i % iarray1) ) deallocate(var_i % iarray1)
+        if ( allocated(var_i % iarray2) ) deallocate(var_i % iarray2)
+        if ( allocated(var_i % iarray3) ) deallocate(var_i % iarray3)
+        if ( allocated(var_i % iarray4) ) deallocate(var_i % iarray4)
+        if ( allocated(var_i % iarray5) ) deallocate(var_i % iarray5)
+        if ( allocated(var_i % iarray6) ) deallocate(var_i % iarray6)
+!
+    enddo
+!
+    if ( allocated(Agrif_Mygrid % tabvars) )   deallocate(Agrif_Mygrid % tabvars)
+    if ( allocated(Agrif_Mygrid % tabvars_c) ) deallocate(Agrif_Mygrid % tabvars_c)
+    if ( allocated(Agrif_Mygrid % tabvars_r) ) deallocate(Agrif_Mygrid % tabvars_r)
+    if ( allocated(Agrif_Mygrid % tabvars_l) ) deallocate(Agrif_Mygrid % tabvars_l)
+    if ( allocated(Agrif_Mygrid % tabvars_i) ) deallocate(Agrif_Mygrid % tabvars_i)
+    deallocate(Agrif_Mygrid)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Deallocation
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Step_adj
+!
+!> creates the grid hierarchy and manages the backward time integration procedure.
+!> It is called in the main program.
+!> calls subroutines #Agrif_Regrid and #Agrif_Integrate_adj.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Step_adj ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)    :: procname     !< Subroutine to call on each grid
+!
+!   Creation and initialization of the grid hierarchy
+!
+!   Set the clustering variables
+    call Agrif_clustering_def()
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
+!
+        if (Agrif_Mygrid % ngridstep == 0) then
+            if (.not.Agrif_regrid_has_been_done ) then
+                call Agrif_Regrid()
+            endif
+            call Agrif_Instance(Agrif_Mygrid)
+        endif
+!
+    else
+!
+        if (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then
+            call Agrif_Regrid()
+            call Agrif_Instance(Agrif_Mygrid)
+        endif
+!
+    endif
+!
+!   Time integration of the grid hierarchy
+!
+    call Agrif_Integrate_adj (Agrif_Mygrid,procname)
+!
+    if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Step_adj
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_adj
+!
+!> Manages the backward time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step_adj
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_adj ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    type(Agrif_pgrid), pointer :: parcours ! pointer for the recursive procedure
+    integer                    :: nbt      ! Number of time steps of the current grid
+    integer                    :: k
+!
+!   Instanciation of the variables of the current grid
+    if ( g%fixedrank /= 0 ) then
+        call Agrif_Instance(g)
+    endif
+!
+!   Number of time steps on the current grid
+!
+    g%ngridstep = g % ngridstep + 1
+    parcours => g % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!   Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+!
+!       Number of time steps
+        nbt = 1
+        do k = 1,Agrif_Probdim
+            nbt = max(nbt, parcours % gr % timeref(k))
+        enddo
+!
+        do k = nbt,1,-1
+            call Agrif_Integrate_adj(parcours % gr, procname)
+        enddo
+!
+        parcours => parcours % next
+!
+    enddo
+!
+    if ( g % child_list % nitems > 0 )  call Agrif_Instance(g)
+!
+!   One step on the current grid
+    call procname ()
+!
+end subroutine Agrif_Integrate_adj
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Step_Child_adj
+!
+!> Apply 'procname' to each grid of the hierarchy from Child to Parent
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Step_Child_adj ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    call Agrif_Integrate_Child_adj(Agrif_Mygrid,procname)
+!
+    if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
+!
+end subroutine Agrif_Step_Child_adj
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_Child_adj
+!
+!> Manages the backward time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance & Agrif_Step_adj.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_Child_adj ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid),pointer   :: g          !< Pointer on the current grid
+    procedure(step_proc)       :: procname   !< Subroutine to call on each grid
+!
+    type(Agrif_PGrid),pointer  :: parcours   !< Pointer for the recursive procedure
+!
+    parcours => g % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!       Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+        call Agrif_Integrate_Child_adj(parcours % gr, procname)
+!
+       parcours => parcours % next
+!
+    enddo
+    if ( g % child_list % nitems > 0 )  call Agrif_Instance(g)
+!
+!   One step on the current grid
+    call procname()
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_Child_adj
+!===================================================================================================
+!
+!===================================================================================================
+
+end module Agrif_Util
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F	(revision 5659)
+++ 	(revision )
@@ -1,152 +1,0 @@
-      Module Agrif_Variables 
-      Use Agrif_CurgridFunctions
-      
-      Contains
-      Subroutine Agrif_Declare_Variable(posvar,firstpoint,
-     &    raf,lb,ub,varid,torestore)
-      character*(80) :: variablename
-      Type(Agrif_List_Variables), Pointer :: newvariable,newvariablep
-      INTEGER, DIMENSION(:) :: posvar
-      INTEGER, DIMENSION(:) :: lb,ub
-      INTEGER, DIMENSION(:) :: firstpoint
-      CHARACTER(*) ,DIMENSION(:) :: raf        
-      TYPE(Agrif_Pvariable), Pointer :: parent_var,root_var
-      INTEGER :: dimensio
-      INTEGER :: varid
-      LOGICAL, OPTIONAL :: torestore
-      LOGICAL :: restaure
-            
-!      if (agrif_root()) return
-
-      variablename = 'xxx'
-      
-      restaure = .FALSE.
-      if (agrif_mygrid%ngridstep /= 0) then
-        if (present(torestore)) restaure = torestore
-      endif
-      
-      dimensio = SIZE(posvar)
-C
-C    
-      Allocate(newvariable)
-      Allocate(newvariable%pvar)
-      Allocate(newvariable%pvar%var)
-      Allocate(newvariable%pvar%var%posvar(dimensio))
-      Allocate(newvariable%pvar%var%interptab(dimensio))
-      newvariable%pvar%var%variablename = variablename
-      newvariable%pvar%var%interptab = raf
-      newvariable%pvar%var%nbdim = dimensio
-      newvariable%pvar%var%posvar = posvar
-      newvariable%pvar%var%point(1:dimensio) = firstpoint
-      newvariable%pvar%var%restaure = restaure
-
-      newvariable%pvar%var%lb(1:dimensio) = lb(1:dimensio)
-      newvariable%pvar%var%ub(1:dimensio) = ub(1:dimensio)
-      
-      if (restaure) then
-      select case(dimensio)
-      case(1)
-                  Allocate( newvariable%pvar%var%Restore1D(  
-     &      lb(1):ub(1)))         
-            newvariable%pvar%var%Restore1D = 0      
-      case(2)
-                  Allocate( newvariable%pvar%var%Restore2D(  
-     &      lb(1):ub(1),lb(2):ub(2)))         
-            newvariable%pvar%var%Restore2D = 0
-      case(3)
-                  Allocate( newvariable%pvar%var%Restore3D(  
-     &      lb(1):ub(1),lb(2):ub(2),lb(3):ub(3)))         
-            newvariable%pvar%var%Restore3D = 0
-      case(4)
-                  Allocate( newvariable%pvar%var%Restore4D(  
-     &      lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4)))         
-            newvariable%pvar%var%Restore4D = 0
-      case(5)
-                  Allocate( newvariable%pvar%var%Restore5D(  
-     &      lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),
-     &      lb(5):ub(5)))         
-            newvariable%pvar%var%Restore5D = 0            
-      end select
-      endif
-      
-      newvariable % nextvariable => Agrif_Curgrid%variables
-      
-      Agrif_Curgrid%variables => newvariable
-      Agrif_Curgrid%Nbvariables = Agrif_Curgrid%Nbvariables + 1
-
-      varid = -Agrif_Curgrid%Nbvariables
-
-!       if (agrif_curgrid%parent%nbvariables < agrif_curgrid%nbvariables)
-!     &       then
-!      Allocate(newvariablep)
-!      Allocate(newvariablep%pvar)
-!      Allocate(newvariablep%pvar%var)      
-!      Allocate(newvariablep%pvar%var%posvar(dimensio))
-!      Allocate(newvariablep%pvar%var%interptab(dimensio))
-!      newvariablep%pvar%var%variablename = variablename
-!      newvariablep%pvar%var%interptab = raf
-!      newvariablep%pvar%var%nbdim = dimensio
-!      newvariablep%pvar%var%posvar = posvar
-!      newvariablep%pvar%var%point(1:dimensio) = firstpoint
-!      newvariablep%pvar%var%restaure = restaure      
-! 
-!      newvariablep%pvar%var%lb(1:dimensio) = lb(1:dimensio)
-!      newvariablep%pvar%var%ub(1:dimensio) = ub(1:dimensio)
-!           
-!      newvariablep % nextvariable => Agrif_Curgrid%parent%variables
-!      
-!      Agrif_Curgrid%parent%variables => newvariablep       
-!      
-!      Agrif_Curgrid%parent%Nbvariables = 
-!     &    Agrif_Curgrid%parent%Nbvariables + 1
-!      parent_var=>newvariablep%pvar
-!      else
-!      parent_var=>Agrif_Search_Variable
-!     &              (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables)
-!       endif
-       
-       if (.not.agrif_root()) then
-      parent_var=>Agrif_Search_Variable
-     &              (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables)       
-       
-       newvariable%pvar%parent_var=>parent_var
-       do i=1,dimensio
-         if (parent_var%var%interptab(i)=='N') then
-           parent_var%var%lb(i)=lb(i)
-           parent_var%var%ub(i)=ub(i)
-         endif
-       enddo
-       endif       
-      
-      root_var=>Agrif_Search_Variable
-     &              (Agrif_Mygrid,Agrif_Curgrid%nbvariables)
-     
-      newvariable%pvar%var%root_var=>root_var%var
-      
-           
-      End Subroutine Agrif_Declare_Variable
-
-      FUNCTION Agrif_Search_Variable(grid,varid)
-      integer :: varid
-      Type(Agrif_Pvariable), Pointer :: Agrif_Search_variable
-      Type(Agrif_grid), Pointer :: grid
-      
-      Type(Agrif_List_Variables), pointer :: parcours
-      Logical :: foundvariable
-      integer nb
-      integer :: varidinv
-      
-      foundvariable = .FALSE.
-      parcours => grid%variables
-      varidinv = 1 + grid%nbvariables - varid
-
-      do nb=1,varidinv-1
-         parcours => parcours%nextvariable    
-      End Do
-      
-      Agrif_Search_variable => parcours%pvar
-      
-      
-      End Function Agrif_Search_variable
-      
-      End Module Agrif_Variables      
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90	(revision 5682)
@@ -0,0 +1,146 @@
+module Agrif_Variables
+!
+    use Agrif_CurgridFunctions
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Declare_Variable
+!
+!> Declare a new variable profile
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Declare_Variable ( posvar, firstpoint, raf, lb, ub, varid, torestore )
+!---------------------------------------------------------------------------------------------------
+    integer,      dimension(:), intent(in)  :: posvar     !< position of the variable on the cell
+                                                          !! (1 for the border of the edge, 2 for the center)
+    integer,      dimension(:), intent(in)  :: firstpoint !< index of the first point in the real domain
+    character(1), dimension(:), intent(in)  :: raf        !< Array indicating the type of dimension (space or not)
+                                                          !!   for each of them
+    integer,      dimension(:), intent(in)  :: lb         !< Lower bounds of the array
+    integer,      dimension(:), intent(in)  :: ub         !< Upper bounds of the array
+    integer,                    intent(out) :: varid      !< Id number of the newly created variable
+    logical,      optional,     intent(in)  :: torestore  !< Indicates if the array restore is used
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variables_List), pointer :: new_varlist
+    type(Agrif_Variable),       pointer :: var
+    integer                             :: nbdim, i
+    logical                             :: restore
+
+    restore = .FALSE.
+    if ( Agrif_Mygrid % ngridstep /= 0 ) then
+        if (present(torestore)) restore = torestore
+    endif
+!
+    nbdim = SIZE(posvar)
+!
+    allocate(new_varlist)
+    allocate(new_varlist % var)
+
+    var => new_varlist % var
+
+    allocate(var % posvar(nbdim))
+    allocate(var % interptab(nbdim))
+    allocate(var % coords(nbdim))
+!
+    var % nbdim          = nbdim
+    var % interptab      = raf(1:nbdim)
+    var % posvar         = posvar(1:nbdim)
+    var % point(1:nbdim) = firstpoint(1:nbdim)
+    var % restore = restore
+!
+    do i = 1,nbdim
+        select case( raf(i) )
+            case('x')    ; var % coords(i) = 1
+            case('y')    ; var % coords(i) = 2
+            case('z')    ; var % coords(i) = 3
+            case('N')    ; var % coords(i) = 0
+            case default ; var % coords(i) = 0
+        end select
+    enddo
+!
+    var % lb(1:nbdim) = lb(1:nbdim)
+    var % ub(1:nbdim) = ub(1:nbdim)
+
+    if ( restore ) then
+        select case(nbdim)
+        case(1)
+            allocate(var % Restore1D(lb(1):ub(1)))
+            var % Restore1D = 0
+        case(2)
+            allocate(var % Restore2D(lb(1):ub(1),   &
+                                     lb(2):ub(2)))
+            var % Restore2D = 0
+        case(3)
+            allocate(var % Restore3D(lb(1):ub(1),   &
+                                     lb(2):ub(2),   &
+                                     lb(3):ub(3)))
+            var % Restore3D = 0
+        case(4)
+            allocate(var % Restore4D(lb(1):ub(1),   &
+                                     lb(2):ub(2),   &
+                                     lb(3):ub(3),   &
+                                     lb(4):ub(4)))
+            var % Restore4D = 0
+        case(5)
+            allocate(var % Restore5D(lb(1):ub(1),   &
+                                     lb(2):ub(2),   &
+                                     lb(3):ub(3),   &
+                                     lb(4):ub(4),   &
+                                     lb(5):ub(5)))
+            var % Restore5D = 0
+        end select
+    endif
+
+    new_varlist % next => Agrif_Curgrid % variables
+
+    Agrif_Curgrid % variables => new_varlist
+    Agrif_Curgrid % Nbvariables = Agrif_Curgrid % Nbvariables + 1
+
+    varid = -Agrif_Curgrid % Nbvariables
+
+    var % parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, Agrif_Curgrid % nbvariables)
+    var % root_var   => Agrif_Search_Variable(Agrif_Mygrid, Agrif_Curgrid % nbvariables)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Declare_Variable
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Search_Variable
+!
+!> Returns a pointer to the variable varid for the grid grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Search_Variable ( grid, varid ) result(outvar)
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer       :: grid     !< Pointer on the current grid.
+    integer,          intent(in)    :: varid    !< ID number of the variable we are looking for.
+!
+    type(Agrif_Variable),       pointer :: outvar
+    type(Agrif_Variables_List), pointer :: parcours
+    integer :: nb, varidinv
+!
+    if ( .not.associated(grid) ) then
+        outvar => NULL()
+        return
+    endif
+!
+    parcours => grid % variables
+
+    if (.not. associated(parcours)) then   ! can occur on the grand mother grid
+           outvar => NULL()                ! during the first call by agrif_mygrid
+           return
+    endif
+
+    varidinv = 1 + grid % nbvariables - varid
+
+    do nb = 1,varidinv-1
+        parcours => parcours % next
+    enddo
+
+    outvar => parcours % var
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Search_variable
+!===================================================================================================
+!
+end module Agrif_Variables
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/Makefile.lex
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/Makefile.lex	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/Makefile.lex	(revision 5682)
@@ -0,0 +1,31 @@
+LEX		= flex -i
+YACC	= bison -t -v -g
+
+all: main.c fortran.c
+
+main.c : convert.tab.c convert.yy.c
+	cat   convert.tab.c convert.yy.c > ../LIB/main.c
+	$(RM) convert.tab.c convert.yy.c
+
+fortran.c : fortran.tab.c fortran.yy.c
+	cat   fortran.tab.c fortran.yy.c > ../LIB/fortran.c
+	$(RM) fortran.tab.c fortran.yy.c
+
+convert.tab.c : convert.y decl.h
+	$(YACC) -p convert_ convert.y
+
+fortran.tab.c : fortran.y decl.h
+	$(YACC) -p fortran_ fortran.y
+
+convert.yy.c : convert.lex
+	$(LEX) -P convert_ -o convert.yy.c convert.lex
+
+fortran.yy.c : fortran.lex
+	$(LEX) -P fortran_ -o fortran.yy.c fortran.lex
+
+clean:
+	$(RM) convert.yy.c convert.tab.c convert.output convert.vcg convert.dot	\
+		  fortran.yy.c fortran.tab.c fortran.output fortran.vcg fortran.dot
+
+clean-all: clean
+	$(RM) ../LIB/main.c ../LIB/fortran.c
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.lex
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.lex	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.lex	(revision 5682)
@@ -0,0 +1,69 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%option warn
+%option noyywrap
+
+%s character
+%{
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define YY_NO_INPUT
+%}
+
+SEPARATEUR      "::"
+COMMENTS        "%".*"%"
+PROBTYPE        "1D"|"2D"|"3D"
+USEITEM         "FIXED_GRIDS"|"ONLY_FIXED_GRIDS"|"F77"
+NAME            [a-zA-Z\_][a-zA-Z0-9\_]*
+INTEGER         [0-9]+
+NEXTLINE        \n+[ \t]+"$"|\n+[ \t]+"&"
+%%
+parammodule         { return TOK_MODULEMAIN; } /* name of the module                      */
+notgriddep          { return TOK_NOTGRIDDEP; } /* variable which are not grid dependent   */
+use                 { return TOK_USE; }
+{COMMENTS}          { }
+{SEPARATEUR}        { return TOK_SEP; }
+KIND                { return TOK_KIND; }
+\=                  { return TOK_EQUAL; }
+{USEITEM}           { strcpy(yylval.na,yytext); return TOK_USEITEM;  }
+{PROBTYPE}          { strcpy(yylval.na,yytext); return TOK_PROBTYPE; }  /* dimension of the problem */
+{NAME}              { strcpy(yylval.na,yytext); return TOK_NAME; }
+{INTEGER}           { strcpy(yylval.na,yytext); return TOK_CSTINT; }
+;|\,|\(|\)|:|\[|\]  { return (int) *yytext; }
+\n                  { line_num++; return (int) *yytext; }
+[ \t]+ ;
+%%
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.y
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.y	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.y	(revision 5682)
@@ -0,0 +1,463 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%{
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+int line_num=1;
+extern FILE * convert_in;
+
+int convert_error(const char *s)
+{
+    printf("##\n## ERROR in conv: '%s' (line %d, file: %s)\n##\n", s, line_num, config_file);
+    exit(0);
+}
+
+%}
+
+%union {
+    char na[LONG_M];
+}
+
+%token TOK_SEP
+%token TOK_KIND
+%token TOK_EQUAL
+%token TOK_USE
+%token TOK_MODULEMAIN      /* name of the module                              */
+%token TOK_NOTGRIDDEP      /* Variable which are not grid dependent           */
+%token <na> TOK_USEITEM
+%token <na> TOK_NAME
+%token <na> TOK_CSTINT
+%token <na> TOK_PROBTYPE   /* dimension of the problem                        */
+%token ','
+%token ';'
+
+%%
+
+input :
+    | input line ;
+
+line :
+      '\n'
+    | TOK_PROBTYPE TOK_NAME ';'                             { initdimprob(1,$2,"0","0"); }
+    | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ';'                { initdimprob(2,$2, $4,"0"); }
+    | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ',' TOK_NAME ';'   { initdimprob(3,$2, $4, $6); }
+    | TOK_MODULEMAIN TOK_NAME ';'
+        {
+            listofmodules = Addtolistnom($2,listofmodules,0);
+            Addmoduletothelist($2);
+        }
+    | TOK_KIND TOK_NAME TOK_EQUAL TOK_CSTINT ';'
+        {
+            if (!strcasecmp($4,"4"))
+            {
+                listofkind = Addtolistnom($2,listofkind,4);
+            }
+            else if (!strcasecmp($4,"8"))
+            {
+                listofkind = Addtolistnom($2,listofkind,8);
+            }
+            else
+            {
+                printf("##\n## Unknown kind type : %s (must be 4 or 8)\n##",$4);
+                exit(0);
+            }
+        }
+    | TOK_NOTGRIDDEP TOK_SEP TOK_NAME ';'
+        {
+            Add_NotGridDepend_Var_1($3);
+        }
+    | TOK_USE TOK_USEITEM ';'
+        {
+            if (!strcasecmp($2,"FIXED_GRIDS"))      fixedgrids = 1;
+            if (!strcasecmp($2,"ONLY_FIXED_GRIDS")) onlyfixedgrids = 1;
+        }
+    ;
+%%
+
+void print_usage()
+{
+    printf("usage : conv <config_file> -convfile  <FILENAME>\n");
+    printf(" [-workdir <directory>] [-incdir <directory>]\n");
+    printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
+    printf(" [-convfile  <FILENAME>] [-SubloopScalar] [-SubloopScalar1] \n");
+    printf(" [-free|-fixed]\n");
+    exit(0);
+}
+
+int main(int argc,char *argv[])
+{
+    extern FILE * convert_in ;
+    FILE *dependglobaloutput;
+    int i;
+    listnom *parcours;
+    listvar *newvar;
+    int stylegiven = 0;
+    int infreegiven ;
+    int infixedgiven ;
+    int lengthmainfile;
+
+    char filetoparse[LONG_FNAME];
+
+/******************************************************************************/
+/*  1-  Variables initialization                                              */
+/******************************************************************************/
+    List_Global_Var = (listvar *) NULL;
+    List_GlobalParameter_Var = (listvar *) NULL;
+    List_Common_Var = (listvar *) NULL;
+    List_Allocate_Var = (listallocate *) NULL;
+    List_SubroutineWhereAgrifUsed = (listnom *) NULL;
+    List_Subroutine_For_Alloc = (listnom *) NULL;
+    List_Include = (listusemodule *) NULL;
+    List_NameOfModuleUsed = (listusemodule *) NULL;
+    listofmoduletmp = (listusemodule *) NULL;
+    List_SubroutineDeclaration_Var = (listvar *) NULL;
+    List_UsedInSubroutine_Var = (listvar *) NULL;
+    List_NotGridDepend_Var = (listvar *) NULL;
+    Listofavailableindices = (listindice *) NULL;
+    Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+    List_CouplePointed_Var = (listvarpointtovar *) NULL;
+    List_ModuleUsed_Var = (listvar *) NULL;
+    List_ModuleUsedInModuleUsed_Var = (listvar *) NULL;
+    List_GlobParamModuleUsed_Var = (listparameter *) NULL;
+    List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *) NULL;
+    List_SubroutineArgument_Var = (listvar *) NULL;
+    List_FunctionType_Var = (listvar *) NULL;
+    tmpuselocallist = (listusemodule *) NULL;
+    List_ContainsSubroutine = (listnom *) NULL;
+    oldfortran_out = (FILE *) NULL;
+
+    if (argc < 2) print_usage();
+    
+    strcpy(config_file, argv[1]);
+    strcpy(work_dir, ".");
+    strcpy(input_dir, ".");
+    strcpy(output_dir, "AGRIF_MODELFILES");
+    strcpy(include_dir, "AGRIF_INC");
+    strcpy(filetoparse, "");
+    strcpy(subofagrifinitgrids, "");
+    strcpy(meetagrifinitgrids, "");
+    strcpy(mpiinitvar, "");
+
+    length_last = 0 ;
+    length_first = 0 ;
+    length_v_vallengspec = 0 ;
+    length_v_commoninfile = 0 ;
+    length_v_precision = 0 ;
+    length_v_IntentSpec = 0 ;
+    length_v_initialvalue = 0 ;
+    length_v_readedlistdimension = 0 ;
+    length_a_nomvar = 0 ;
+    length_toprintglob = 0 ;
+    length_tmpvargridname = 0 ;
+    length_ligne_Subloop = 0 ;
+    length_toprint_utilagrif = 0 ;
+    length_toprinttmp_utilchar = 0 ;
+    length_ligne_writedecl = 0 ;
+    length_newname_toamr = 0 ;
+    length_newname_writedecl = 0 ;
+    length_ligne_toamr = 0 ;
+    length_tmpligne_writedecl = 0 ;
+    value_char_size = 0 ;
+    value_char_size1 = 0 ;
+    value_char_size2 = 0 ;
+    value_char_size3 = 0 ;
+    inallocate = 0;
+    infixed = 1;
+    infree  = 0;
+
+    onlyfixedgrids=0;
+    fixedgrids=0;
+    InAgrifParentDef = 0;
+    IndicenbmaillesX=0;
+    IndicenbmaillesY=0;
+    IndicenbmaillesZ=0;
+    created_dimensionlist = 1;
+    /* current indice in the table tabvars             */
+    for ( i=0 ; i<NB_CAT_VARIABLES ; i++)
+    {
+        indicemaxtabvars[i] = 0;
+    }
+    SubloopScalar = 0;
+    todebug = 0;
+    retour77 = 1 ;
+    shouldincludempif = 0 ;
+
+    Read_val_max();
+
+/******************************************************************************/
+/*  2-  Program arguments                                                     */
+/******************************************************************************/
+
+    if ( (convert_in=fopen(config_file,"r")) == NULL )
+    {
+        printf("##\n## ERROR: the configuration file '%s' doesn't exist.\n##\n", config_file);
+        print_usage();
+    }
+
+    i=2;
+    while ( i < argc )
+    {
+        if (!strcasecmp(argv[i], "-workdir"))
+        {
+            strcpy(work_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-incdir"))
+        {
+            strcpy(include_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirin")) /* input directory           */
+        {
+            strcpy(input_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirout")) /* output directory         */
+        {
+            strcpy(output_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-convfile")) /* file to parse             */
+        {
+            strcpy(filetoparse, argv[i+1]);
+            i++;
+            lengthmainfile = strlen(filetoparse);
+            if (!strcasecmp(&filetoparse[lengthmainfile-4], ".f90"))
+            {
+                infixed = 0;
+                infree = 1;
+            }
+            else
+            {
+                infixed = 1;
+                infree = 0;
+            }
+        }
+        else if (!strcasecmp(argv[i], "-free"))
+        {
+            stylegiven = 1;
+            infreegiven  = 1 ;
+            infixedgiven = 0;
+        }
+        else if (!strcasecmp(argv[i], "-fixed"))
+        {
+            stylegiven = 1;
+            infreegiven  = 0;
+            infixedgiven = 1;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar"))
+        {
+            SubloopScalar = 1 ;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar1"))
+        {
+            SubloopScalar = 2 ;
+        }
+        else if (!strcasecmp(argv[i], "-todebug"))
+        {
+            todebug = 1 ;
+        }
+        else if (!strcasecmp(argv[i],"-rm")) { }
+        else
+        {
+            printf("##\n## Unkwon option : %s\n##\n", argv[i]);
+            exit(0);
+        }
+        i++;
+    }
+    // Check input file
+    if ( strlen(filetoparse) == 0 )         // -convfile has not been specified
+    {
+        printf("##\n## ERROR: please provide a file to parse with -convfile.\n##\n");
+        print_usage();
+    }
+    // Setup input & output directories
+    if ( strcasecmp(work_dir, ".") != 0 )   // -workdir has been changed...
+    {
+        if ( strcasecmp(input_dir,  ".") == 0 )                 // ...and -comdirin  has NOT been changed
+        {
+            strcpy(input_dir, work_dir);
+        }
+        if ( strcasecmp(output_dir, "AGRIF_MODELFILES") == 0 )  // ...and -comdirout has NOT been changed
+        {
+            sprintf(output_dir, "%s/%s", work_dir, "AGRIF_MODELFILES");
+        }
+        if ( strcasecmp(include_dir, "AGRIF_INC") == 0 )        // ...and -incdir    has NOT been changed
+        {
+            sprintf(include_dir, "%s/%s", work_dir, "AGRIF_INC");
+        }
+    }
+    if (stylegiven == 1)
+    {
+        infree  = infreegiven;
+        infixed = infixedgiven;
+    }
+
+/******************************************************************************/
+/*  3-  Parsing of the conv file <name>.in                                    */
+/******************************************************************************/
+
+    if ( strstr(filetoparse, ".f90") || strstr(filetoparse, ".F90") ) retour77 = 0;
+
+    convert_parse();
+
+/******************************************************************************/
+/*  4-  Preparation of the file parsing                                       */
+/******************************************************************************/
+
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    /*                                                                         */
+    if ( (dependglobaloutput=fopen(dependfilename, "r")) != NULL )
+    {
+        for (i=0;i<NB_CAT_VARIABLES;i++)
+        {
+            fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars[i]);
+        }
+        fclose(dependglobaloutput);
+    }
+    Readthedependavailablefile();
+    /* Read the .dependnbxnby file which contains indices of nbmaillsX, nbmailleY and nbmailleZ */
+    Readthedependnbxnbyfile();
+    Read_Subroutine_For_Alloc();
+
+/******************************************************************************/
+/*  5-  Parsing of the input file (2 times)                                   */
+/******************************************************************************/
+
+    /* Record all variables in list                                            */
+    firstpass = 1;
+    process_fortran(filetoparse);
+
+    CompleteThelistvarindoloop();
+    /* Read list of module used                                                */
+    RecordUseModulesVariables();
+    /* Read list of module used in module used                                 */
+    RecordUseModulesUseModulesVariables();
+    /* Save variables are considered as globals ones                           */
+    Update_List_Global_Var_From_List_Save_Var();
+    /* Update all lists                                                        */
+    ListUpdate();
+
+    Clean_List_Global_Var();
+    /* Indice tabvars identification                                           */
+    IndiceTabvarsIdentification();
+    /* Update all lists                                                        */
+    ListUpdate();
+    /* The allocation subroutine is necessary ????                             */
+    New_Allocate_Subroutine_Is_Necessary();
+    /* The allocation subroutine is necessary for common list                  */
+    New_Allocate_Subroutine_For_Common_Is_Necessary();
+    /* Sort List_SubroutineArgument_Var                                        */
+    Sort_List_SubroutineArgument_Var();
+    /* Clean all lists                                                         */
+    ListClean();
+    /* Update Indice of List_UsedInSubroutine_Var from module used             */
+    List_UsedInSubroutine_Var_Update_From_Module_Used();
+    /* Update List_SubroutineWhereAgrifUsed                                    */
+    UpdateList_SubroutineWhereAgrifUsed();
+    /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
+    UpdateList_UsedInSubroutine_With_dimension();
+
+    ModifyThelistvarindoloop();
+    UpdateListDeclarationWithDimensionList();
+    GiveTypeOfVariables();
+
+    /* Build new subroutines                                                   */
+    firstpass = 0;
+    process_fortran(filetoparse);
+
+    newvar = (listvar *) NULL;
+
+    while ( newvar )
+    {
+        printf("++++ %s %d %s %s %s\n",
+            newvar->var->v_nomvar,
+            newvar->var->v_nbdim,
+            newvar->var->v_subroutinename,
+            newvar->var->v_modulename,
+            newvar->var->v_typevar);
+        newvar = newvar->suiv;
+    }
+
+/******************************************************************************/
+/*  6-  Write informations in output files                                    */
+/******************************************************************************/
+
+    /* Write the .dependglobal_agrif file which contain the max indice         */
+    /*    of the tabvars table                                                 */
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    dependglobaloutput = fopen(dependfilename, "w");
+    for (i=0;i<NB_CAT_VARIABLES;i++)
+    {
+        fprintf(dependglobaloutput,"%d\n",indicemaxtabvars[i]);
+    }
+    fclose(dependglobaloutput);
+    /* Write the list of available indice                                      */
+    Writethedependavailablefile();
+    /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
+    /*    nbmailleY and nbmailleZ                                              */
+    Writethedependnbxnbyfile();
+    /* Write the .depend<namefile> file which contain general informations     */
+    /*    about variable of this file                                          */
+    parcours = List_NameOfModule;
+    while( parcours )
+    {
+        Writethedependlistofmoduleused(parcours->o_nom);
+        WritedependParameterList(parcours->o_nom);
+        Writethedependfile(parcours->o_nom,List_Global_Var);
+        parcours=parcours->suiv;
+    }
+    parcours = List_NameOfCommon;
+    while( parcours )
+    {
+        Writethedependfile(parcours->o_nom,List_Common_Var);
+        parcours=parcours->suiv;
+    }
+    Write_Subroutine_For_Alloc();
+
+/******************************************************************************/
+/*  7-  Create files in AGRIF_INC directory                                   */
+/******************************************************************************/
+
+    creefichieramr();
+
+    Write_val_max();
+
+    if ( todebug == 1 ) printf("Out of CONV \n");
+    return 0;
+}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/decl.h
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/decl.h	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/decl.h	(revision 5682)
@@ -0,0 +1,1 @@
+link ../LIB/decl.h
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.lex
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.lex	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.lex	(revision 5682)
@@ -0,0 +1,294 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%option warn
+%option noyywrap
+
+%x parameter
+%s character
+%x donottreat
+%s fortran77style
+%s fortran90style
+%{
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+extern FILE * yyin;
+#define MAX_INCLUDE_DEPTH 30
+YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
+int line_num_input = 1;
+int newlinef90 = 0;
+char tmpc;
+#define PRINT_LINE_NUM()     // { fprintf(stderr,"== Parsing l.%4d...\n", line_num_input); }
+#define INCREMENT_LINE_NUM() { line_num_input++; PRINT_LINE_NUM(); }
+
+/******************************************************************************/
+/**************PETITS PB NON PREVUS *******************************************/
+/******************************************************************************/
+/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
+/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
+/*            de la 7eme et le debut de la ligne de commande                  */
+/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
+/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
+/******************************************************************************/
+#define YY_USER_ACTION  if (firstpass == 0) ECHO;
+
+void out_of_donottreat(void);
+
+%}
+
+REAL8 "real*8"[ \t]*"(a-h,o-z)"
+
+SLASH       "/"
+DSLASH      "/"[ \t]*"/"
+HEXA        Z\'[0-9a-fA-F]+\'
+NAME        [a-zA-Z\_][a-zA-Z0-9\_]*
+INTEGER     [0-9]+
+
+EXPONENT    [edq][-+]?{INTEGER}
+
+BEG_DNT         ^[C!]"$AGRIF_DO_NOT_TREAT"[ \t]*\n
+END_DNT         ^[C!]"$AGRIF_END_DO_NOT_TREAT"[ \t]*\n
+
+BEG_INTERFACE   ^[ \t]*interface
+END_INTERFACE   ^[ \t]*end[ \t]*interface.*\n
+
+ASSIGNTYPE      "assignment"[ \t]*"("[ \t]*[-+=]+[ \t]*")"
+
+COMM_F77        ^([Cc*](([ \t]*\n)|([^AaHhOo\n].*\n)))
+COMM_F90        ^[ \t]*!.*\n
+COMM_F90_2      !.*
+NEXTLINEF90     "&".*\n+
+NEXTLINEF77     [\n \t]*\n[ \t]{5}("&"|"+"|"$"|"*"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"|"."|"#")
+
+LABEL           ^(((" "|[0-9]){1,5})|([ \t]{1,5}))[ &]+
+
+%%
+  if (infixed) BEGIN(fortran77style) ;
+  if (infree)  BEGIN(fortran90style) ;
+
+{REAL8}                     { return TOK_REAL8; }
+subroutine                  { return TOK_SUBROUTINE; }
+program                     { return TOK_PROGRAM; }
+allocate                    { inallocate = 1; return TOK_ALLOCATE; }
+nullify			            { return TOK_NULLIFY; }
+null[ ]*\([ ]*\)            { return TOK_NULL_PTR; }
+deallocate                  { inallocate = 1; return TOK_DEALLOCATE; }
+result                      { return TOK_RESULT; }
+function                    { return TOK_FUNCTION; }
+end[ \t]*program            { strcpy(yylval.na,fortran_text); return TOK_ENDPROGRAM;}
+end[ \t]*module             { strcpy(yylval.na,fortran_text); return TOK_ENDMODULE; }
+end[ \t]*subroutine         { strcpy(yylval.na,fortran_text); return TOK_ENDSUBROUTINE;}
+end[ \t]*function           { strcpy(yylval.na,fortran_text); return TOK_ENDFUNCTION;}
+end                         { strcpy(yylval.na,fortran_text); return TOK_ENDUNIT;}
+include                     { pos_curinclude = setposcur()-9; return TOK_INCLUDE;}
+^[ \t]*use[ ]+              { strcpy(yylval.na,fortran_text);
+                              tmpc = (char) input(); unput(tmpc);
+                              if ( ( tmpc >= 'a' && tmpc <= 'z' ) ||
+                                   ( tmpc >= 'A' && tmpc <= 'Z' )  )  return TOK_USE;
+                              else                                    return TOK_NAME;
+                            }
+rewind                      { return TOK_REWIND; }
+implicit                    { return TOK_IMPLICIT; }
+none                        { return TOK_NONE; }
+call                        { return TOK_CALL; }
+.true.                      { return TOK_TRUE; }
+.false.                     { return TOK_FALSE; }
+\=\>                        { return TOK_POINT_TO; }
+{ASSIGNTYPE}                { strcpy(yylval.na,fortran_text); return TOK_ASSIGNTYPE;}
+\*\*                        { strcpy(yylval.na,fortran_text); return TOK_DASTER; }
+\.[ \t]*eqv\.               { strcpy(yylval.na,fortran_text); return TOK_EQV; }
+\.[ \t]*eq\.                { strcpy(yylval.na,fortran_text); return TOK_EQ;  }
+\.[ \t]*gt\.                { strcpy(yylval.na,fortran_text); return TOK_GT;  }
+\.[ \t]*ge\.                { strcpy(yylval.na,fortran_text); return TOK_GE;  }
+\.[ \t]*lt\.                { strcpy(yylval.na,fortran_text); return TOK_LT;  }
+\.[ \t]*le\.                { strcpy(yylval.na,fortran_text); return TOK_LE;  }
+\.[ \t]*neqv\.              { strcpy(yylval.na,fortran_text); return TOK_NEQV;}
+\.[ \t]*ne\.                { strcpy(yylval.na,fortran_text); return TOK_NE;  }
+\.[ \t]*not\.               { strcpy(yylval.na,fortran_text); return TOK_NOT; }
+\.[ \t]*or\.                { strcpy(yylval.na,fortran_text); return TOK_OR;  }
+\.[ \t]*xor\.               { strcpy(yylval.na,fortran_text); return TOK_XOR; }
+\.[ \t]*and\.               { strcpy(yylval.na,fortran_text); return TOK_AND; }
+module                      { return TOK_MODULE; }
+while                       { return TOK_WHILE; }
+concurrent                  { return TOK_CONCURRENT; }
+end[ \t]*do                 { return TOK_ENDDO; }
+do                          { return TOK_PLAINDO;}
+real                        { strcpy(yylval.na,fortran_text); return TOK_REAL; }
+integer                     { strcpy(yylval.na,fortran_text); return TOK_INTEGER; }
+logical                     { strcpy(yylval.na,fortran_text); return TOK_LOGICAL; }
+character                   { strcpy(yylval.na,fortran_text); return TOK_CHARACTER; }
+{HEXA}                      { strcpy(yylval.na,fortran_text); return TOK_HEXA;}
+double[ \t]*precision       { strcpy(yylval.na,fortran_text); return TOK_DOUBLEPRECISION; }
+double[ \t]*complex         { strcpy(yylval.na,fortran_text); return TOK_DOUBLECOMPLEX; }
+complex                     { return TOK_COMPLEX; }
+allocatable                 { return TOK_ALLOCATABLE; }
+close                       { return TOK_CLOSE; }
+inquire                     { return TOK_INQUIRE; }
+dimension                   { return TOK_DIMENSION; }
+pause                       { return TOK_PAUSE; }
+equivalence                 { return TOK_EQUIVALENCE; }
+stop                        { return TOK_STOP; }
+where                       { return TOK_WHERE; }
+end[ \t]*where              { return TOK_ENDWHERE; }
+else[ \t]*where[ \t]*\(     { return TOK_ELSEWHEREPAR; }
+else[ \t]*where             { return TOK_ELSEWHERE; }
+^[ \t]*contains             { return TOK_CONTAINS; }
+only                        { return TOK_ONLY; }
+parameter                   { return TOK_PARAMETER; }
+recursive                   { return TOK_RECURSIVE; }
+common                      { return TOK_COMMON; }
+^[ \t]*global[ \t]+         { return TOK_GLOBAL; }
+external                    { return TOK_EXTERNAL; }
+intent                      { return TOK_INTENT; }
+pointer                     { return TOK_POINTER; }
+optional                    { return TOK_OPTIONAL; }
+save                        { return TOK_SAVE; }
+^[ \t]*type[ \t]*\(         { pos_cur_decl = setposcur()-5; return TOK_TYPEPAR; }
+^[ \t]*type[ \t\,]+         { return TOK_TYPE; }
+end[ \t]*type               { return TOK_ENDTYPE; }
+stat                        { if (inallocate == 1) return TOK_STAT; else { strcpy(yylval.na,fortran_text); return TOK_NAME; } }
+open                        { return TOK_OPEN; }
+return                      { return TOK_RETURN; }
+exit[^(]                    { return TOK_EXIT; }
+print                       { return TOK_PRINT; }
+module[ \t]*procedure       { return TOK_PROCEDURE; }
+read                        { return TOK_READ; }
+namelist                    { return TOK_NAMELIST; }
+write                       { return TOK_WRITE; }
+flush                       { return TOK_FLUSH; }
+target                      { return TOK_TARGET; }
+public                      { return TOK_PUBLIC; }
+private                     { return TOK_PRIVATE; }
+in                          { strcpy(yylval.na,fortran_text); return TOK_IN; }
+^[ \t]*data[ \t]+           { pos_curdata = setposcur()-strlen(fortran_text); Init_List_Data_Var(); return TOK_DATA; }
+continue                    { return TOK_CONTINUE; }
+go[ \t]*to                  { return TOK_PLAINGOTO; }
+out                         { strcpy(yylval.na,fortran_text); return TOK_OUT; }
+inout                       { strcpy(yylval.na,fortran_text); return TOK_INOUT; }
+intrinsic                   { return TOK_INTRINSIC; }
+then                        { return TOK_THEN; }
+else[ \t]*if                { return TOK_ELSEIF; }
+else                        { return TOK_ELSE; }
+end[ \t]*if                 { return TOK_ENDIF; }
+if                          { return TOK_LOGICALIF; }
+sum[ \t]*\(                 { return TOK_SUM; }
+max[ \t]*\(                 { return TOK_MAX; }
+tanh                        { return TOK_TANH; }
+maxval                      { return TOK_MAXVAL; }
+trim                        { return TOK_TRIM; }
+sqrt\(                      { return TOK_SQRT; }
+select[ \t]*case            { return TOK_SELECTCASE; }
+^[ \t]*case[ \t]*           { return TOK_CASE; }
+default                     { return TOK_DEFAULT; }
+end[ \t]*select             { return TOK_ENDSELECT; }
+file[ \t]*\=                { return TOK_FILE; }
+unit[ \t]*\=                { return TOK_UNIT; }
+fmt[ \t]*\=                 { return TOK_FMT; }
+nml[ \t]*\=                 { return TOK_NML; }
+end[ \t]*\=                 { return TOK_END; }
+eor[ \t]*\=                 { return TOK_EOR; }
+err[ \t]*\=                 { return TOK_ERR; }
+exist[ \t]*\=               { return TOK_EXIST; }
+min[ \t]*\(                 { return TOK_MIN; }
+nint                        { return TOK_NINT; }
+float                       { return TOK_FLOAT; }
+exp                         { return TOK_EXP; }
+cos                         { return TOK_COS; }
+cosh                        { return TOK_COSH; }
+acos                        { return TOK_ACOS; }
+sin                         { return TOK_SIN; }
+sinh                        { return TOK_SINH; }
+asin                        { return TOK_ASIN; }
+log                         { return TOK_LOG; }
+tan                         { return TOK_TAN; }
+atan                        { return TOK_ATAN; }
+cycle                       { return TOK_CYCLE; }
+abs[ \t]*\(                 { return TOK_ABS; }
+mod                         { return TOK_MOD; }
+sign[ \t]*\(                { return TOK_SIGN; }
+minloc                      { return TOK_MINLOC; }
+maxloc                      { return TOK_MAXLOC; }
+minval                      { return TOK_MINVAL; }
+backspace                   { return TOK_BACKSPACE; }
+::                          { return TOK_FOURDOTS;  }
+\({SLASH}                   { return TOK_LEFTAB; }
+{SLASH}\)                   { return TOK_RIGHTAB; }
+format[ \t]*\((.|{NEXTLINEF90}|{NEXTLINEF77})*\)  {
+                              return TOK_FORMAT; }
+{SLASH}                     { strcpy(yylval.na,fortran_text); return TOK_SLASH; }
+DSLASH                      { strcpy(yylval.na,fortran_text); return TOK_DSLASH; }
+(\')[^']*&{0,1}\n[ \t]*&{0,1}[^']*(\') {
+                              strcpy(yylval.na,fortran_text); return TOK_CHAR_CUT; }
+(\')[^']*(\')             { strcpy(yylval.na,fortran_text);return TOK_CHAR_CONSTANT; }
+(\")[^"]*(\")             { strcpy(yylval.na,fortran_text);return TOK_CHAR_MESSAGE; }
+{BEG_INTERFACE}             { BEGIN(donottreat); }
+<donottreat>{END_INTERFACE} { out_of_donottreat(); return '\n'; }
+{NAME}                      { strcpy(yylval.na,fortran_text); return TOK_NAME; }
+({INTEGER}\.[0-9]*)/[^"and."|"false."|"true."|"eq."|"or."|"gt."|"ge."|"lt."|"le."|"not."|"ne."] {  // REAL1
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+(({INTEGER}\.[0-9]+|[0-9]*\.{INTEGER}){EXPONENT}?)|{INTEGER}(\.)?{EXPONENT}                     {  // REAL2
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+{INTEGER}                   { strcpy(yylval.na,fortran_text); return TOK_CSTINT; }
+\$                          {}
+\.                          {}
+\(|\)|:|\[|\]|\+|\-|\*      { strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+\%                          { strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+\;                          { return TOK_SEMICOLON; }
+\,                          { return (int) *fortran_text; }
+\=                          { return (int) *fortran_text; }
+\<                          { return (int) *fortran_text; }
+\>                          { return (int) *fortran_text; }
+\n                          { INCREMENT_LINE_NUM() ; return '\n'; }
+^[ ]*$                      {}
+[ \t]+                      {}
+{LABEL}                     { if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0; }
+{NEXTLINEF90}               { INCREMENT_LINE_NUM() ; newlinef90=1; }
+{NEXTLINEF77}               { INCREMENT_LINE_NUM() ; }
+
+{BEG_DNT}                   { INCREMENT_LINE_NUM() ; BEGIN(donottreat); }
+<donottreat>{END_DNT}       { out_of_donottreat(); return '\n'; }
+<donottreat>.*\n            { INCREMENT_LINE_NUM() ; }
+<fortran77style>{COMM_F77}  { INCREMENT_LINE_NUM() ; }
+{COMM_F90}                  { INCREMENT_LINE_NUM() ; }
+{COMM_F90_2}                {}
+%%
+
+void out_of_donottreat ( void )
+{
+    BEGIN(INITIAL);
+    if (infixed) BEGIN(fortran77style) ;
+    if (infree)  BEGIN(fortran90style) ;
+    INCREMENT_LINE_NUM() ;
+}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.y
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.y	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.y	(revision 5682)
@@ -0,0 +1,2225 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http ://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+
+%{
+#define YYMAXDEPTH 1000
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+extern int line_num_input;
+extern char *fortran_text;
+
+char c_selectorname[LONG_M];
+char ligne[LONG_M];
+char truename[LONG_VNAME];
+char identcopy[LONG_VNAME];
+int c_selectorgiven=0;
+listvar *curlistvar;
+typedim c_selectordim;
+listcouple *coupletmp;
+int removeline=0;
+listvar *test;
+
+int fortran_error(const char *s)
+{
+    printf("%s line %d, file %s motclef = |%s|\n", s, line_num_input, cur_filename, fortran_text);
+    exit(1);
+}
+
+%}
+
+%union {
+    char        na[LONG_M];
+    listdim     *d;
+    listvar     *l;
+    listcouple  *lc;
+    listname    *lnn;
+    typedim     dim1;
+    variable    *v;
+}
+
+%left ','
+%nonassoc ':'
+%right '='
+%left TOK_EQV TOK_NEQV
+%left TOK_OR TOK_XOR
+%left TOK_AND
+%left TOK_NOT
+%nonassoc TOK_LT TOK_GT TOK_LE TOK_GE TOK_EQ TOK_NE
+%left TOK_DSLASH
+%left '+' '-'
+%left '*' TOK_SLASH
+%right TOK_DASTER
+
+%token TOK_SEMICOLON
+%token TOK_PARAMETER
+%token TOK_RESULT
+%token TOK_ONLY
+%token TOK_INCLUDE
+%token TOK_SUBROUTINE
+%token TOK_PROGRAM
+%token TOK_FUNCTION
+%token TOK_FORMAT
+%token TOK_MAX
+%token TOK_TANH
+%token TOK_WHERE
+%token TOK_ELSEWHEREPAR
+%token TOK_ELSEWHERE
+%token TOK_ENDWHERE
+%token TOK_MAXVAL
+%token TOK_TRIM
+%token TOK_NULL_PTR
+%token TOK_SUM
+%token TOK_SQRT
+%token TOK_CASE
+%token TOK_SELECTCASE
+%token TOK_FILE
+%token TOK_UNIT
+%token TOK_FMT
+%token TOK_NML
+%token TOK_END
+%token TOK_EOR
+%token TOK_ERR
+%token TOK_EXIST
+%token TOK_MIN
+%token TOK_FLOAT
+%token TOK_EXP
+%token TOK_COS
+%token TOK_COSH
+%token TOK_ACOS
+%token TOK_NINT
+%token TOK_CYCLE
+%token TOK_SIN
+%token TOK_SINH
+%token TOK_ASIN
+%token TOK_EQUIVALENCE
+%token TOK_BACKSPACE
+%token TOK_LOG
+%token TOK_TAN
+%token TOK_ATAN
+%token TOK_RECURSIVE
+%token TOK_ABS
+%token TOK_MOD
+%token TOK_SIGN
+%token TOK_MINLOC
+%token TOK_MAXLOC
+%token TOK_EXIT
+%token TOK_MINVAL
+%token TOK_PUBLIC
+%token TOK_PRIVATE
+%token TOK_ALLOCATABLE
+%token TOK_RETURN
+%token TOK_THEN
+%token TOK_ELSEIF
+%token TOK_ELSE
+%token TOK_ENDIF
+%token TOK_PRINT
+%token TOK_PLAINGOTO
+%token TOK_LOGICALIF
+%token TOK_PLAINDO
+%token TOK_CONTAINS
+%token TOK_ENDDO
+%token TOK_MODULE
+%token TOK_ENDMODULE
+%token TOK_WHILE
+%token TOK_CONCURRENT
+%token TOK_ALLOCATE
+%token TOK_OPEN
+%token TOK_CLOSE
+%token TOK_INQUIRE
+%token TOK_WRITE
+%token TOK_FLUSH
+%token TOK_READ
+%token TOK_REWIND
+%token TOK_DEALLOCATE
+%token TOK_NULLIFY
+%token TOK_DIMENSION
+%token TOK_ENDSELECT
+%token TOK_EXTERNAL
+%token TOK_INTENT
+%token TOK_INTRINSIC
+%token TOK_NAMELIST
+%token TOK_DEFAULT
+%token TOK_OPTIONAL
+%token TOK_POINTER
+%token TOK_CONTINUE
+%token TOK_SAVE
+%token TOK_TARGET
+%token TOK_IMPLICIT
+%token TOK_NONE
+%token TOK_CALL
+%token TOK_STAT
+%token TOK_POINT_TO
+%token TOK_COMMON
+%token TOK_GLOBAL
+%token TOK_LEFTAB
+%token TOK_RIGHTAB
+%token TOK_PAUSE
+%token TOK_PROCEDURE
+%token TOK_STOP
+%token TOK_REAL8
+%token TOK_FOURDOTS
+%token <na> TOK_HEXA
+%token <na> TOK_ASSIGNTYPE
+%token <na> TOK_OUT
+%token <na> TOK_INOUT
+%token <na> TOK_IN
+%token <na> TOK_USE
+%token <na> TOK_DSLASH
+%token <na> TOK_DASTER
+%token <na> TOK_EQ
+%token <na> TOK_EQV
+%token <na> TOK_GT
+%token <na> TOK_LT
+%token <na> TOK_GE
+%token <na> TOK_NE
+%token <na> TOK_NEQV
+%token <na> TOK_LE
+%token <na> TOK_OR
+%token <na> TOK_XOR
+%token <na> TOK_NOT
+%token <na> TOK_AND
+%token <na> TOK_TRUE
+%token <na> TOK_FALSE
+%token <na> TOK_LABEL
+%token <na> TOK_TYPE
+%token <na> TOK_TYPEPAR
+%token <na> TOK_ENDTYPE
+%token <na> TOK_REAL
+%token <na> TOK_INTEGER
+%token <na> TOK_LOGICAL
+%token <na> TOK_DOUBLEPRECISION
+%token <na> TOK_ENDSUBROUTINE
+%token <na> TOK_ENDFUNCTION
+%token <na> TOK_ENDPROGRAM
+%token <na> TOK_ENDUNIT
+%token <na> TOK_CHARACTER
+%token <na> TOK_CHAR_CONSTANT
+%token <na> TOK_CHAR_CUT
+%token <na> TOK_DATA
+%token <na> TOK_CHAR_MESSAGE
+%token <na> TOK_CSTREAL
+%token <na> TOK_COMPLEX
+%token <na> TOK_DOUBLECOMPLEX
+%token <na> TOK_NAME
+%token <na> TOK_SLASH
+%token <na> TOK_CSTINT
+%token ','
+%token ':'
+%token '('
+%token ')'
+%token '<'
+%token '>'
+%type <l> dcl
+%type <l> after_type
+%type <l> dimension
+%type <l> paramlist
+%type <l> args
+%type <l> arglist
+%type <lc> only_list
+%type <lc> only_name
+%type <lc> rename_list
+%type <lc> rename_name
+%type <d> dims
+%type <d> dimlist
+%type <dim1> dim
+%type <v> paramitem
+%type <na> comblock
+%type <na> name_routine
+%type <na> opt_name
+%type <na> type
+%type <na> word_endsubroutine
+%type <na> word_endfunction
+%type <na> word_endprogram
+%type <na> word_endunit
+%type <na> typespec
+%type <na> string_constant
+%type <na> simple_const
+%type <na> ident
+%type <na> intent_spec
+%type <na> signe
+%type <na> opt_signe
+%type <na> filename
+%type <na> attribute
+%type <na> complex_const
+%type <na> begin_array
+%type <na> clause
+%type <na> arg
+%type <na> uexpr
+%type <na> minmaxlist
+%type <na> lhs
+%type <na> vec
+%type <na> outlist
+%type <na> other
+%type <na> dospec
+%type <na> expr_data
+%type <na> structure_component
+%type <na> array_ele_substring_func_ref
+%type <na> funarglist
+%type <na> funarg
+%type <na> funargs
+%type <na> triplet
+%type <na> substring
+%type <na> opt_substring
+%type <na> opt_expr
+%type <na> optexpr
+%type <lnn> data_stmt_value_list
+%type <lnn> datanamelist
+%type <na> after_slash
+%type <na> after_equal
+%type <na> predefinedfunction
+%type <na> expr
+%type <na> ubound
+%type <na> operation
+%type <na> proper_lengspec
+%type <lnn> use_name_list
+%type <lnn> public
+
+%%
+input :
+      | input line
+      ;
+line :  line-break
+      | suite_line_list
+      | TOK_LABEL suite_line_list
+      | error {yyerrok;yyclearin;}
+      ;
+line-break:
+        '\n' fin_line
+      | TOK_SEMICOLON
+      | line-break '\n' fin_line
+      | line-break TOK_SEMICOLON
+      | line-break TOK_LABEL
+      ;
+suite_line_list :
+        suite_line
+      | suite_line_list TOK_SEMICOLON '\n'
+      | suite_line_list TOK_SEMICOLON suite_line
+      ;
+suite_line :
+        entry fin_line     /* subroutine, function, module                    */
+      | spec fin_line      /* declaration                                     */
+      | TOK_INCLUDE filename fin_line
+        {
+            if (inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
+            }
+        }
+      | execution-part-construct
+      ;
+
+fin_line : { pos_cur = setposcur(); }
+      ;
+
+opt_recursive :         { isrecursive = 0; }
+      | TOK_RECURSIVE   { isrecursive = 1; }
+      ;
+
+opt_result :                                { is_result_present = 0; }
+      | TOK_RESULT arglist_after_result     { is_result_present = 1; }
+      ;
+
+entry : opt_recursive TOK_SUBROUTINE name_routine arglist
+        {
+            insubroutinedeclare = 1;
+            if ( firstpass )
+                Add_SubroutineArgument_Var_1($4);
+            else
+                WriteBeginof_SubLoop();
+        }
+      | TOK_PROGRAM name_routine
+        {
+            insubroutinedeclare = 1;
+            inprogramdeclare = 1;
+            /* in the second step we should write the head of       */
+            /*    the subroutine sub_loop_<subroutinename>          */
+            if ( ! firstpass )
+                WriteBeginof_SubLoop();
+        }
+      | opt_recursive TOK_FUNCTION name_routine arglist opt_result
+        {
+            insubroutinedeclare = 1;
+            strcpy(DeclType, "");
+            /* we should to list of the subroutine argument the  */
+            /*    name of the function which has to be defined   */
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1($4);
+                if ( ! is_result_present )
+                    Add_FunctionType_Var_1($3);
+            }
+            else
+            /* in the second step we should write the head of    */
+            /*    the subroutine sub_loop_<subroutinename>       */
+                WriteBeginof_SubLoop();
+        }
+      | TOK_MODULE TOK_NAME
+        {
+            GlobalDeclaration = 0;
+            strcpy(curmodulename,$2);
+            strcpy(subroutinename,"");
+            Add_NameOfModule_1($2);
+            if ( inmoduledeclare == 0 )
+            {
+                /* To know if there are in the module declaration    */
+                inmoduledeclare = 1;
+                /* to know if a module has been met                  */
+                inmodulemeet = 1;
+                /* to know if we are after the keyword contains      */
+                aftercontainsdeclare = 0 ;
+            }
+        }
+      ;
+
+/* R312 : label */
+label: TOK_CSTINT
+     | label TOK_CSTINT
+     ;
+
+name_routine :  TOK_NAME    { strcpy($$, $1); strcpy(subroutinename, $1); }
+      ;
+filename :      TOK_CHAR_CONSTANT { Add_Include_1($1); }
+      ;
+arglist :               { if ( firstpass ) $$=NULL; }
+      | '(' ')'         { if ( firstpass ) $$=NULL; }
+      | '(' args ')'    { if ( firstpass ) $$=$2; }
+      ;
+arglist_after_result:
+      | '(' ')'
+      | '(' args ')'    { if ( firstpass ) Add_SubroutineArgument_Var_1($2); }
+      ;
+args :  arg
+        {
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar($1,NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                curlistvar = insertvar(NULL,curvar);
+                $$ = settype("",curlistvar);
+            }
+        }
+      | args ',' arg
+        {
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar($3,NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                $$ = insertvar($1,curvar);
+            }
+        }
+      ;
+arg : TOK_NAME  { strcpy($$,$1);  }
+      | '*'     { strcpy($$,"*"); }
+      ;
+spec :  type after_type
+      | TOK_TYPE opt_spec opt_sep opt_name  { inside_type_declare = 1; }
+      | TOK_ENDTYPE opt_name                { inside_type_declare = 0; }
+      | TOK_POINTER list_couple
+      | before_parameter '(' paramlist ')'
+        {
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1($3);
+                    else                        Add_GlobalParameter_Var_1($3);
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out, pos_cur_decl, pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+      | before_parameter paramlist
+        {
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1($2);
+                    else                        Add_GlobalParameter_Var_1($2);
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+      | common
+      | save
+        {
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave);
+        }
+      | implicit
+      | dimension
+        {
+            /* if the variable is a parameter we can suppose that is   */
+            /*    value is the same on each grid. It is not useless to */
+            /*    create a copy of it on each grid                     */
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    Add_Globliste_1($1);
+                    /* if variableparamlists has been declared in a subroutine   */
+                    if ( insubroutinedeclare )     Add_Dimension_Var_1($1);
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension);
+                }
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+        }
+      | public
+        {
+            if (firstpass == 0)
+            {
+                if ($1)
+                {
+                    removeglobfromlist(&($1));
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur);
+                    writelistpublic($1);
+                }
+            }
+        }
+      | private
+      | use_stat
+      | module_proc_stmt
+      | namelist
+      | TOK_BACKSPACE '(' expr ')'
+      | TOK_EXTERNAL opt_sep use_name_list
+      | TOK_INTRINSIC opt_sep use_intrinsic_list
+      | TOK_EQUIVALENCE list_expr_equi
+      | data_stmt '\n'
+        {
+            /* we should remove the data declaration                */
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata);
+
+            if ( aftercontainsdeclare == 1  && firstpass == 0 )
+            {
+                ReWriteDataStatement_0(fortran_out);
+                pos_end = setposcur();
+            }
+        }
+      ;
+opt_spec :
+      | access_spec
+        {
+            PublicDeclare = 0 ;
+            PrivateDeclare = 0 ;
+        }
+      ;
+name_intrinsic :
+        TOK_SUM
+      | TOK_TANH
+      | TOK_MAXVAL
+      | TOK_MIN
+      | TOK_MINVAL
+      | TOK_TRIM
+      | TOK_SQRT
+      | TOK_NINT
+      | TOK_FLOAT
+      | TOK_EXP
+      | TOK_COS
+      | TOK_COSH
+      | TOK_ACOS
+      | TOK_SIN
+      | TOK_SINH
+      | TOK_ASIN
+      | TOK_LOG
+      | TOK_TAN
+      | TOK_ATAN
+      | TOK_MOD
+      | TOK_SIGN
+      | TOK_MINLOC
+      | TOK_MAXLOC
+      | TOK_NAME
+      ;
+use_intrinsic_list :
+                               name_intrinsic
+      | use_intrinsic_list ',' name_intrinsic
+      ;
+list_couple :
+                        '(' list_expr ')'
+      | list_couple ',' '(' list_expr ')'
+      ;
+list_expr_equi :
+                           expr_equi
+      | list_expr_equi ',' expr_equi
+      ;
+expr_equi : '(' list_expr_equi1 ')'
+      ;
+list_expr_equi1 :
+                            ident dims
+      | list_expr_equi1 ',' ident dims
+      ;
+list_expr :
+                      expr
+      | list_expr ',' expr
+      ;
+opt_sep :
+      | TOK_FOURDOTS
+      ;
+after_type :
+        dcl nodimsgiven
+        {
+            /* if the variable is a parameter we can suppose that is*/
+            /*    value is the same on each grid. It is not useless */
+            /*    to create a copy of it on each grid               */
+            if ( ! inside_type_declare )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                ReWriteDeclarationAndAddTosubroutine_01($1);
+                pos_cur_decl = setposcur();
+                if ( firstpass == 0 && GlobalDeclaration == 0
+                                    && insubroutinedeclare == 0 )
+                {
+                    fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename);
+                    sprintf(ligne, "Module_Declar_%s.h", curmodulename);
+                    module_declar = open_for_write(ligne);
+                    GlobalDeclaration = 1 ;
+                    pos_cur_decl = setposcur();
+                }
+                $$ = $1;
+
+                if ( firstpass )
+                {
+                    Add_Globliste_1($1);
+                    if ( insubroutinedeclare )
+                    {
+                        if ( pointerdeclare ) Add_Pointer_Var_From_List_1($1);
+                        Add_Parameter_Var_1($1);
+                    }
+                    else
+                        Add_GlobalParameter_Var_1($1);
+
+                    /* If there's a SAVE declaration in module's subroutines we should    */
+                    /*    remove it from the subroutines declaration and add it in the    */
+                    /*    global declarations                                             */
+                    if ( aftercontainsdeclare && SaveDeclare )
+                    {
+                        if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1($1);
+                        else                Add_Save_Var_dcl_1($1);
+                    }
+                }
+            }
+            else
+            {
+                $$ = (listvar *) NULL;
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+            GlobalDeclarationType = 0;
+        }
+      | before_function name_routine arglist
+        {
+            insubroutinedeclare = 1;
+
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1($3);
+                Add_FunctionType_Var_1($2);
+            }
+            else
+                WriteBeginof_SubLoop();
+
+            strcpy(nameinttypename,"");
+        }
+      ;
+before_function :   TOK_FUNCTION    { functiondeclarationisdone = 1; }
+      ;
+before_parameter :  TOK_PARAMETER   { VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
+      ;
+
+data_stmt :             /* R534 */
+        TOK_DATA data_stmt_set_list
+
+data_stmt_set_list :
+        data_stmt_set
+      | data_stmt_set_list opt_comma data_stmt_set
+
+data_stmt_set :         /* R535 */
+        TOK_NAME TOK_SLASH data_stmt_value_list TOK_SLASH
+        {
+            createstringfromlistname(ligne,$3);
+            if (firstpass == 1) Add_Data_Var_1(&List_Data_Var,$1,ligne);
+            else                Add_Data_Var_1(&List_Data_Var_Cur,$1,ligne);
+        }
+      | datanamelist TOK_SLASH data_stmt_value_list TOK_SLASH
+        {
+            if (firstpass == 1)  Add_Data_Var_Names_01(&List_Data_Var,$1,$3);
+            else                 Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3);
+        }
+      | '(' lhs ',' dospec ')' TOK_SLASH data_stmt_value_list TOK_SLASH
+        {
+            createstringfromlistname(ligne,$7);
+            printf("###################################################################################################################\n");
+            printf("## CONV Error : data_implied_do statements (R537) are not yet supported. Please complain to the proper authorities.\n");
+            printf("l.%4d -- data_stmt_set : ( lhs , dospec ) /data_stmt_value_list/ -- lhs=|%s| dospec=|%s| data_stmt_value_list=|%s|\n",
+                line_num_input,$2,$4,ligne);
+            printf("## But, are you SURE you NEED a DATA construct ?\n");
+            printf("###################################################################################################################\n");
+            exit(1);
+        }
+      ;
+
+data_stmt_value_list :
+        expr_data                           { $$ = Insertname(NULL,$1,0); }
+      | expr_data ',' data_stmt_value_list  { $$ = Insertname($3,$1,1);   }
+      ;
+
+save :  before_save varsave
+      | before_save comblock varsave
+      | save opt_comma comblock opt_comma varsave
+      | save ',' varsave
+      ;
+before_save :
+        TOK_SAVE        { pos_cursave = setposcur()-4; }
+      ;
+varsave :
+      | TOK_NAME dims   { if ( ! inside_type_declare ) Add_Save_Var_1($1,$2); }
+      ;
+datanamelist :
+        TOK_NAME                        { $$ = Insertname(NULL,$1,0); }
+      | TOK_NAME '(' expr ')'           { printf("l.%4d -- INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n",line_num_input); exit(0); }
+      | datanamelist ',' datanamelist   { $$ = concat_listname($1,$3); }
+      ;
+expr_data :
+        opt_signe simple_const      { sprintf($$,"%s%s",$1,$2);  }
+      | expr_data '+' expr_data     { sprintf($$,"%s+%s",$1,$3); }
+      | expr_data '-' expr_data     { sprintf($$,"%s-%s",$1,$3); }
+      | expr_data '*' expr_data     { sprintf($$,"%s*%s",$1,$3); }
+      | expr_data '/' expr_data     { sprintf($$,"%s/%s",$1,$3); }
+      ;
+opt_signe :     { strcpy($$,""); }
+      | signe   { strcpy($$,$1); }
+      ;
+namelist :
+        TOK_NAMELIST ident
+      | TOK_NAMELIST comblock ident
+      | namelist opt_comma comblock opt_comma ident
+      | namelist ',' ident
+      ;
+before_dimension :
+        TOK_DIMENSION
+        {
+            positioninblock = 0;
+            pos_curdimension = setposcur()-9;
+        }
+
+dimension :
+        before_dimension opt_comma TOK_NAME dims lengspec
+        {
+            printf("l.%4d -- dimension : before_dimension opt_comma TOK_NAME = |%s| -- MHCHECK\n",line_num_input,$3);
+            if ( inside_type_declare ) break;
+            curvar = createvar($3,$4);
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar=insertvar(NULL, curvar);
+            $$ = settype("",curlistvar);
+            strcpy(vallengspec,"");
+        }
+      | dimension ',' TOK_NAME dims lengspec
+        {
+            printf("l.%4d -- dimension : dimension ',' TOK_NAME dims lengspec = |%s| -- MHCHECK\n",line_num_input,$3);
+            if ( inside_type_declare ) break;
+            curvar = createvar($3,$4);
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar = insertvar($1, curvar);
+            $$ = curlistvar;
+            strcpy(vallengspec,"");
+        }
+      ;
+private :
+        TOK_PRIVATE '\n'
+      | TOK_PRIVATE opt_sep use_name_list
+      ;
+public :
+        TOK_PUBLIC '\n'                     { $$ = (listname *) NULL; }
+      | TOK_PUBLIC opt_sep use_name_list    { $$ = $3; }
+      ;
+use_name_list :
+        TOK_NAME                            { $$ = Insertname(NULL,$1,0); }
+      | TOK_ASSIGNTYPE                      { $$ = Insertname(NULL,$1,0); }
+      | use_name_list ',' TOK_NAME          { $$ = Insertname($1,$3,0);   }
+      | use_name_list ',' TOK_ASSIGNTYPE    { $$ = Insertname($1,$3,0);   }
+      ;
+common :
+        before_common var_common_list
+        {
+            if ( inside_type_declare ) break;
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+      | before_common comblock var_common_list
+        {
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",$2);
+            Add_NameOfCommon_1($2,subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+      | common opt_comma comblock opt_comma var_common_list
+        {
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",$3);
+            Add_NameOfCommon_1($3,subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+      ;
+before_common :
+        TOK_COMMON              { positioninblock = 0; pos_curcommon = setposcur()-6;   }
+      | TOK_GLOBAL TOK_COMMON   { positioninblock = 0; pos_curcommon = setposcur()-6-7; }
+      ;
+var_common_list :
+        var_common                      { if ( ! inside_type_declare ) Add_Common_var_1(); }
+      | var_common_list ',' var_common  { if ( ! inside_type_declare ) Add_Common_var_1(); }
+      ;
+var_common :
+        TOK_NAME dims
+        {
+            positioninblock = positioninblock + 1 ;
+            strcpy(commonvar,$1);
+            commondim = $2;
+        }
+      ;
+comblock :
+        TOK_DSLASH
+        {
+            strcpy($$,"");
+            positioninblock=0;
+            strcpy(commonblockname,"");
+        }
+      | TOK_SLASH TOK_NAME TOK_SLASH
+        {
+            strcpy($$,$2);
+            positioninblock=0;
+            strcpy(commonblockname,$2);
+        }
+      ;
+opt_comma :
+      | ','
+      ;
+paramlist :
+        paramitem                   { $$=insertvar(NULL,$1); }
+      | paramlist ',' paramitem     { $$=insertvar($1,$3);   }
+      ;
+paramitem :
+        TOK_NAME '=' expr
+        {
+            if ( inside_type_declare ) break;
+            curvar=(variable *) calloc(1,sizeof(variable));
+            Init_Variable(curvar);
+            curvar->v_VariableIsParameter = 1;
+            strcpy(curvar->v_nomvar,$1);
+            strcpy(curvar->v_subroutinename,subroutinename);
+            strcpy(curvar->v_modulename,curmodulename);
+            strcpy(curvar->v_initialvalue,$3);
+            strcpy(curvar->v_commoninfile,cur_filename);
+            Save_Length($3,14);
+            $$ = curvar;
+        }
+      ;
+module_proc_stmt :
+        TOK_PROCEDURE proc_name_list
+      ;
+proc_name_list :
+        TOK_NAME
+      | proc_name_list ',' TOK_NAME
+      ;
+implicit :
+        TOK_IMPLICIT TOK_NONE
+        {
+            if ( insubroutinedeclare == 1 )
+            {
+                Add_ImplicitNoneSubroutine_1();
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_end-13,13);
+            }
+        }
+      | TOK_IMPLICIT TOK_REAL8
+      ;
+dcl :   options TOK_NAME dims lengspec initial_value
+        {
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar($2,curdim);
+                else                curvar = createvar($2,$3);
+                CreateAndFillin_Curvar(DeclType, curvar);
+                curlistvar = insertvar(NULL, curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                $$=settype(DeclType,curlistvar);
+            }
+            strcpy(vallengspec,"");
+        }
+      | dcl ',' TOK_NAME dims lengspec initial_value
+        {
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar($3, curdim);
+                else                curvar = createvar($3, $4);
+                CreateAndFillin_Curvar($1->var->v_typevar,curvar);
+                strcpy(curvar->v_typevar, $1->var->v_typevar);
+                curvar->v_catvar = get_cat_var(curvar);
+                curlistvar = insertvar($1, curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                $$=curlistvar;
+            }
+            strcpy(vallengspec,"");
+        }
+      ;
+nodimsgiven : { dimsgiven = 0; }
+      ;
+type :  typespec selector               { strcpy(DeclType,$1);  }
+      | before_character c_selector     { strcpy(DeclType,"character");  }
+      | typespec '*' TOK_CSTINT         { strcpy(DeclType,$1); strcpy(nameinttypename,$3);  }
+      | TOK_TYPEPAR attribute ')'       { strcpy(DeclType,"type"); GlobalDeclarationType = 1;  }
+      ;
+c_selector :
+      | '*' TOK_CSTINT              { c_selectorgiven = 1; strcpy(c_selectorname,$2); }
+      | '*' '(' c_attribute ')'     { c_star = 1;}
+      | '(' c_attribute ')'
+      ;
+c_attribute :
+        TOK_NAME clause opt_clause
+      | TOK_NAME '=' clause opt_clause
+      | clause opt_clause
+      ;
+before_character : TOK_CHARACTER    { pos_cur_decl = setposcur()-9; }
+      ;
+typespec :
+        TOK_INTEGER         { strcpy($$,"integer"); pos_cur_decl = setposcur()-7; }
+      | TOK_LOGICAL         { strcpy($$,"logical"); pos_cur_decl = setposcur()-7; }
+      | TOK_REAL            { strcpy($$,"real");    pos_cur_decl = setposcur()-4; }
+      | TOK_COMPLEX         { strcpy($$,"complex"); pos_cur_decl = setposcur()-7; }
+      | TOK_DOUBLECOMPLEX   { strcpy($$,"double complex"); pos_cur_decl = setposcur()-14; }
+      | TOK_DOUBLEPRECISION { pos_cur_decl = setposcur()-16; strcpy($$,"real"); strcpy(nameinttypename,"8"); }
+      ;
+lengspec :
+      | '*' proper_lengspec {strcpy(vallengspec,$2);}
+      ;
+proper_lengspec :
+        expr        { sprintf($$,"*%s",$1); }
+      | '(' '*' ')' { strcpy($$,"*(*)"); }
+      ;
+selector :
+      | '*' proper_selector
+      | '(' attribute ')'
+      ;
+proper_selector : expr
+      | '(' '*' ')'
+      ;
+attribute :
+        TOK_NAME clause
+      | TOK_NAME '=' clause
+        {
+            if ( strstr($3,"0.d0") )
+            {
+                strcpy(nameinttypename,"8");
+                strcpy(NamePrecision,"");
+            }
+            else
+                sprintf(NamePrecision,"%s = %s",$1,$3);
+        }
+      | TOK_NAME        { strcpy(NamePrecision,$1); }
+      | TOK_CSTINT      { strcpy(NamePrecision,$1); }
+      | TOK_ASSIGNTYPE  { strcpy(NamePrecision,$1); }
+      ;
+clause :
+        expr   { strcpy(CharacterSize,$1);  strcpy($$,$1);  }
+      | '*'    { strcpy(CharacterSize,"*"); strcpy($$,"*"); }
+      ;
+opt_clause :
+      | ',' TOK_NAME clause
+      ;
+options :
+      | TOK_FOURDOTS
+      | ',' attr_spec_list TOK_FOURDOTS
+      ;
+attr_spec_list : attr_spec
+      | attr_spec_list ',' attr_spec
+      ;
+attr_spec :
+        TOK_PARAMETER       { VariableIsParameter = 1; }
+      | access_spec
+      | TOK_ALLOCATABLE     { Allocatabledeclare = 1; }
+      | TOK_DIMENSION dims  { dimsgiven = 1; curdim = $2; }
+      | TOK_EXTERNAL        { ExternalDeclare = 1; }
+      | TOK_INTENT '(' intent_spec ')'
+                            { strcpy(IntentSpec,$3); }
+      | TOK_INTRINSIC
+      | TOK_OPTIONAL        { optionaldeclare = 1 ; }
+      | TOK_POINTER         { pointerdeclare = 1 ; }
+      | TOK_SAVE            { SaveDeclare = 1 ; }
+      | TOK_TARGET          { Targetdeclare = 1; }
+      ;
+intent_spec :
+        TOK_IN          { strcpy($$,$1); }
+      | TOK_OUT         { strcpy($$,$1); }
+      | TOK_INOUT       { strcpy($$,$1); }
+      ;
+access_spec :
+        TOK_PUBLIC      { PublicDeclare = 1;  }
+      | TOK_PRIVATE     { PrivateDeclare = 1; }
+      ;
+dims :  { $$ = (listdim*) NULL; }
+      | '(' dimlist ')'
+        {
+            $$ = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=$2;
+        }
+      ;
+dimlist :
+        dim
+        {
+            $$ = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1);
+        }
+      | dimlist ',' dim
+        {
+            $$ = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3);
+        }
+      ;
+dim :   ubound              { strcpy($$.first,"1"); strcpy($$.last,$1); Save_Length($1,1); }
+      | ':'                 { strcpy($$.first,"");  strcpy($$.last,"");                    }
+      | expr ':'            { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,""); }
+      | ':' expr            { strcpy($$.first,"");  strcpy($$.last,$2); Save_Length($2,1); }
+      | expr ':' ubound     { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,$3); Save_Length($3,1); }
+      ;
+ubound :
+        '*'                 { strcpy($$,"*"); }
+      | expr                { strcpy($$,$1);  }
+      ;
+expr :  uexpr               { strcpy($$,$1); }
+      | complex_const       { strcpy($$,$1); }
+      | predefinedfunction  { strcpy($$,$1); }
+      | '(' expr ')'        { sprintf($$,"(%s)",$2); }
+      ;
+
+predefinedfunction :
+        TOK_SUM minmaxlist ')'          { sprintf($$,"SUM(%s)",$2);}
+      | TOK_MAX minmaxlist ')'          { sprintf($$,"MAX(%s)",$2);}
+      | TOK_TANH '(' minmaxlist ')'     { sprintf($$,"TANH(%s)",$3);}
+      | TOK_MAXVAL '(' minmaxlist ')'   { sprintf($$,"MAXVAL(%s)",$3);}
+      | TOK_MIN minmaxlist ')'          { sprintf($$,"MIN(%s)",$2);}
+      | TOK_MINVAL '(' minmaxlist ')'   { sprintf($$,"MINVAL(%s)",$3);}
+      | TOK_TRIM '(' expr ')'           { sprintf($$,"TRIM(%s)",$3);}
+      | TOK_SQRT expr ')'               { sprintf($$,"SQRT(%s)",$2);}
+      | TOK_REAL '(' minmaxlist ')'     { sprintf($$,"REAL(%s)",$3);}
+      | TOK_NINT '(' expr ')'           { sprintf($$,"NINT(%s)",$3);}
+      | TOK_FLOAT '(' expr ')'          { sprintf($$,"FLOAT(%s)",$3);}
+      | TOK_EXP '(' expr ')'            { sprintf($$,"EXP(%s)",$3);}
+      | TOK_COS '(' expr ')'            { sprintf($$,"COS(%s)",$3);}
+      | TOK_COSH '(' expr ')'           { sprintf($$,"COSH(%s)",$3);}
+      | TOK_ACOS '(' expr ')'           { sprintf($$,"ACOS(%s)",$3);}
+      | TOK_SIN '(' expr ')'            { sprintf($$,"SIN(%s)",$3);}
+      | TOK_SINH '(' expr ')'           { sprintf($$,"SINH(%s)",$3);}
+      | TOK_ASIN '(' expr ')'           { sprintf($$,"ASIN(%s)",$3);}
+      | TOK_LOG '(' expr ')'            { sprintf($$,"LOG(%s)",$3);}
+      | TOK_TAN '(' expr ')'            { sprintf($$,"TAN(%s)",$3);}
+      | TOK_ATAN '(' expr ')'           { sprintf($$,"ATAN(%s)",$3);}
+      | TOK_ABS expr ')'                { sprintf($$,"ABS(%s)",$2);}
+      | TOK_MOD '(' minmaxlist ')'      { sprintf($$,"MOD(%s)",$3);}
+      | TOK_SIGN minmaxlist ')'         { sprintf($$,"SIGN(%s)",$2);}
+      | TOK_MINLOC '(' minmaxlist ')'   { sprintf($$,"MINLOC(%s)",$3);}
+      | TOK_MAXLOC '(' minmaxlist ')'   { sprintf($$,"MAXLOC(%s)",$3);}
+      ;
+minmaxlist : expr {strcpy($$,$1);}
+      | minmaxlist ',' expr     { sprintf($$,"%s,%s",$1,$3); }
+      ;
+uexpr : lhs                     { strcpy($$,$1); }
+      | simple_const            { strcpy($$,$1); }
+      | vec                     { strcpy($$,$1); }
+      | expr operation          { sprintf($$,"%s%s",$1,$2); }
+      | signe expr %prec '*'    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_NOT expr            { sprintf($$,"%s%s",$1,$2); }
+      ;
+signe : '+'        { strcpy($$,"+"); }
+      | '-'        { strcpy($$,"-"); }
+      ;
+
+operation :
+        '+' expr %prec '+'          { sprintf($$,"+%s",$2); }
+      | '-' expr %prec '+'          { sprintf($$,"-%s",$2); }
+      | '*' expr                    { sprintf($$,"*%s",$2); }
+      | TOK_DASTER expr             { sprintf($$,"%s%s",$1,$2); }
+      | TOK_EQ expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_EQV expr %prec TOK_EQV  { sprintf($$,"%s%s",$1,$2); }
+      | TOK_GT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | '>' expr %prec TOK_EQ       { sprintf($$," > %s",$2); }
+      | '<' expr %prec TOK_EQ       { sprintf($$," < %s",$2); }
+      | '>''=' expr %prec TOK_EQ    { sprintf($$," >= %s",$3); }
+      | '<''=' expr %prec TOK_EQ    { sprintf($$," <= %s",$3); }
+      | TOK_LT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_GE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_LE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_NE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_NEQV expr %prec TOK_EQV { sprintf($$,"%s%s",$1,$2); }
+      | TOK_XOR expr                { sprintf($$,"%s%s",$1,$2); }
+      | TOK_OR expr                 { sprintf($$,"%s%s",$1,$2); }
+      | TOK_AND expr                { sprintf($$,"%s%s",$1,$2); }
+      | TOK_SLASH after_slash       { sprintf($$,"%s",$2); }
+      | '=' after_equal             { sprintf($$,"%s",$2); }
+
+after_slash :                   { strcpy($$,""); }
+      | expr                    { sprintf($$,"/%s",$1); }
+      | '=' expr %prec TOK_EQ   { sprintf($$,"/= %s",$2);}
+      | TOK_SLASH expr          { sprintf($$,"//%s",$2); }
+      ;
+after_equal :
+        '=' expr %prec TOK_EQ   { sprintf($$,"==%s",$2); }
+      | expr                    { sprintf($$,"= %s",$1); }
+      ;
+
+lhs :   ident                           { strcpy($$,$1); }
+      | structure_component             { strcpy($$,$1); }
+      | array_ele_substring_func_ref    { strcpy($$,$1); }
+      ;
+
+beforefunctionuse :
+        {
+            agrif_parentcall = 0;
+            if ( !strcasecmp(identcopy, "Agrif_Parent") )   agrif_parentcall = 1;
+            if ( Agrif_in_Tok_NAME(identcopy) )
+            {
+                inagrifcallargument = 1;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+      ;
+array_ele_substring_func_ref :
+        begin_array                                         { strcpy($$,$1); if ( incalldeclare == 0 ) inagrifcallargument = 0;   }
+      | begin_array substring                               { sprintf($$," %s %s ",$1,$2); }
+      | structure_component '(' funarglist ')'              { sprintf($$," %s ( %s )",$1,$3); }
+      | structure_component '(' funarglist ')' substring    { sprintf($$," %s ( %s ) %s ",$1,$3,$5); }
+      ;
+begin_array :
+        ident '(' funarglist ')'
+        {
+            if ( inside_type_declare ) break;
+            sprintf($$," %s ( %s )",$1,$3);
+            ModifyTheAgrifFunction_0($3);
+            agrif_parentcall = 0;
+        }
+      ;
+structure_component :
+        lhs '%' declare_after_percent lhs
+        {
+            sprintf($$," %s %% %s ",$1,$4);
+            if ( incalldeclare == 0 ) inagrifcallargument = 0;
+        }
+      ;
+vec :
+        TOK_LEFTAB outlist TOK_RIGHTAB   { sprintf($$,"(/%s/)",$2); }
+      ;
+funarglist :
+        beforefunctionuse           { strcpy($$," "); }
+      | beforefunctionuse funargs   { strcpy($$,$2); }
+      ;
+funargs :
+        funarg              {  strcpy($$,$1); }
+      | funargs ',' funarg  {  sprintf($$,"%s,%s",$1,$3); }
+      ;
+funarg :
+        expr       {strcpy($$,$1);}
+      | triplet    {strcpy($$,$1);}
+      ;
+triplet :
+        expr ':' expr           {  sprintf($$,"%s :%s",$1,$3);}
+      | expr ':' expr ':' expr  {  sprintf($$,"%s :%s :%s",$1,$3,$5);}
+      | ':' expr ':' expr       {  sprintf($$,":%s :%s",$2,$4);}
+      | ':' ':' expr            {  sprintf($$,": : %s",$3);}
+      | ':' expr                {  sprintf($$,":%s",$2);}
+      | expr ':'                {  sprintf($$,"%s :",$1);}
+      | ':'                     {  sprintf($$,":");}
+      ;
+ident : TOK_NAME
+        {
+            if ( afterpercent == 0 )
+            {
+                if ( Agrif_in_Tok_NAME($1) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+                if ( !strcasecmp($1,"Agrif_Parent") )   agrif_parentcall = 1;
+                if ( VariableIsFunction($1) )
+                {
+                    if ( inagrifcallargument == 1 )
+                    {
+                        if ( !strcasecmp($1,identcopy) )
+                        {
+                            strcpy(sameagrifname,identcopy);
+                            sameagrifargument = 1;
+                        }
+                    }
+                    strcpy(identcopy,$1);
+                    pointedvar = 0;
+
+                    if (variscoupled_0($1)) strcpy(truename, getcoupledname_0($1));
+                    else                    strcpy(truename, $1);
+
+                    if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) )
+                    {
+                        if ( inagrifcallargument == 1 || varispointer_0(truename) == 1 )
+                        {
+                            if ( (IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1) )
+                            {
+                                if (varistyped_0(truename) == 0)    ModifyTheVariableName_0(truename,strlen($1));
+                            }
+                        }
+                        if ( inagrifcallargument != 1 || sameagrifargument ==1 )
+                        {
+                            Add_UsedInSubroutine_Var_1(truename);
+                        }
+                    }
+                    NotifyAgrifFunction_0(truename);
+                }
+            }
+            else
+            {
+                afterpercent = 0;
+            }
+        }
+      ;
+simple_const :
+        TOK_TRUE     { strcpy($$,".TRUE.");}
+      | TOK_FALSE    { strcpy($$,".FALSE.");}
+      | TOK_NULL_PTR { strcpy($$,"NULL()"); }
+      | TOK_CSTINT   { strcpy($$,$1); }
+      | TOK_CSTREAL  { strcpy($$,$1); }
+      | TOK_HEXA     { strcpy($$,$1); }
+      | simple_const TOK_NAME
+                     { sprintf($$,"%s%s",$1,$2); }
+      | string_constant opt_substring
+      ;
+string_constant :
+        TOK_CHAR_CONSTANT                   { strcpy($$,$1);}
+      | string_constant TOK_CHAR_CONSTANT
+      | TOK_CHAR_MESSAGE                    { strcpy($$,$1);}
+      | TOK_CHAR_CUT                        { strcpy($$,$1);}
+      ;
+opt_substring :     { strcpy($$," ");}
+      | substring   { strcpy($$,$1);}
+      ;
+substring :
+        '(' optexpr ':' optexpr ')' { sprintf($$,"(%s :%s)",$2,$4);}
+      ;
+optexpr :           { strcpy($$," ");}
+      | expr        { strcpy($$,$1);}
+      ;
+opt_expr :
+        '\n'        { strcpy($$," ");}
+      | expr        { strcpy($$,$1);}
+      ;
+initial_value :     { InitialValueGiven = 0; }
+      | '=' expr
+        {
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,$2);
+            InitialValueGiven = 1;
+        }
+      | TOK_POINT_TO expr
+        {
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,$2);
+            InitialValueGiven = 2;
+        }
+      ;
+complex_const :
+        '(' uexpr ',' uexpr ')' {sprintf($$,"(%s,%s)",$2,$4); }
+      ;
+use_stat :
+        word_use TOK_NAME
+        {
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule, "%s", $2);
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1($2);
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuse_0($2);
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+      | word_use TOK_NAME ',' rename_list
+        {
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1($2,$4);
+                    coupletmp = $4;
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne, coupletmp->c_namevar);
+                        strcat(ligne, " => ");
+                        strcat(ligne, coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",$2);
+                }
+                Add_NameOfModuleUsed_1($2);
+            }
+            if ( inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+            }
+        }
+      | word_use TOK_NAME ',' TOK_ONLY ':' '\n'
+        {
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule,"%s",$2);
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1($2);
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuseonly_0($2);
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+      | word_use  TOK_NAME ',' TOK_ONLY ':' only_list
+        {
+            /* if variables has been declared in a subroutine      */
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1($2,$6);
+                    coupletmp = $6;
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne,coupletmp->c_namevar);
+                        if ( strcasecmp(coupletmp->c_namepointedvar,"") )   strcat(ligne," => ");
+                        strcat(ligne,coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",$2);
+                }
+                Add_NameOfModuleUsed_1($2);
+            }
+            else /* if ( firstpass == 0 ) */
+            {
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                    if (oldfortran_out)  variableisglobalinmodule($6,$2,oldfortran_out,pos_curuseold);
+                }
+                else
+                {
+                    /* if we are in the module declare and if the    */
+                    /* onlylist is a list of global variable         */
+                    variableisglobalinmodule($6, $2, fortran_out,pos_curuse);
+                }
+            }
+        }
+      ;
+word_use :
+        TOK_USE
+        {
+            pos_curuse = setposcur()-strlen($1);
+            if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);
+        }
+      ;
+rename_list :
+        rename_name
+        {
+            $$ = $1;
+        }
+      | rename_list ',' rename_name
+        {
+            /* insert the variable in the list $1                 */
+            $3->suiv = $1;
+            $$ = $3;
+        }
+      ;
+rename_name : TOK_NAME TOK_POINT_TO TOK_NAME
+        {
+            coupletmp = (listcouple *) calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,$3);
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+        }
+      ;
+only_list :
+        only_name   {  $$ = $1; }
+      | only_list ',' only_name
+        {
+            /* insert the variable in the list $1                 */
+            $3->suiv = $1;
+            $$ = $3;
+        }
+      ;
+only_name :
+        TOK_NAME TOK_POINT_TO TOK_NAME
+        {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,$3);
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+            pointedvar = 1;
+            Add_UsedInSubroutine_Var_1($1);
+        }
+      | TOK_NAME
+        {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,"");
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+        }
+      ;
+
+/* R209 : execution-part-construct */
+execution-part-construct:
+        executable-construct
+      | format-stmt
+      ;
+
+/* R213 : executable-construct */
+executable-construct:
+        action-stmt
+      | do-construct
+      | case-construct
+      | if-construct
+      | where-construct
+      ;
+
+/* R214 : action-stmt */
+action-stmt :
+        TOK_CONTINUE
+      | ident_dims after_ident_dims
+      | goto
+      | call
+      | iofctl ioctl
+      | read option_read
+      | TOK_WRITE ioctl
+      | TOK_WRITE ioctl outlist
+      | TOK_REWIND after_rewind
+      | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'          { inallocate = 0; }
+      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'   { inallocate = 0; }
+      | TOK_EXIT optexpr
+      | TOK_RETURN opt_expr
+      | TOK_CYCLE opt_expr
+      | stop opt_expr
+      | int_list
+      | TOK_NULLIFY '(' pointer_name_list ')'
+      | word_endunit
+        {
+            GlobalDeclaration = 0 ;
+            if ( firstpass == 0 && strcasecmp(subroutinename,"") )
+            {
+                if ( module_declar && insubroutinedeclare == 0 )    fclose(module_declar);
+            }
+            if ( strcasecmp(subroutinename,"") )
+            {
+                if ( inmodulemeet == 1 )
+                {
+                    /* we are in a module                                */
+                    if ( insubroutinedeclare == 1 )
+                    {
+                        /* it is like an end subroutine <name>            */
+                        insubroutinedeclare = 0 ;
+                        pos_cur = setposcur();
+                        closeandcallsubloopandincludeit_0(1);
+                        functiondeclarationisdone = 0;
+                    }
+                    else
+                    {
+                        /* it is like an end module <name>                */
+                        inmoduledeclare = 0 ;
+                        inmodulemeet = 0 ;
+                    }
+                }
+                else
+                {
+                    insubroutinedeclare = 0;
+                    pos_cur = setposcur();
+                    closeandcallsubloopandincludeit_0(2);
+                    functiondeclarationisdone = 0;
+                }
+            }
+            strcpy(subroutinename,"");
+        }
+      | word_endprogram opt_name
+        {
+            insubroutinedeclare = 0;
+            inprogramdeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(3);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+      | word_endsubroutine opt_name
+        {
+            if ( strcasecmp(subroutinename,"") )
+            {
+                insubroutinedeclare = 0;
+                pos_cur = setposcur();
+                closeandcallsubloopandincludeit_0(1);
+                functiondeclarationisdone = 0;
+                strcpy(subroutinename,"");
+            }
+        }
+      | word_endfunction opt_name
+        {
+            insubroutinedeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(0);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+      | TOK_ENDMODULE opt_name
+        {
+            /* if we never meet the contains keyword               */
+            if ( firstpass == 0 )
+            {
+                RemoveWordCUR_0(fortran_out, strlen($2)+11);    // Remove word "end module"
+                if ( inmoduledeclare && ! aftercontainsdeclare )
+                {
+                    Write_Closing_Module(1);
+                }
+                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
+                if ( module_declar && insubroutinedeclare == 0 )
+                {
+                    fclose(module_declar);
+                }
+            }
+            inmoduledeclare = 0 ;
+            inmodulemeet = 0 ;
+            aftercontainsdeclare = 1;
+            strcpy(curmodulename, "");
+            GlobalDeclaration = 0 ;
+        }
+      | if-stmt
+      | where-stmt
+      | TOK_CONTAINS
+        {
+            if ( inside_type_declare ) break;
+            if ( inmoduledeclare )
+            {
+                if ( firstpass == 0 )
+                {
+                    RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
+                    Write_Closing_Module(0);
+                }
+                inmoduledeclare = 0 ;
+                aftercontainsdeclare = 1;
+            }
+            else if ( insubroutinedeclare )
+            {
+                incontainssubroutine = 1;
+                insubroutinedeclare  = 0;
+                incontainssubroutine = 0;
+                functiondeclarationisdone = 0;
+
+                if ( firstpass )
+                    List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0);
+                else
+                    closeandcallsubloop_contains_0();
+
+                strcpy(subroutinename, "");
+            }
+            else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input);
+        }
+      ;
+
+/* R601 : variable */
+//variable : expr
+//       ;
+
+/* R734 : assignment-stmt */
+// assignment-stmt: variable '=' expr
+//       ;
+assignment-stmt: expr
+      ;
+
+/* R741 : where-stmt */
+where-stmt: TOK_WHERE '(' mask-expr ')' where-assignment-stmt
+      ;
+
+/* R742 : where-construct */
+where-construct: where-construct-stmt line-break opt-where-body-construct opt-masked-elsewhere-construct opt-elsewhere-construct end-where-stmt
+      ;
+
+opt-where-body-construct:
+      | opt-where-body-construct where-body-construct line-break
+      ;
+
+opt-masked-elsewhere-construct :
+      | opt-masked-elsewhere-construct masked-elsewhere-stmt line-break opt-where-body-construct
+      ;
+
+opt-elsewhere-construct:
+      | opt-elsewhere-construct elsewhere-stmt line-break opt-where-body-construct
+      ;
+
+/* R743 : where-construct-stmt */
+where-construct-stmt:
+        TOK_WHERE '(' mask-expr ')'
+      ;
+
+/* R744 : where-body-construct */
+where-body-construct: where-assignment-stmt
+      | where-stmt
+      | where-construct
+      ;
+
+/* R745 : where-assignment-stmt */
+where-assignment-stmt: assignment-stmt
+      ;
+
+/* R746 : mask-expr */
+mask-expr: expr
+      ;
+
+/* R747 : masked-elsewhere-stmt */
+masked-elsewhere-stmt:
+        TOK_ELSEWHEREPAR mask-expr ')'
+      | TOK_ELSEWHEREPAR mask-expr ')' TOK_NAME
+      ;
+
+/* R748: elsewhere-stmt */
+elsewhere-stmt:
+        TOK_ELSEWHERE
+      | TOK_ELSEWHERE TOK_NAME
+      ;
+
+/* R749: end-where-stmt */
+end-where-stmt:
+        TOK_ENDWHERE
+      | TOK_ENDWHERE TOK_NAME
+      ;
+
+/* R752 : forall-header */
+forall-header :
+     ;
+
+/* R801 : block */
+block:
+      |block execution-part-construct
+      |block execution-part-construct line-break
+      ;
+
+/* R813 : do-construct */
+do-construct:
+        block-do-construct
+      ;
+
+/* R814 : block-do-construct */
+block-do-construct:
+        do-stmt line-break do-block end-do
+      ;
+
+/* R815 : do-stmt */
+do-stmt:
+        label-do-stmt
+      | nonlabel-do-stmt
+      ;
+
+/* R816 : label-do-stmt */
+label-do-stmt:
+        TOK_NAME ':' TOK_PLAINDO label
+      |              TOK_PLAINDO label
+      | TOK_NAME ':' TOK_PLAINDO label loop-control
+      |              TOK_PLAINDO label loop-control
+      ;
+
+/* R817 : nonlabel-do-stmt */
+nonlabel-do-stmt:
+        TOK_NAME ':' TOK_PLAINDO
+      |              TOK_PLAINDO
+      | TOK_NAME ':' TOK_PLAINDO loop-control
+      |              TOK_PLAINDO loop-control
+      ;
+
+/* R818 : loop-control */
+loop-control:
+        opt_comma do-variable '=' expr ',' expr
+      | opt_comma do-variable '=' expr ',' expr ',' expr
+      | opt_comma TOK_WHILE '(' expr ')'
+      | opt_comma TOK_CONCURRENT forall-header
+      ;
+
+/* R819 : do-variable */
+do-variable : ident
+     ;
+
+/* R820 : do-block */
+do-block: block
+     ;
+
+/* R821 : end-do */
+end-do: end-do-stmt
+     | continue-stmt
+     ;
+
+/* R822 : end-do-stmt */
+end-do-stmt:
+        TOK_ENDDO
+      | TOK_ENDDO TOK_NAME
+      ;
+
+/* R832 : if-construct */
+if-construct: if-then-stmt line-break block opt-else-if-stmt-block opt-else-stmt-block end-if-stmt
+      ;
+
+opt-else-if-stmt-block:
+      | else-if-stmt-block
+      | opt-else-if-stmt-block else-if-stmt-block
+      ;
+
+else-if-stmt-block:
+        else-if-stmt line-break block
+      ;
+
+opt-else-stmt-block:
+      | else-stmt-block
+      | opt-else-stmt-block else-if-stmt-block
+      ;
+
+else-stmt-block: else-stmt line-break block
+        ;
+
+/* R833 : if-then-stmt */
+if-then-stmt:
+         TOK_NAME ':' TOK_LOGICALIF '(' expr ')' TOK_THEN
+      |               TOK_LOGICALIF '(' expr ')' TOK_THEN
+      ;
+
+/* R834 : else-if-stmt */
+else-if-stmt:
+        TOK_ELSEIF '(' expr ')' TOK_THEN
+      | TOK_ELSEIF '(' expr ')' TOK_THEN TOK_NAME
+      ;
+
+/* R835 : else-stmt */
+else-stmt:
+        TOK_ELSE
+      | TOK_ELSE TOK_NAME
+      ;
+
+/* R836 : end-if-stmt */
+end-if-stmt:
+        TOK_ENDIF
+      | TOK_ENDIF TOK_NAME
+      ;
+
+/* R837 : if-stmt */
+if-stmt: TOK_LOGICALIF '(' expr ')' action-stmt
+        ;
+
+/* R838 : case-construct */
+case-construct: select-case-stmt line-break opt_case-stmt-block end-select-stmt
+        ;
+
+opt_case-stmt-block:
+        | case-stmt-block
+        | opt_case-stmt-block case-stmt-block
+        ;
+
+case-stmt-block: case-stmt line-break block
+        ;
+
+/* R839 : select-case-stmt */
+select-case-stmt :
+          TOK_NAME ':' TOK_SELECTCASE '(' expr ')'
+        |              TOK_SELECTCASE '(' expr ')'
+        ;
+
+/* R840 : case-stmt */
+case-stmt:
+          TOK_CASE case-selector
+        | TOK_CASE case-selector TOK_NAME
+        ;
+
+/* R840 : end-select-stmt */
+end-select-stmt:
+          TOK_ENDSELECT
+        | TOK_ENDSELECT TOK_NAME
+        ;
+
+/* R843 : case-selector */
+case-selector:
+          '(' case-value-range-list ')'
+        | TOK_DEFAULT
+        ;
+
+case-value-range-list:
+        case-value-range
+      | case-value-range-list ',' case-value-range
+      ;
+
+/* R844: case-value-range */
+case-value-range :
+        case-value
+      | case-value ':'
+      | ':' case-value
+      | case-value ':' case-value
+      ;
+
+/* R845 : case-value */
+case-value: expr
+        ;
+
+/* R854 : continue-stmt */
+continue-stmt: TOK_CONTINUE
+        ;
+
+/* R1001 : format-stmt */
+format-stmt: TOK_FORMAT
+        ;
+
+word_endsubroutine :
+        TOK_ENDSUBROUTINE
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+            functiondeclarationisdone = 0;
+        }
+      ;
+word_endunit :
+        TOK_ENDUNIT
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+        }
+      ;
+word_endprogram :
+        TOK_ENDPROGRAM
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+        }
+      ;
+word_endfunction :
+        TOK_ENDFUNCTION
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+        }
+      ;
+
+opt_name : '\n'  {strcpy($$,"");}
+      | TOK_NAME {strcpy($$,$1);}
+      ;
+
+before_dims : { created_dimensionlist = 0; }
+      ;
+ident_dims :
+        ident before_dims dims dims
+        {
+            created_dimensionlist = 1;
+            if ( ($3 == NULL) || ($4 == NULL) ) break;
+            if  ( agrif_parentcall == 1 )
+            {
+                ModifyTheAgrifFunction_0($3->dim.last);
+                agrif_parentcall = 0;
+                fprintf(fortran_out," = ");
+            }
+        }
+      | ident_dims '%' declare_after_percent ident before_dims dims dims
+        {
+            created_dimensionlist = 1;
+        }
+      ;
+int_list :
+        TOK_CSTINT
+      | int_list ',' TOK_CSTINT
+      ;
+after_ident_dims :
+        '=' expr
+      | TOK_POINT_TO expr
+      ;
+call :  keywordcall opt_call
+        {
+            inagrifcallargument = 0 ;
+            incalldeclare=0;
+            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
+                strcpy(subofagrifinitgrids,subroutinename);
+            }
+            Instanciation_0(sameagrifname);
+        }
+      ;
+opt_call :
+      | '(' opt_callarglist  ')'
+      ;
+opt_callarglist :
+      | callarglist
+      ;
+keywordcall :
+        before_call TOK_FLUSH
+      | before_call TOK_NAME
+        {
+            if (!strcasecmp($2,"MPI_Init") )    callmpiinit = 1;
+            else                                callmpiinit = 0;
+
+            if (!strcasecmp($2,"Agrif_Init_Grids") )
+            {
+                callagrifinitgrids = 1;
+                strcpy(meetagrifinitgrids,subroutinename);
+            }
+            else
+            {
+                callagrifinitgrids = 0;
+            }
+            if ( Vartonumber($2) == 1 )
+            {
+                incalldeclare = 1;
+                inagrifcallargument = 1 ;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+      ;
+before_call : TOK_CALL  { pos_curcall=setposcur()-4; }
+      ;
+callarglist :
+        callarg
+      | callarglist ',' callarg
+      ;
+callarg :
+        expr
+        {
+            if ( callmpiinit == 1 )
+            {
+                strcpy(mpiinitvar,$1);
+                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
+            }
+        }
+      | '*' TOK_CSTINT
+      ;
+
+stop :  TOK_PAUSE
+      | TOK_STOP
+      ;
+
+option_inlist :
+      | inlist
+      ;
+option_read :
+        ioctl option_inlist
+      | infmt opt_inlist
+      ;
+opt_inlist :
+      | ',' inlist
+      ;
+ioctl : '(' ctllist ')'
+      ;
+after_rewind :
+        '(' ident ')'
+      | '(' TOK_CSTINT ')'
+      | TOK_CSTINT
+      | '(' uexpr ')'
+      | TOK_NAME
+      ;
+ctllist :
+        ioclause
+      | ctllist ',' ioclause
+      ;
+ioclause :
+        fexpr
+      | '*'
+      | TOK_DASTER
+      | ident expr dims
+      | ident expr '%' declare_after_percent ident_dims
+      | ident '(' triplet ')'
+      | ident '*'
+      | ident TOK_DASTER
+      ;
+
+declare_after_percent:      { afterpercent = 1; }
+      ;
+iofctl :
+        TOK_OPEN
+      | TOK_CLOSE
+      | TOK_FLUSH
+      ;
+infmt :  unpar_fexpr
+      | '*'
+      ;
+
+read :  TOK_READ
+      | TOK_INQUIRE
+      | TOK_PRINT
+      ;
+
+fexpr : unpar_fexpr
+      | '(' fexpr ')'
+      ;
+unpar_fexpr :
+        lhs
+      | simple_const
+      | fexpr addop fexpr %prec '+'
+      | fexpr '*' fexpr
+      | fexpr TOK_SLASH fexpr
+      | fexpr TOK_DASTER fexpr
+      | addop fexpr %prec '*'
+      | fexpr TOK_DSLASH fexpr
+      | TOK_FILE expr
+      | TOK_UNIT expr
+      | TOK_NML expr
+      | TOK_FMT expr
+      | TOK_EXIST expr
+      | TOK_ERR expr
+      | TOK_END expr
+      | TOK_NAME '=' expr
+      | predefinedfunction
+      ;
+addop : '+'
+      | '-'
+      ;
+inlist : inelt
+      | inlist ',' inelt
+      ;
+// opt_lhs :
+//       | lhs
+//       ;
+inelt : //opt_lhs opt_operation
+        lhs opt_operation
+      | '(' inlist ')' opt_operation
+      | predefinedfunction opt_operation
+      | simple_const opt_operation
+      | '(' inlist ',' dospec ')'
+      ;
+opt_operation :
+      | operation
+      | opt_operation operation
+      ;
+outlist :
+        complex_const       { strcpy($$,$1); }
+      | predefinedfunction  { strcpy($$,$1); }
+      | uexpr               { strcpy($$,$1); }
+      | other               { strcpy($$,$1); }
+      | uexpr   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
+      | uexpr   ',' other   { sprintf($$,"%s,%s",$1,$3); }
+      | other   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
+      | other   ',' other   { sprintf($$,"%s,%s",$1,$3); }
+      | outlist ',' expr    { sprintf($$,"%s,%s",$1,$3); }
+      | outlist ',' other   { sprintf($$,"%s,%s",$1,$3); }
+      ;
+other :
+        '(' uexpr   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
+      | '(' outlist ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
+      | '(' other   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
+dospec :
+        TOK_NAME '=' expr ',' expr           { sprintf($$,"%s=%s,%s)",$1,$3,$5);}
+      | TOK_NAME '=' expr ',' expr ',' expr  { sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);}
+      ;
+goto :  TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
+      | TOK_PLAINGOTO TOK_CSTINT
+      ;
+allocation_list :
+        allocate_object
+      | allocation_list ',' allocate_object
+      ;
+allocate_object :
+        lhs     { Add_Allocate_Var_1($1,curmodulename); }
+      ;
+allocate_object_list :
+        allocate_object
+      | allocate_object_list ',' allocate_object
+      ;
+opt_stat_spec :
+      | ',' TOK_STAT '=' lhs
+      ;
+pointer_name_list :
+        ident
+      | pointer_name_list ',' ident
+      ;
+
+%%
+
+void process_fortran(const char *input_file)
+{
+    extern FILE *fortran_in;
+    extern FILE *fortran_out;
+
+    char output_file[LONG_FNAME];
+    char input_fullpath[LONG_FNAME];
+
+    if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass);
+
+     yydebug=0;
+/******************************************************************************/
+/*  1-  Open input file                                                       */
+/******************************************************************************/
+
+    strcpy(cur_filename, input_file);
+    sprintf(input_fullpath, "%s/%s", input_dir, input_file);
+
+    fortran_in = fopen(input_fullpath, "r");
+    if (! fortran_in)
+    {
+        printf("Error : File %s does not exist\n", input_fullpath);
+        exit(1);
+    }
+
+/******************************************************************************/
+/*  2-  Variables initialization                                              */
+/******************************************************************************/
+
+    line_num_input = 1;
+    PublicDeclare = 0;
+    PrivateDeclare = 0;
+    ExternalDeclare = 0;
+    SaveDeclare = 0;
+    pointerdeclare = 0;
+    optionaldeclare = 0;
+    incalldeclare = 0;
+    inside_type_declare = 0;
+    Allocatabledeclare = 0 ;
+    Targetdeclare = 0 ;
+    VariableIsParameter =  0 ;
+    strcpy(NamePrecision,"");
+    c_star = 0 ;
+    functiondeclarationisdone = 0;
+    insubroutinedeclare = 0 ;
+    strcpy(subroutinename," ");
+    isrecursive = 0;
+    InitialValueGiven = 0 ;
+    GlobalDeclarationType = 0;
+    inmoduledeclare = 0;
+    incontainssubroutine = 0;
+    afterpercent = 0;
+    aftercontainsdeclare = 1;
+    strcpy(nameinttypename,"");
+
+/******************************************************************************/
+/*  3-  Parsing of the input file (1 time)                                    */
+/******************************************************************************/
+
+    sprintf(output_file, "%s/%s", output_dir, input_file);
+
+    if (firstpass == 0) fortran_out = fopen(output_file,"w");
+
+    fortran_parse();
+
+    if (firstpass == 0) NewModule_Creation_0();
+    if (firstpass == 0) fclose(fortran_out);
+}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c	(revision 5682)
@@ -48,92 +48,83 @@
 void Add_Common_var_1()
 {
-   listvar *newvar;
-   listvar *newvar2;
-   variable *newvariable;
-   listdim *dims;
-   char listdimension[LONG_C];
-   char ligne[LONG_C];
-   int out;
-
-   if ( firstpass == 1 )
-   {
-
-   newvar = (listvar *)malloc(sizeof(listvar));
-   newvariable = (variable *)malloc(sizeof(variable));
-   /*                                                                         */
-   Init_Variable(newvariable);
-   /*                                                                         */
-   strcpy(newvariable->v_nomvar,commonvar);
-   Save_Length(commonvar,4);
-   strcpy(newvariable->v_commonname,commonblockname);
-   Save_Length(commonblockname,7);
-   strcpy(newvariable->v_modulename,curmodulename);
-   Save_Length(curmodulename,6);
-   strcpy(newvariable->v_subroutinename,subroutinename);
-   Save_Length(subroutinename,11);
-   newvariable->v_positioninblock= positioninblock;
-   newvariable->v_common=1;
-   strcpy(newvariable->v_commoninfile,mainfile);
-   Save_Length(mainfile,10);
-
-   newvar->var = newvariable;
-
-   if ( commondim )
-   {
-      newvariable->v_dimension=commondim;
-      newvariable->v_dimensiongiven=1;
-      newvariable->v_nbdim=num_dims(commondim);
-      /* Creation of the string for the dimension of this variable            */
-      dimsempty = 1;
-      strcpy(listdimension,"");
-
-      if ( commondim )
-      {
-         dims = commondim;
-         while (dims)
-         {
-            if ( strcasecmp(dims->dim.first,"") ||
-                 strcasecmp(dims->dim.last,""))  dimsempty = 0;
-            sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
-            strcat(listdimension,ligne);
-            if ( dims->suiv ) strcat(listdimension,",");
-            dims = dims->suiv;
-         }
-         if ( dimsempty == 1 ) newvariable->v_dimsempty=1;
-      }
-      strcpy(newvariable->v_readedlistdimension,listdimension);
-      Save_Length(listdimension,15);
-   }
-
-
-   newvar->suiv = NULL;
-
-   if ( !List_Common_Var )
-   {
-      List_Common_Var = newvar;
-   }
-   else
-   {
-      newvar2 = List_Common_Var;
-      out = 0 ;
-      while ( newvar2 && out == 0 )
-      {
-         if ( !strcasecmp(newvar2->var->v_nomvar,commonvar) &&
-              !strcasecmp(newvar2->var->v_commonname,commonblockname) &&
-              !strcasecmp(newvar2->var->v_subroutinename,subroutinename)
-                          ) out = 1 ;
-         else newvar2 = newvar2->suiv;
-      }
-      if ( out == 0 )
-      {
-         newvar->suiv = List_Common_Var;
-         List_Common_Var = newvar;
-      }
-      else
-      {
-         free(newvar);
-      }
-   }
-   }
+    listvar *newvar;
+    listvar *newvar2;
+    variable *newvariable;
+    listdim *dims;
+    char listdimension[LONG_M];
+    char ligne[LONG_M];
+    int out;
+
+    if ( firstpass == 1 )
+    {
+        newvar = (listvar *) calloc(1,sizeof(listvar));
+        newvariable = (variable *) calloc(1,sizeof(variable));
+
+        Init_Variable(newvariable);
+
+        strcpy(newvariable->v_nomvar,commonvar);
+        strcpy(newvariable->v_commonname,commonblockname);
+        strcpy(newvariable->v_modulename,curmodulename);
+        strcpy(newvariable->v_subroutinename,subroutinename);
+        strcpy(newvariable->v_commoninfile,cur_filename);
+        newvariable->v_positioninblock = positioninblock;
+        newvariable->v_common = 1;
+        newvar->var = newvariable;
+
+        if ( commondim )
+        {
+            newvariable->v_dimension = commondim;
+            newvariable->v_dimensiongiven = 1;
+            newvariable->v_nbdim = get_num_dims(commondim);
+
+            /* Creation of the string for the dimension of this variable            */
+            dimsempty = 1;
+            strcpy(listdimension,"");
+
+            dims = commondim;
+            while (dims)
+            {
+                if ( strcasecmp(dims->dim.first,"") ||
+                     strcasecmp(dims->dim.last,""))  dimsempty = 0;
+                sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+                strcat(listdimension,ligne);
+                if ( dims->suiv ) strcat(listdimension,",");
+                dims = dims->suiv;
+            }
+            if ( dimsempty == 1 ) newvariable->v_dimsempty = 1;
+
+            strcpy(newvariable->v_readedlistdimension,listdimension);
+            Save_Length(listdimension,15);
+        }
+
+        newvar->suiv = NULL;
+
+        if ( !List_Common_Var )
+        {
+            List_Common_Var = newvar;
+        }
+        else
+        {
+            newvar2 = List_Common_Var;
+            out = 0 ;
+            while ( newvar2 && out == 0 )
+            {
+                if ( !strcasecmp(newvar2->var->v_nomvar,commonvar) &&
+                     !strcasecmp(newvar2->var->v_commonname,commonblockname) &&
+                     !strcasecmp(newvar2->var->v_subroutinename,subroutinename)
+                   ) out = 1 ;
+                else newvar2 = newvar2->suiv;
+            }
+            if ( out == 0 )
+            {
+                newvar->suiv = List_Common_Var;
+                List_Common_Var = newvar;
+            }
+            else
+            {
+                free(newvar);
+            }
+        }
+    }
 }
 
@@ -145,37 +136,39 @@
 /*                                                                            */
 /******************************************************************************/
-listnom *Addtolistnom(char *nom, listnom *listin,int value)
-{
-   listnom *newnom;
-   listnom *parcours;
-   int out;
-
-   newnom=(listnom *) malloc (sizeof (listnom));
-   strcpy(newnom->o_nom,nom);
-   Save_Length(nom,23);
-   newnom->o_val = value;
-   newnom->suiv = NULL;
-
-   if ( !listin ) listin = newnom;
-   else
-   {
-      parcours = listin;
-      out = 0 ;
-      while ( parcours && out == 0 )
-      {
-         if ( !strcasecmp(parcours->o_nom,nom) ) out = 1 ;
-         else parcours=parcours->suiv;
-      }
-      if ( out == 0 )
-      {
-          newnom->suiv = listin;
-          listin = newnom;
-      }
-      else
-      {
-         free(newnom);
-      }
-   }
-   return listin;
+listnom *Addtolistnom(const char *nom, listnom *listin, int value)
+{
+    listnom *newnom;
+    listnom *parcours;
+    int out;
+
+    newnom = (listnom*) calloc(1, sizeof(listnom));
+    strcpy(newnom->o_nom, nom);
+    newnom->o_val = value;
+    newnom->suiv = NULL;
+
+    if ( listin == NULL )
+    {
+        listin = newnom;
+    }
+    else
+    {
+        parcours = listin;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->o_nom, nom) ) out = 1 ;
+            else parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newnom->suiv = listin;
+            listin = newnom;
+        }
+        else
+        {
+            free(newnom);
+        }
+    }
+    return listin;
 }
 
@@ -193,37 +186,35 @@
 /*                                                                            */
 /******************************************************************************/
-listname *Addtolistname(char *nom,listname *input)
-{
-   listname *newnom;
-   listname *parcours;
-   int out;
-
-   if ( !input )
-   {
-      newnom=(listname *) malloc (sizeof (listname));
-      strcpy(newnom->n_name,nom);
-      Save_Length(nom,20);
-      newnom->suiv = NULL;
-      input = newnom;
-   }
-   else
-   {
-      parcours = input;
-      out = 0 ;
-      while ( parcours && out == 0 )
-      {
-         if ( !strcasecmp(parcours->n_name,nom) ) out = 1;
-         else parcours=parcours->suiv;
-      }
-      if ( out == 0 )
-      {
-         newnom=(listname *) malloc (sizeof (listname));
-         strcpy(newnom->n_name,nom);
-         Save_Length(nom,20);
-         newnom->suiv = input;
-         input = newnom;
-      }
-   }
-   return input;
+listname *Addtolistname(const char *nom, listname *input)
+{
+    listname *newnom;
+    listname *parcours;
+    int out;
+
+    if ( !input )
+    {
+        newnom = (listname*) calloc(1, sizeof(listname));
+        strcpy(newnom->n_name, nom);
+        newnom->suiv = NULL;
+        input = newnom;
+    }
+    else
+    {
+        parcours = input;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->n_name,nom) ) out = 1;
+            else parcours=parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newnom = (listname*) calloc(1,sizeof(listname));
+            strcpy(newnom->n_name, nom);
+            newnom->suiv = input;
+            input = newnom;
+        }
+    }
+    return input;
 }
 
@@ -236,20 +227,20 @@
 /*                                                                            */
 /******************************************************************************/
-int ModuleIsDefineInInputFile(char *name)
-{
-   listnom *newnom;
-   int out;
-
-   out = 0;
-   if ( listofmodules )
-   {
-      newnom = listofmodules;
-      while( newnom && out == 0 )
-      {
-         if ( !strcasecmp(newnom->o_nom,name) ) out = 1 ;
-         else newnom=newnom->suiv;
-      }
-   }
-   return out;
+int ModuleIsDefineInInputFile(const char *name)
+{
+    listnom *newnom;
+    int out;
+
+    out = 0;
+    if ( listofmodules )
+    {
+        newnom = listofmodules;
+        while( newnom && out == 0 )
+        {
+            if ( !strcasecmp(newnom->o_nom,name) ) out = 1 ;
+            else newnom = newnom->suiv;
+        }
+    }
+    return out;
 }
 
@@ -270,40 +261,36 @@
 /*                                                                            */
 /******************************************************************************/
-void Addmoduletothelisttmp(char *name)
-{
-  listusemodule *newmodule;
-  listusemodule *parcours;
-  int out;
-
-  if ( !listofmoduletmp)
-  {
-    newmodule =(listusemodule *)malloc(sizeof(listusemodule));
-    strcpy(newmodule->u_usemodule,name);
-    Save_Length(name,16);
-    strcpy(newmodule->u_cursubroutine,subroutinename);
-    Save_Length(subroutinename,18);
-    newmodule->suiv = NULL;
-    listofmoduletmp = newmodule ;
-  }
-  else
-  {
-    parcours = listofmoduletmp;
-    out = 0;
-    while( parcours && out == 0 )
-    {
-       if ( !strcasecmp(parcours->u_usemodule,name) ) out = 1;
-       else parcours = parcours->suiv;
-    }
-    if ( out == 0 )
-    {
-       newmodule =(listusemodule *)malloc(sizeof(listusemodule));
-       strcpy(newmodule->u_usemodule,name);
-       Save_Length(name,16);
-       strcpy(newmodule->u_cursubroutine,subroutinename);
-       Save_Length(subroutinename,18);
-       newmodule->suiv = listofmoduletmp;
-       listofmoduletmp = newmodule;
-    }
-  }
+void Addmoduletothelisttmp(const char *name)
+{
+    listusemodule *newmodule;
+    listusemodule *parcours;
+    int out;
+
+    if ( !listofmoduletmp )
+    {
+        newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
+        strcpy(newmodule->u_usemodule, name);
+        strcpy(newmodule->u_cursubroutine, subroutinename);
+        newmodule->suiv = NULL;
+        listofmoduletmp = newmodule ;
+    }
+    else
+    {
+        parcours = listofmoduletmp;
+        out = 0;
+        while( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->u_usemodule, name) ) out = 1;
+            else parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
+            strcpy(newmodule->u_usemodule, name);
+            strcpy(newmodule->u_cursubroutine, subroutinename);
+            newmodule->suiv = listofmoduletmp;
+            listofmoduletmp = newmodule;
+        }
+    }
 }
 
@@ -321,16 +308,15 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_NameOfModule_1(char *nom)
-{
-   listnom *newnom;
-
-   if ( firstpass == 1 )
-   {
-      newnom=(listnom *) malloc (sizeof (listnom));
-      strcpy(newnom->o_nom,nom);
-      Save_Length(nom,23);
-      newnom->suiv = List_NameOfModule;
-      List_NameOfModule = newnom;
-   }
+void Add_NameOfModule_1(const char *nom)
+{
+    listnom *newnom;
+
+    if ( firstpass == 1 )
+    {
+        newnom = (listnom *) calloc(1,sizeof(listnom));
+        strcpy(newnom->o_nom,nom);
+        newnom->suiv = List_NameOfModule;
+        List_NameOfModule = newnom;
+    }
 }
 
@@ -348,24 +334,23 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_NameOfCommon_1(char *nom,char *cursubroutinename)
-{
-   listnom *newnom;
-   listnom *parcours;
-
-   if ( firstpass == 1 )
-   {
-      parcours = List_NameOfCommon;
-      while ( parcours && strcasecmp(parcours->o_nom,nom) )
-                                                      parcours = parcours->suiv;
-      if ( !parcours )
-      {
-         newnom=(listnom *) malloc (sizeof (listnom));
-         strcpy(newnom->o_nom,nom);
-         strcpy(newnom->o_subroutinename,cursubroutinename);
-         Save_Length(nom,23);
-         newnom->suiv = List_NameOfCommon;
-         List_NameOfCommon = newnom;
-      }
-   }
+void Add_NameOfCommon_1(const char *nom, const char *cursubroutinename)
+{
+    listnom *newnom;
+    listnom *parcours;
+
+    if ( firstpass == 1 )
+    {
+        parcours = List_NameOfCommon;
+        while ( parcours && strcasecmp(parcours->o_nom,nom) )
+            parcours = parcours->suiv;
+        if ( !parcours )
+        {
+            newnom = (listnom *) calloc(1,sizeof(listnom));
+            strcpy(newnom->o_nom,nom);
+            strcpy(newnom->o_subroutinename,cursubroutinename);
+            newnom->suiv = List_NameOfCommon;
+            List_NameOfCommon = newnom;
+        }
+    }
 }
 
@@ -378,28 +363,22 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_CouplePointed_Var_1(char *namemodule,listcouple *couple)
-{
-   listvarpointtovar *pointtmp;
-
-   if ( firstpass == 1 )
-   {
-      /* we should complete the List_CouplePointed_Var                        */
-      pointtmp=(listvarpointtovar *)malloc(sizeof(listvarpointtovar));
-      strcpy(pointtmp->t_usemodule,namemodule);
-      Save_Length(namemodule,28);
-      strcpy(pointtmp->t_cursubroutine,subroutinename);
-      Save_Length(subroutinename,29);
-      pointtmp->t_couple = couple;
-      if ( List_CouplePointed_Var )
-      {
-         pointtmp->suiv = List_CouplePointed_Var;
-         List_CouplePointed_Var = pointtmp;
-      }
-      else
-      {
-         pointtmp->suiv = NULL;
-         List_CouplePointed_Var = pointtmp;
-      }
-   }
+void Add_CouplePointed_Var_1(const char *namemodule, listcouple *couple)
+{
+    listvarpointtovar *pointtmp;
+
+    /* we should complete the List_CouplePointed_Var                        */
+    pointtmp = (listvarpointtovar*) calloc(1, sizeof(listvarpointtovar));
+    strcpy(pointtmp->t_usemodule, namemodule);
+    strcpy(pointtmp->t_cursubroutine, subroutinename);
+    pointtmp->t_couple = couple;
+    if ( List_CouplePointed_Var )
+    {
+        pointtmp->suiv = List_CouplePointed_Var;
+    }
+    else
+    {
+        pointtmp->suiv = NULL;
+    }
+    List_CouplePointed_Var = pointtmp;
 }
 
@@ -420,66 +399,51 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_Include_1(char *name)
+void Add_Include_1(const char *name)
+{
+    listusemodule *newinclude;
+
+    if ( firstpass == 1 )
+    {
+        newinclude = (listusemodule*) calloc(1, sizeof(listusemodule));
+        strcpy(newinclude->u_usemodule,name);
+        strcpy(newinclude->u_cursubroutine,subroutinename);
+
+        newinclude->suiv = List_Include;
+        List_Include  = newinclude ;
+    }
+}
+
+/******************************************************************************/
+/*                     Add_ImplicitNoneSubroutine_1                           */
+/******************************************************************************/
+/* This subroutine is used to add a record to a list of struct                */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_ImplicitNoneSubroutine_1()
+{
+    if ( firstpass == 1 )
+        List_ImplicitNoneSubroutine = Addtolistname(subroutinename,List_ImplicitNoneSubroutine);
+}
+
+/******************************************************************************/
+/*                        WriteIncludeDeclaration                             */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void WriteIncludeDeclaration(FILE* tofile)
 {
   listusemodule *newinclude;
 
-  if ( firstpass == 1 )
-  {
-  newinclude =(listusemodule *)malloc(sizeof(listusemodule));
-  strcpy(newinclude->u_usemodule,name);
-  Save_Length(name,16);
-  strcpy(newinclude->u_cursubroutine,subroutinename);
-  Save_Length(subroutinename,18);
-  newinclude->suiv = NULL;
-
-  if ( !List_Include)
-  {
-     List_Include  = newinclude ;
-  }
-  else
-  {
-    newinclude->suiv = List_Include;
-    List_Include = newinclude;
-  }
-  }
-}
-
-/******************************************************************************/
-/*                     Add_ImplicitNoneSubroutine_1                           */
-/******************************************************************************/
-/* This subroutine is used to add a record to a list of struct                */
-/******************************************************************************/
-/*                                                                            */
-/*                                                                            */
-/******************************************************************************/
-void Add_ImplicitNoneSubroutine_1()
-{
-
-  if ( firstpass == 1 )
-  {
-     List_ImplicitNoneSubroutine = Addtolistname(subroutinename,
-                                                   List_ImplicitNoneSubroutine);
-  }
-}
-
-
-/******************************************************************************/
-/*                        WriteIncludeDeclaration                             */
-/******************************************************************************/
-/* Firstpass 0                                                                */
-/******************************************************************************/
-/*                                                                            */
-/******************************************************************************/
-void WriteIncludeDeclaration()
-{
-  listusemodule *newinclude;
-
   newinclude = List_Include;
-  fprintf(fortranout,"\n");
+  fprintf(tofile,"\n");
   while ( newinclude )
   {
      if ( !strcasecmp(newinclude->u_cursubroutine,subroutinename) )
      {
-        fprintf(fortranout,"      INCLUDE %s \n",newinclude->u_usemodule);
+        fprintf(tofile, "      include %s\n",newinclude->u_usemodule);
      }
      newinclude = newinclude ->suiv;
@@ -498,109 +462,81 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_Save_Var_1 (char *name,listdim *d)
-{
-  listvar *newvar;
-  listdim *dims;
-  char ligne[LONG_C];
-  char listdimension[LONG_C];
-
-  if ( firstpass == 1 )
-  {
-     newvar=(listvar *)malloc(sizeof(listvar));
-     newvar->var=(variable *)malloc(sizeof(variable));
-     /*                                                                       */
-     Init_Variable(newvar->var);
-     /*                                                                       */
-     newvar->var->v_save=1;
-     strcpy(newvar->var->v_nomvar,name);
-     Save_Length(name,4);
-     strcpy(newvar->var->v_modulename,curmodulename);
-     Save_Length(curmodulename,6);
-     strcpy(newvar->var->v_subroutinename,subroutinename);
-     Save_Length(subroutinename,11);
-     strcpy(newvar->var->v_commoninfile,mainfile);
-     Save_Length(mainfile,10);
-
-     newvar->var->v_dimension=d;
-     /* Creation of the string for the dimension of this variable             */
-     dimsempty = 1;
-
-     if ( d )
-     {
-        newvar->var->v_dimensiongiven=1;
-        dims = d;
-        while (dims)
-        {
-           if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
-                                                                  dimsempty = 0;
-           sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
-           strcat(listdimension,ligne);
-           if ( dims->suiv )
-           {
-              strcat(listdimension,",");
-           }
-           dims = dims->suiv;
-        }
-        if ( dimsempty == 1 ) newvar->var->v_dimsempty=1;
-     }
-
-/*     strcpy(newvar->var->v_readedlistdimension,listdimension);
-     Save_Length(listdimension,15);*/
-     /*                                                                       */
-     newvar->suiv = NULL;
-
-     if ( !List_Save_Var )
-     {
-        List_Save_Var  = newvar ;
-     }
-     else
-     {
+void Add_Save_Var_1 (const char *name, listdim *d)
+{
+    listvar *newvar;
+    listdim *dims;
+    char ligne[LONG_M];
+    char listdimension[LONG_M];
+
+    if ( firstpass == 1 )
+    {
+        newvar = (listvar *) calloc(1,sizeof(listvar));
+        newvar->var = (variable *) calloc(1,sizeof(variable));
+
+        Init_Variable(newvar->var);
+
+        newvar->var->v_save = 1;
+        strcpy(newvar->var->v_nomvar,name);
+        strcpy(newvar->var->v_modulename,curmodulename);
+        strcpy(newvar->var->v_subroutinename,subroutinename);
+        strcpy(newvar->var->v_commoninfile,cur_filename);
+
+        newvar->var->v_dimension = d;
+
+        /* Creation of the string for the dimension of this variable             */
+        dimsempty = 1;
+
+        if ( d )
+        {
+            newvar->var->v_dimensiongiven = 1;
+            dims = d;
+            while (dims)
+            {
+                if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
+                    dimsempty = 0;
+                sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+                strcat(listdimension,ligne);
+                if ( dims->suiv )   strcat(listdimension,",");
+                dims = dims->suiv;
+            }
+            if ( dimsempty == 1 ) newvar->var->v_dimsempty = 1;
+        }
+
         newvar->suiv = List_Save_Var;
         List_Save_Var = newvar;
-     }
-  }
+    }
 }
 
 void Add_Save_Var_dcl_1 (listvar *var)
 {
-  listvar *newvar;
-  listvar *parcours;
-
-  if ( firstpass == 1 )
-  {
-     parcours = var;
-     while ( parcours )
-     {
-        newvar=(listvar *)malloc(sizeof(listvar));
-        newvar->var=(variable *)malloc(sizeof(variable));
-        /*                                                                    */
-        Init_Variable(newvar->var);
-        /*                                                                    */
-        newvar->var->v_save=1;
-        strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
-        strcpy(newvar->var->v_modulename,curmodulename);
-        Save_Length(curmodulename,6);
-        strcpy(newvar->var->v_subroutinename,subroutinename);
-        Save_Length(subroutinename,11);
-        strcpy(newvar->var->v_commoninfile,mainfile);
-        Save_Length(mainfile,10);
-        /*                                                                    */
-        strcpy(newvar->var->v_readedlistdimension,
-             parcours->var->v_readedlistdimension);
-        newvar->var->v_nbdim = parcours->var->v_nbdim;
-        newvar->var->v_dimension = parcours->var->v_dimension;
-        /*                                                                    */
-        newvar->var->v_dimensiongiven=parcours->var->v_dimensiongiven;
-        /*                                                                    */
-        newvar->suiv = NULL;
-
-        if ( !List_Save_Var ) List_Save_Var  = newvar ;
-        else
-        {
-           newvar->suiv = List_Save_Var;
-           List_Save_Var = newvar;
-        }
-        parcours = parcours->suiv;
-     }
-  }
-}
+    listvar *newvar;
+    listvar *parcours;
+
+    if ( firstpass == 1 )
+    {
+        parcours = var;
+        while ( parcours )
+        {
+            newvar = (listvar *) calloc(1,sizeof(listvar));
+            newvar->var = (variable *) calloc(1,sizeof(variable));
+
+            Init_Variable(newvar->var);
+
+            newvar->var->v_save = 1;
+            strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
+            strcpy(newvar->var->v_modulename,curmodulename);
+            strcpy(newvar->var->v_subroutinename,subroutinename);
+            strcpy(newvar->var->v_commoninfile,cur_filename);
+            strcpy(newvar->var->v_readedlistdimension,parcours->var->v_readedlistdimension);
+
+            newvar->var->v_nbdim = parcours->var->v_nbdim;
+            newvar->var->v_catvar = parcours->var->v_catvar;
+            newvar->var->v_dimension = parcours->var->v_dimension;
+            newvar->var->v_dimensiongiven=parcours->var->v_dimensiongiven;
+            newvar->suiv = List_Save_Var;
+            List_Save_Var = newvar;
+
+            parcours = parcours->suiv;
+        }
+    }
+}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile	(revision 5682)
@@ -1,7 +1,2 @@
-#- option to debug
-C_D = -g # -g -Wall
-# Compilation:
-CC		= cc -O
-#-
 OBJS = main.o WriteInFile.o toamr.o fortran.o  \
        dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \
@@ -14,13 +9,31 @@
        WorkWithlistofcoupled.o
 
-
 .SUFFIXES:
 .SUFFIXES: .c .o
 
-all : conv
-	@echo CONV is ok
+all: conv
+	@echo
+	@echo ===================================================
+	@echo   CONV is ok
+	@echo ===================================================
+	@echo
 
-conv :  $(OBJS)
-	@$(CC) $(OBJS) -o ../$@
+#main.c: convert.y convert.lex
+#	@echo ===================================================
+#	@echo   Rebuilding main.c ...
+#	@echo ===================================================
+#	$(MAKE) -f Makefile.lex main.c
+
+#fortran.c: fortran.y fortran.lex
+#	@echo ===================================================
+#	@echo   Rebuilding fortran.c ...
+#	@echo ===================================================
+#	$(MAKE) -f Makefile.lex fortran.c
+
+conv: $(OBJS)
+	$(CC) $(CFLAGS) -g $(OBJS) -o ../$@
+
+%.o: %.c
+	$(CC) $(CFLAGS) -g -c $< -o $@
 
 main.o : main.c
@@ -28,16 +41,16 @@
 toamr.o : toamr.c decl.h
 WriteInFile.o : WriteInFile.c decl.h
-dependfile.o : dependfile.c decl.h	
-SubLoopCreation.o : SubLoopCreation.c decl.h	
-WorkWithglobliste.o : WorkWithglobliste.c decl.h	
-WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h	
-WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h	
-Writedeclarations.o : Writedeclarations.c decl.h	
-UtilFortran.o : UtilFortran.c decl.h	
-WorkWithParameterlist.o : WorkWithParameterlist.c decl.h	
-UtilNotGridDep.o : UtilNotGridDep.c decl.h	
-WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h	
-DiversListe.o : DiversListe.c decl.h	
-UtilAgrif.o : UtilAgrif.c decl.h	
+dependfile.o : dependfile.c decl.h
+SubLoopCreation.o : SubLoopCreation.c decl.h
+WorkWithglobliste.o : WorkWithglobliste.c decl.h
+WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h
+WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h
+Writedeclarations.o : Writedeclarations.c decl.h
+UtilFortran.o : UtilFortran.c decl.h
+WorkWithParameterlist.o : WorkWithParameterlist.c decl.h
+UtilNotGridDep.o : UtilNotGridDep.c decl.h
+WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h
+DiversListe.o : DiversListe.c decl.h
+UtilAgrif.o : UtilAgrif.c decl.h
 WorkWithAllocatelist.o : WorkWithAllocatelist.c decl.h
 UtilCharacter.o : UtilCharacter.c decl.h
@@ -47,4 +60,7 @@
 WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h
 WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h
-clean : 
-	/bin/rm -f *.o y.output
+
+clean:
+#	$(MAKE) -f Makefile.lex clean
+	$(RM) *.o conv
+	
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex	(revision 5659)
+++ 	(revision )
@@ -1,77 +1,0 @@
-# Compilation:
-CC		= cc -O -g -Wall
-LEX		= flex
-
-# option de flex et pas de lex
-LEXFLAGS=-i
-YACC = byacc -t -v -g
-YACC = bison -t -v -g
-YACC = bison 
-
-
-OBJS = main.o WriteInFile.o toamr.o fortran.o  \
-       dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \
-       WorkWithvarofsubroutineliste.o WorkWithParameterlist.o \
-       Writedeclarations.o WorkWithglobliste.o UtilFortran.o \
-       UtilNotGridDep.o WorkWithlistdatavariable.o \
-       DiversListe.o UtilAgrif.o WorkWithAllocatelist.o \
-       UtilCharacter.o UtilListe.o UtilFile.o \
-       WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o \
-       WorkWithlistofcoupled.o
-
-.SUFFIXES:
-.SUFFIXES: .c .o
-
-all : conv
-
-conv :  $(OBJS)
-	$(CC) $(OBJS)  $(LEXLIB) -o ../$@
-
-main.o : main.c
-main.c : convert.tab.c  convert.yy.c
-	rm -f main.c
-	cat convert.tab.c  convert.yy.c > main.c
-	rm -f convert.yy.c convert.tab.c
-fortran.o : fortran.c
-fortran.c : fortran.tab.c fortran.yy.c
-	rm -f fortran.c
-	cat fortran.tab.c  fortran.yy.c > fortran.c
-#rm -f fortran.yy.c fortran.tab.c
-convert.tab.c : convert.y decl.h
-	$(YACC) convert.y
-#	mv -f y.tab.c convert.tab.c
-fortran.tab.c : fortran.y decl.h
-	$(YACC) -p fortran fortran.y
-#	mv -f y.tab.c fortran.tab.c
-#	mv -f y.output fortran.output
-#	mv -f y.dot fortran.dot
-convert.yy.c : convert.lex
-	$(LEX) $(LEXFLAGS) -oconvert.yy.c convert.lex
-fortran.yy.c : fortran.lex
-	$(LEX) $(LEXFLAGS) -Pfortran -ofortran.yy.c fortran.lex
-	
-toamr.o : toamr.c decl.h
-WriteInFile.o : WriteInFile.c decl.h
-dependfile.o : dependfile.c decl.h
-SubLoopCreation.o : SubLoopCreation.c decl.h
-WorkWithglobliste.o : WorkWithglobliste.c decl.h
-WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h
-WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h
-Writedeclarations.o : Writedeclarations.c decl.h
-UtilFortran.o : UtilFortran.c decl.h
-WorkWithParameterlist.o : WorkWithParameterlist.c decl.h
-UtilNotGridDep.o : UtilNotGridDep.c decl.h
-WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h
-DiversListe.o : DiversListe.c decl.h
-UtilAgrif.o : UtilAgrif.c decl.h
-WorkWithAllocatelist.o : WorkWithAllocatelist.c decl.h
-UtilCharacter.o : UtilCharacter.c decl.h
-UtilListe.o : UtilListe.c decl.h
-UtilFile.o : UtilFile.c decl.h
-WorkWithlistofmodulebysubroutine.o : WorkWithlistofmodulebysubroutine.c decl.h
-WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h
-WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h
-clean : 
-	/bin/rm -f *.o y.tab.c main.c lex.yy.c fortran.c \
-	fortran.tab.c fortran.yy.c convert.tab.c convert.yy.c \
-	y.output
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex.byacc
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex.byacc	(revision 5659)
+++ 	(revision )
@@ -1,76 +1,0 @@
-# Compilation:
-CC		= cc -O -g -Wall
-LEX		= flex
-
-# option de flex et pas de lex
-LEXFLAGS=-i
-YACC = byacc -t -v -g
-YACC = bison -t -v -g
-
-
-OBJS = main.o WriteInFile.o toamr.o fortran.o  \
-       dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \
-       WorkWithvarofsubroutineliste.o WorkWithParameterlist.o \
-       Writedeclarations.o WorkWithglobliste.o UtilFortran.o \
-       UtilNotGridDep.o WorkWithlistdatavariable.o \
-       DiversListe.o UtilAgrif.o WorkWithAllocatelist.o \
-       UtilCharacter.o UtilListe.o UtilFile.o \
-       WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o \
-       WorkWithlistofcoupled.o
-
-.SUFFIXES:
-.SUFFIXES: .c .o
-
-all : conv
-
-conv :  $(OBJS)
-	$(CC) $(OBJS)  $(LEXLIB) -o ../$@
-
-main.o : main.c
-main.c : convert.tab.c  convert.yy.c
-	rm -f main.c
-	cat convert.tab.c  convert.yy.c > main.c
-	rm -f convert.yy.c convert.tab.c
-fortran.o : fortran.c
-fortran.c : fortran.tab.c fortran.yy.c
-	rm -f fortran.c
-	cat fortran.tab.c  fortran.yy.c > fortran.c
-#rm -f fortran.yy.c fortran.tab.c
-convert.tab.c : convert.y decl.h
-	$(YACC) convert.y
-	mv -f y.tab.c convert.tab.c
-fortran.tab.c : fortran.y decl.h
-	$(YACC) -p fortran fortran.y
-	mv -f y.tab.c fortran.tab.c
-	mv -f y.output fortran.output
-	mv -f y.dot fortran.dot
-convert.yy.c : convert.lex
-	$(LEX) $(LEXFLAGS) -oconvert.yy.c convert.lex
-fortran.yy.c : fortran.lex
-	$(LEX) $(LEXFLAGS) -Pfortran -ofortran.yy.c fortran.lex
-	
-toamr.o : toamr.c decl.h
-WriteInFile.o : WriteInFile.c decl.h
-dependfile.o : dependfile.c decl.h
-SubLoopCreation.o : SubLoopCreation.c decl.h
-WorkWithglobliste.o : WorkWithglobliste.c decl.h
-WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h
-WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h
-Writedeclarations.o : Writedeclarations.c decl.h
-UtilFortran.o : UtilFortran.c decl.h
-WorkWithParameterlist.o : WorkWithParameterlist.c decl.h
-UtilNotGridDep.o : UtilNotGridDep.c decl.h
-WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h
-DiversListe.o : DiversListe.c decl.h
-UtilAgrif.o : UtilAgrif.c decl.h
-WorkWithAllocatelist.o : WorkWithAllocatelist.c decl.h
-UtilCharacter.o : UtilCharacter.c decl.h
-UtilListe.o : UtilListe.c decl.h
-UtilFile.o : UtilFile.c decl.h
-WorkWithlistofmodulebysubroutine.o : WorkWithlistofmodulebysubroutine.c decl.h
-WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h
-WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h
-clean : 
-	/bin/rm -f *.o y.tab.c main.c lex.yy.c fortran.c \
-	fortran.tab.c fortran.yy.c convert.tab.c convert.yy.c \
-	y.output
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c	(revision 5682)
@@ -45,74 +45,47 @@
 
 /******************************************************************************/
-/*                             writeheadnewsub_0                              */
-/******************************************************************************/
-/* Firstpass 0                                                                */
+/*                           WriteBeginof_SubLoop                             */
+/******************************************************************************/
 /* We should write the head of the subroutine sub_loop_<subroutinename>       */
 /******************************************************************************/
 /*                                                                            */
 /******************************************************************************/
-void writeheadnewsub_0()
-{
-   char ligne[LONG_C];
-
-   if ( firstpass == 0 && IsTabvarsUseInArgument_0() == 1 )
-   {
-      if ( todebug == 1 ) printf("Enter in writeheadnewsub_0\n");
+void WriteBeginof_SubLoop()
+{
+   if (todebug == 1) printf("##\n## Enter in HEAD SUBLOOP for |%s|\n##\n", subroutinename);
+   if ( IsTabvarsUseInArgument_0() == 1 )
+   {
+      if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 1\n");
       /* we should add the use agrif_uti l if it is necessary                 */
       WriteHeadofSubroutineLoop();
       WriteUsemoduleDeclaration(subroutinename);
-      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout,
-                                                       "      IMPLICIT NONE\n");
-      WriteIncludeDeclaration();
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n");
+      WriteIncludeDeclaration(fortran_out);
       /*                                                                      */
       /* We should write once the declaration of tables (extract              */
       /*    from pointer) in the new subroutine                               */
-      if ( mark == 1 ) fprintf(fortranout,"!!! 000000000000000 \n");
-
-      if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration();
-      if ( mark == 1 ) fprintf(fortranout,"!!! 111111111111111 \n");
-
-      sprintf(ligne,"\n#include \"ParamFile%s.h\" \n",subroutinename);
-      tofich(fortranout,ligne,1);
-
-      WriteArgumentDeclaration_Sort();
-
-      if ( mark == 1 ) fprintf(fortranout,"!!! 222222222222222 \n");
-      writesub_loopdeclaration_tab(List_UsedInSubroutine_Var,fortranout);
-      if ( mark == 1 ) fprintf(fortranout,"!!! 333333333333333 \n");
-      writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var,paramout);
-      if ( mark == 1 ) fprintf(fortranout,"!!! 444444444444444 \n");
-      /* now we should write the function declaration                         */
-      /*    case if it is the                                                 */
-      WriteFunctionDeclaration(1);
-      if ( mark == 1 ) fprintf(fortranout,"!!! 555555555555555 \n");
-
-//      if ( SubInList_ContainsSubroutine() == 0 ) WriteSubroutineDeclaration(1);
-  
-      if ( mark == 1 ) fprintf(fortranout,"!!! 666666666666666 \n");
-      if ( todebug == 1 ) printf("Out of writeheadnewsub_0\n");
-   }
-   else if ( firstpass == 0 )
-   {
-      AddUseAgrifUtil_0(fortranout);
+      if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration(fortran_out);
+
+      writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var,fortran_out);
+      writesub_loopdeclaration_tab(List_UsedInSubroutine_Var,fortran_out);
+      WriteArgumentDeclaration_Sort(fortran_out);
+      WriteFunctionDeclaration(fortran_out, 1);
+   }
+   else
+   {
+      if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 0\n");
+      AddUseAgrifUtil_0(fortran_out);
       WriteUsemoduleDeclaration(subroutinename);
-      WriteIncludeDeclaration();
-      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout,
-                                                       "      IMPLICIT NONE\n");
-      if ( mark == 1 ) fprintf(fortranout,"!!! aaaaaaaaaaaaaaa \n");
-      WriteLocalParamDeclaration();
-      if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbbbbbbbbbb \n");   
+      WriteIncludeDeclaration(fortran_out);
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n");
+      WriteLocalParamDeclaration(fortran_out);
       WriteArgumentDeclaration_beforecall();
-      if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbccccccccc \n");
-      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(1);
-/*      writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortranout);
-      writesub_loopdeclaration_tab(List_SubroutineArgument_Var,fortranout);*/
-      if ( mark == 1 ) fprintf(fortranout,"!!! ccccccccccccccc \n");
-      if ( mark == 1 ) fprintf(fortranout,"!!! ddddddddddddddd \n");
-//      WriteSubroutineDeclaration(1);
-      if ( mark == 1 ) fprintf(fortranout,"!!! eeeeeeeeeeeeeee \n");
-   }
-}
-
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 1);
+/*    writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortran_out);
+      writesub_loopdeclaration_tab(List_SubroutineArgument_Var,fortran_out);*/
+   }
+   if ( todebug == 1 ) printf("<   out of WriteBeginof_SubLoop\n");
+   if ( todebug == 1 ) printf("## EXIT HEAD SUBLOOP (%s)\n\n", subroutinename);
+}
 
 /******************************************************************************/
@@ -129,17 +102,14 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteVariablelist_subloop(FILE *outputfile,char *ligne)
+void WriteVariablelist_subloop(char *ligne)
 {
    listvar *parcours;
-   int compteur;
-
-   if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop\n");
+
+   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop\n");
    parcours = List_SubroutineArgument_Var;
    didvariableadded = 0;
-   compteur = 0 ;
 
    while ( parcours )
    {
-
       /* if the readed variable is a variable of the subroutine               */
       /*    subroutinename we should write the name of this variable          */
@@ -147,11 +117,8 @@
       if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
       {
-         if ( didvariableadded == 1 )
-         {
-            strcat(ligne,",");
-         }
+         if ( didvariableadded == 1 )   strcat(ligne,",");
          strcat(ligne,parcours->var->v_nomvar);
          didvariableadded = 1;
-            }
+      }
       parcours = parcours -> suiv;
    }
@@ -161,14 +128,11 @@
       if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
       {
-         if ( didvariableadded == 1 )
-         {
-            strcat(ligne,",");
-         }
+         if ( didvariableadded == 1 )   strcat(ligne,",");
          strcat(ligne,parcours->var->v_nomvar);
          didvariableadded = 1;
-            }
+      }
       parcours = parcours -> suiv;
    }
-   if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop\n");
+   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop\n");
 }
 
@@ -188,14 +152,16 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteVariablelist_subloop_Call(FILE *outputfile,char *ligne)
+void WriteVariablelist_subloop_Call(char **ligne, size_t line_length)
 {
    listvar *parcours;
-   char ligne2[10];
+   char ligne2[LONG_M];
    int i;
-   int compteur ;
-
-   if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Call\n");
+   size_t cur_length;
+
+   cur_length = line_length;
+
+   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Call\n");
    parcours = List_UsedInSubroutine_Var;
-   compteur = 0 ;
+
    while ( parcours )
    {
@@ -207,9 +173,12 @@
          )
       {
-         if ( didvariableadded == 1 )
+         if ( didvariableadded == 1 )   strcat(*ligne,",");
+         const char *vres = vargridcurgridtabvars(parcours->var, 0);
+         if ( (strlen(*ligne)+strlen(vres)+100) > cur_length )
          {
-            strcat(ligne," , ");
+            cur_length += LONG_M;
+            *ligne = realloc( *ligne, cur_length*sizeof(char) );
          }
-         strcat(ligne,vargridcurgridtabvars(parcours->var,0));
+         strcat(*ligne, vres);
          /* if it is asked in the call of the conv we should give             */
          /* scalar in argument, so we should put (1,1,1) after the            */
@@ -223,43 +192,25 @@
              while ( i <=  parcours->var->v_nbdim )
              {
-                if ( i == 1 ) strcat(ligne,"( ");
+                if ( i == 1 ) strcat(*ligne,"( ");
                 if ( SubloopScalar == 2 )
                 {
-                   strcat(ligne,":");
-                   if ( i != parcours->var->v_nbdim ) strcat(ligne,",");
+                   strcat(*ligne,":");
+                   if ( i != parcours->var->v_nbdim ) strcat(*ligne,",");
                 }
                 else
                 {
-                   strcat(ligne," lbound( ");
-                   strcat(ligne,vargridcurgridtabvars(parcours->var,0));
-                   strcat(ligne,",");
-                   strcpy(ligne2,"");
-                   sprintf(ligne2,"%d",i);
-                   strcat(ligne,ligne2);
-                   if ( i != parcours->var->v_nbdim ) strcat(ligne,"),");
+                   sprintf(ligne2,"lbound(%s,%d",vargridcurgridtabvars(parcours->var,0),i);
+                   strcat(*ligne,ligne2);
+                   if ( i != parcours->var->v_nbdim ) strcat(*ligne,"),");
                 }
-                if ( i == parcours->var->v_nbdim ) strcat(ligne,"))");
+                if ( i == parcours->var->v_nbdim ) strcat(*ligne,"))");
                 i++;
              }
          }
          didvariableadded = 1;
-         compteur = compteur +1 ;
-         /*if ( retour77 == 0 )
-         {
-            strcat(ligne," &");
-            fprintf(outputfile,"\n");
-         }
-         else fprintf(outputfile,"\n     & ");*/
-         /*tofich(outputfile,ligne,0);*/
       }
       parcours = parcours -> suiv;
    }
-   
-//   Save_Length(ligne,41);
-//   tofich(outputfile,ligne,0);
-   /* Now we should replace the last ", &" by " &"                            */
-/*   if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR);
-   if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/
-   if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Call\n");
+   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop_Call\n");
 }
 
@@ -280,13 +231,11 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteVariablelist_subloop_Def(FILE *outputfile, char *ligne)
+void WriteVariablelist_subloop_Def(char *ligne)
 {
    listvar *parcours;
-/*   char ligne[LONG_40M];*/
-   int compteur;
-
-   if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Def\n");
+
+   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Def\n");
    parcours = List_UsedInSubroutine_Var;
-   compteur = 0 ;
+
    while ( parcours )
    {
@@ -295,32 +244,15 @@
       /*    in the output file                                                */
       if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  &&
-           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))
-         )
+           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) )
       {
-         if ( didvariableadded == 1 )
-         {
-            strcat(ligne,",");
-         }
+         if ( didvariableadded == 1 )   strcat(ligne,",");
          strcat(ligne,parcours->var->v_nomvar);
          didvariableadded = 1;
-            }
+      }
       parcours = parcours -> suiv;
    }
- /*  if ( compteur != 3 && compteur != 0 )
-   {
-      if ( retour77 == 0 ) fprintf(outputfile,"\n      %s &",ligne);
-      else fprintf(outputfile,"\n     & %s",ligne);
-   }*/
    Save_Length(ligne,41);
- //  tofich(outputfile,ligne,0);
-
-   /* Now we should replace the last ", &" by " &"                            */
-  /* if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR);
-   if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/
-   if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Def\n");
-   
-}
-
-
+   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop_Def\n");
+}
 
 /******************************************************************************/
@@ -340,33 +272,27 @@
 void WriteHeadofSubroutineLoop()
 {
-   char ligne[LONG_40M];
+   char ligne[LONG_M];
    FILE * subloop;
 
-   if ( todebug == 1 ) printf("Enter in WriteHeadofSubroutineLoop\n");
-   tofich(fortranout,"\n",1);
+   if ( todebug == 1 ) printf("> enter in WriteHeadofSubroutineLoop\n");
+   tofich(fortran_out,"\n",1);
    /* Open this newfile                                                       */
    sprintf(ligne,"Sub_Loop_%s.h",subroutinename);
-   subloop = associate(ligne);
+   subloop = open_for_write(ligne);
    /*                                                                         */
-   if (isrecursive) 
-   {
-   sprintf(ligne,"      recursive subroutine Sub_Loop_%s(",subroutinename);
-   }
-   else
-   {
-   sprintf(ligne,"      subroutine Sub_Loop_%s(",subroutinename);
-   }
+   if (isrecursive) sprintf(ligne,"recursive subroutine Sub_Loop_%s(",subroutinename);
+   else             sprintf(ligne,"subroutine Sub_Loop_%s(",subroutinename);
    /*                                                                         */
-   WriteVariablelist_subloop(subloop,ligne);
-   WriteVariablelist_subloop_Def(subloop,ligne);
+   WriteVariablelist_subloop(ligne);
+   WriteVariablelist_subloop_Def(ligne);
    /*                                                                         */
-     strcat(ligne,")");
+   strcat(ligne,")");
    tofich(subloop,ligne,1);
    /* if USE agrif_Uti l should be add                                        */
    AddUseAgrifUtil_0(subloop);
    /*                                                                         */
-   oldfortranout = fortranout;
-   fortranout = subloop;
-   if ( todebug == 1 ) printf("Out of WriteHeadofSubroutineLoop\n");
+   oldfortran_out = fortran_out;
+   fortran_out = subloop;
+   if ( todebug == 1 ) printf("<   out of WriteHeadofSubroutineLoop\n");
 }
 
@@ -386,107 +312,93 @@
 void closeandcallsubloopandincludeit_0(int suborfun)
 {
-   char ligne[LONG_40M];
-
-   if ( firstpass == 0 )
-   {
-
-   if ( todebug == 1 ) printf("Enter in closeandcallsubloopandincludeit_0\n");
+   char *ligne;
+
+   if ( firstpass == 1 )    return;
+   if ( todebug == 1 ) printf("> enter in closeandcallsubloopandincludeit_0\n");
+
+   ligne = (char*) calloc(LONG_M, sizeof(char));
+
    if ( IsTabvarsUseInArgument_0() == 1 )
    {
       /* We should remove the key word end subroutine                         */
-      RemoveWordCUR_0(fortranout,(long)(-(pos_cur-pos_endsubroutine)),
-                                          pos_cur-pos_endsubroutine);
+      RemoveWordCUR_0(fortran_out,setposcur()-pos_endsubroutine);
       /* We should close the loop subroutine                                  */
-      sprintf(ligne,"\n      end subroutine Sub_Loop_%s",subroutinename);
-      tofich(fortranout,ligne,1);
-      fclose(fortranout);
-      fortranout = oldfortranout;
-
-
-      AddUseAgrifUtilBeforeCall_0(fortranout);
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename);
+      tofich(fortran_out,ligne,1);
+      fclose(fortran_out);
+      fortran_out = oldfortran_out;
+
+      AddUseAgrifUtilBeforeCall_0(fortran_out);
       WriteArgumentDeclaration_beforecall();
-      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0);
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0);
       if ( !strcasecmp(subofagrifinitgrids,subroutinename) )
-                     fprintf(oldfortranout,"      Call Agrif_Init_Grids () \n");
+            fprintf(fortran_out,"      call Agrif_Init_Grids()\n");
       /* Now we add the call af the new subroutine                            */
-      sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename);
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"  call Sub_Loop_%s(",subroutinename);
       /* Write the list of the local variables used in this new subroutine    */
-      WriteVariablelist_subloop(fortranout,ligne);
+      WriteVariablelist_subloop(ligne);
       /* Write the list of the global tables used in this new subroutine      */
       /*    in doloop                                                         */
-      WriteVariablelist_subloop_Call(fortranout,ligne);
+      WriteVariablelist_subloop_Call(&ligne, LONG_M);
       /* Close the parenthesis of the new subroutine called                   */
-       strcat(ligne,")");
-      
-      tofich(fortranout,ligne,1);
+      strcat(ligne,")\n");
+      tofich(fortran_out,ligne,1);
+      /* we should include the above file in the original code                */
 
       /* We should close the original subroutine                              */
-      if ( suborfun == 3 ) sprintf(ligne,"\n      end program %s"
-                                                               ,subroutinename);
-      if ( suborfun == 2 ) sprintf(ligne,"\n      end");
-      if ( suborfun == 1 ) sprintf(ligne,"\n      end subroutine %s"
-                                                               ,subroutinename);
-      if ( suborfun == 0 ) sprintf(ligne,"\n      end function %s"
-                                                               ,subroutinename);
-      tofich(fortranout,ligne,1);
-      /* we should include the above file in the original code                */
-      sprintf(ligne,"\n#include \"Sub_Loop_%s.h\" \n",subroutinename);
-      tofich(fortranout,ligne,1);
-      }
-    oldfortranout = (FILE *)NULL;      
-   if ( todebug == 1 ) printf("Out of closeandcallsubloopandincludeit_0\n");
-   }
-   
-}
-
-
-
+      if ( suborfun == 3 ) fprintf(fortran_out, "      end program %s\n"   , subroutinename);
+      if ( suborfun == 2 ) fprintf(fortran_out, "      end\n");
+      if ( suborfun == 1 ) fprintf(fortran_out, "      end subroutine %s\n", subroutinename);
+      if ( suborfun == 0 ) fprintf(fortran_out, "      end function %s\n"  , subroutinename);
+
+      fprintf(fortran_out,"\n\n#include \"Sub_Loop_%s.h\"\n",subroutinename);
+    }
+    oldfortran_out = (FILE *)NULL;
+    if ( todebug == 1 ) printf("<   out of closeandcallsubloopandincludeit_0\n");
+}
 
 void closeandcallsubloop_contains_0()
 {
-   char ligne[LONG_40M];
-
-   if ( firstpass == 0 )
-   {
-   if ( todebug == 1 ) printf("Enter in closeandcallsubloopandincludeit_0\n");
+   char *ligne;
+
+   if ( todebug == 1 ) printf("> enter in closeandcallsubloop_contains_0\n");
    if ( IsTabvarsUseInArgument_0() == 1 )
    {
-      Remove_Word_Contains_0();
-      sprintf(ligne,"\n      end subroutine Sub_Loop_%s",subroutinename);
-      tofich(fortranout,ligne,1);
-      fclose(fortranout);
-      fortranout = oldfortranout;
-
-      AddUseAgrifUtilBeforeCall_0(fortranout);
-      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout,
-                                                       "      IMPLICIT NONE\n");
-      WriteLocalParamDeclaration();
+      ligne = (char*) calloc(LONG_M, sizeof(char));
+      RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename);
+      tofich(fortran_out,ligne,1);
+      fclose(fortran_out);
+      fortran_out = oldfortran_out;
+
+      AddUseAgrifUtilBeforeCall_0(fortran_out);
+
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n");
+      WriteLocalParamDeclaration(fortran_out);
       WriteArgumentDeclaration_beforecall();
-      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0);
-      WriteSubroutineDeclaration(0);
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0);
+/*      WriteSubroutineDeclaration(0);*/
       if ( !strcasecmp(subofagrifinitgrids,subroutinename) )
-                     fprintf(oldfortranout,"      Call Agrif_Init_Grids () \n");
+          fprintf(fortran_out,"      call Agrif_Init_Grids()\n");
       /* Now we add the call af the new subroutine                            */
-      if ( retour77 == 0 ) sprintf(ligne,"\n      Call Sub_Loop_%s( &"
-                                                               ,subroutinename);
-      else sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename);
-      fprintf(fortranout,ligne);
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"  call Sub_Loop_%s(",subroutinename);
       /* Write the list of the local variables used in this new subroutine    */
-      WriteVariablelist_subloop(fortranout,ligne);
+      WriteVariablelist_subloop(ligne);
       /* Write the list of the global tables used in this new subroutine      */
       /*    in doloop                                                         */
-      WriteVariablelist_subloop_Call(fortranout,ligne);
+      WriteVariablelist_subloop_Call(&ligne, LONG_M);
       /* Close the parenthesis of the new subroutine called                   */
-      sprintf(ligne,")");
-      tofich(fortranout,ligne,1);
+      strcat(ligne,")\n");
+      tofich(fortran_out,ligne,1);
       /* We should close the original subroutine                              */
-      sprintf(ligne,"\n      contains");
-      tofich(fortranout,ligne,1);
+      fprintf(fortran_out, "      contains\n");
       /* we should include the above file in the original code                */
-      sprintf(ligne,"\n#include \"Sub_Loop_%s.h\" \n",subroutinename);
-      tofich(fortranout,ligne,1);
+      fprintf(fortran_out,"#include \"Sub_Loop_%s.h\"\n",subroutinename);
       }
-   oldfortranout = (FILE *)NULL;
-   if ( todebug == 1 ) printf("Out of closeandcallsubloopandincludeit_0\n");
-   }
-}
+   oldfortran_out = (FILE *)NULL;
+   if ( todebug == 1 ) printf("<   out of closeandcallsubloop_contains_0\n");
+}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c	(revision 5682)
@@ -45,5 +45,5 @@
 /*                                                                            */
 /******************************************************************************/
-int Vartonumber(char *tokname)
+int Vartonumber(const char *tokname)
 {
    int agrifintheword;
@@ -68,6 +68,11 @@
    else if ( !strcasecmp(tokname,"Agrif_Set_restore")    ) agrifintheword = 1;
    else if ( !strcasecmp(tokname,"Agrif_Save_Forrestore")) agrifintheword = 1;
-   else if ( !strcasecmp(tokname,"agrif_init_grids")     ) agrifintheword = 1;
-   else if ( !strcasecmp(tokname,"agrif_step")           ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_init_grids")     ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_step")           ) agrifintheword = 1;
+/**************************************************/
+/* adding specific adjoint agrif subroutine names */
+/**************************************************/
+   else if ( !strcasecmp(tokname,"Agrif_bc_variable_adj")    ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_update_variable_adj")) agrifintheword = 1;
 
    return agrifintheword;
@@ -85,12 +90,7 @@
 /*                                                                            */
 /******************************************************************************/
-int Agrif_in_Tok_NAME(char *tokname)
-{
-   int agrifintheword;
-
-   if ( strncasecmp(tokname,"Agrif_",6) == 0 )  agrifintheword = 1;
-   else agrifintheword = 0;
-
-   return agrifintheword;
+int Agrif_in_Tok_NAME(const char *tokname)
+{
+    return ( strncasecmp(tokname,"Agrif_",6) == 0 );
 }
 
@@ -104,230 +104,93 @@
 /*                                                                            */
 /******************************************************************************/
-void ModifyTheVariableName_0(char *ident, int lengthname)
-{
-   listvar *newvar;
-   int out;
-   
-   printf("ICI ident = %s\n",ident);
-   
-   if ( firstpass == 0 )
-   {
-      newvar = List_Global_Var;
-      out=0;
-      while ( newvar && out == 0 )
-      {
-         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-         else newvar=newvar->suiv;
-      }
-       printf("out1 = %d\n",out);
-      if ( out == 0 )
-      {
-         newvar = List_ModuleUsed_Var;
-         while ( newvar && out == 0 )
-         {
+void ModifyTheVariableName_0(const char *ident, int lengthname)
+{
+    listvar *newvar;
+    int out;
+
+    if ( firstpass )  return;
+
+    newvar = List_Global_Var;
+    out = 0;
+    while ( newvar && out == 0 )
+    {
+        if ( !strcasecmp(newvar->var->v_nomvar, ident) ) out = 1;
+        else newvar = newvar->suiv;
+    }
+    if ( out == 0 )
+    {
+        newvar = List_ModuleUsed_Var;
+        while ( newvar && out == 0 )
+        {
             if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-      if (out == 1 && !strcasecmp(newvar->var->v_typevar,"type")) return;
-
-      if ( out == 0 )
-      {
-         newvar = List_Common_Var;
-         while ( newvar && out == 0 )
-         {
+            else newvar = newvar->suiv;
+        }
+    }
+    if ( out && !strcasecmp(newvar->var->v_typevar,"type")) return;
+
+    if ( out == 0 )
+    {
+        newvar = List_Common_Var;
+        while ( newvar && out == 0 )
+        {
             if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-
-      if ( out == 0 )
-      {
-         newvar = List_ModuleUsedInModuleUsed_Var;
-         while ( newvar && out == 0 )
-         {
+            else newvar = newvar->suiv;
+        }
+    }
+    if ( out == 0 )
+    {
+        newvar = List_ModuleUsedInModuleUsed_Var;
+        while ( newvar && out == 0 )
+        {
             if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-
-      if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type"))
-      {
-      printf("ICIC3\n");
-         /* remove the variable                                               */
-         RemoveWordCUR_0(fortranout,(long)(-lengthname),
-                               lengthname);
-         fseek(fortranout,(long)(-lengthname),SEEK_CUR);
-         /* then write the new name                                           */
-         if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
-            fprintf(fortranout,"%d",newvar->var->v_indicetabvars);
-         else
-         {
+            else newvar = newvar->suiv;
+        }
+    }
+    if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type"))
+    {
+        // remove the variable
+        RemoveWordCUR_0(fortran_out,lengthname);
+        // then write the new name
+        if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
+            fprintf(fortran_out,"%d",newvar->var->v_indicetabvars);
+        else
+        {
             if ( retour77 == 0 )
-            {
-               fprintf(fortranout," Agrif_tabvars & \n      ");
-            }
+                fprintf(fortran_out,"Agrif_%s & \n      ", tabvarsname(newvar->var));
             else
             {
-               fprintf(fortranout,"Agrif_tabvars");
-               fprintf(fortranout," \n     & ");
+               fprintf(fortran_out,"Agrif_%s", tabvarsname(newvar->var));
+               fprintf(fortran_out," \n     & ");
             }
-            fprintf(fortranout,"%s",
-                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-            colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-         }
-      }
-      else
-      {
-         /* we should look in the List_ModuleUsed_Var                         */
-         if ( inagrifcallargument != 1 )
-         {
+            fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+        }
+    }
+    else
+    {
+        // we should look in the List_ModuleUsed_Var
+        if ( inagrifcallargument != 1 )
+        {
             newvar = List_ModuleUsed_Var;
             while ( newvar && out == 0 )
             {
-               if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-               else newvar=newvar->suiv;
+                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+                else newvar = newvar->suiv;
             }
-            if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type"))
+            if ( out == 1 && strcasecmp(newvar->var->v_typevar, "type"))
             {
-            printf("ICICIC4 %s\n",newvar->var->v_typevar);
-               /* remove the variable                                         */
-               RemoveWordCUR_0(fortranout,(long)(-lengthname),
-                                     lengthname);
-               fseek(fortranout,(long)(-lengthname),SEEK_CUR);
-               /* then write the new name                                     */
-               if ( retour77 == 0 )
-               {
-                  fprintf(fortranout," Agrif_tabvars & \n      ");
-               }
-               else
-               {
-                  fprintf(fortranout," \n     & Agrif_tabvars");
-               }
-               fprintf(fortranout,"%s",
-                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-               colnum = strlen(
-                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+                // remove the variable
+                RemoveWordCUR_0(fortran_out,lengthname);
+                // then write the new name
+                if ( retour77 == 0 )
+                    fprintf(fortran_out,"Agrif_%s & \n      ",tabvarsname(newvar->var));
+                else
+                {
+                    fprintf(fortran_out," \n     &Agrif_%s",tabvarsname(newvar->var));
+                }
+                fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
             }
-         }
-      }
-   }
-}
-
-/******************************************************************************/
-/*                     ModifyTheVariableName_0                                */
-/******************************************************************************/
-/* Firstpass 0                                                                */
-/******************************************************************************/
-/*                                                                            */
-/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
-/*                                                                            */
-/******************************************************************************/
-void ModifyTheVariableNamecoupled_0(char *ident, char* coupledident)
-{
-   listvar *newvar;
-   int out;
-   
-   if ( firstpass == 0 )
-   {
-      newvar = List_Global_Var;
-      out=0;
-      while ( newvar && out == 0 )
-      {
-         if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
-         else newvar=newvar->suiv;
-      }
-
-      if ( out == 0 )
-      {
-         newvar = List_ModuleUsed_Var;
-         while ( newvar && out == 0 )
-         {
-            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-      if ( out == 0 )
-      {
-         newvar = List_Common_Var;
-         while ( newvar && out == 0 )
-         {
-            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-
-      if ( out == 0 )
-      {
-         newvar = List_ModuleUsedInModuleUsed_Var;
-         while ( newvar && out == 0 )
-         {
-            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-
-      if ( out == 1 )
-      {
-         /* remove the variable                                               */
-         RemoveWordCUR_0(fortranout,(long)(-strlen(ident)),
-                               strlen(ident));
-         fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR);
-         /* then write the new name                                           */
-         if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
-            fprintf(fortranout,"%d",newvar->var->v_indicetabvars);
-         else
-         {
-            if ( retour77 == 0 )
-            {
-               fprintf(fortranout," Agrif_tabvars & \n      ");
-            }
-            else
-            {
-               fprintf(fortranout,"Agrif_tabvars");
-               fprintf(fortranout," \n     & ");
-            }
-            fprintf(fortranout,"%s",
-                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-            colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-         }
-      }
-      else
-      {
-         /* we should look in the List_ModuleUsed_Var                         */
-         if ( inagrifcallargument != 1 )
-         {
-            newvar = List_ModuleUsed_Var;
-            while ( newvar && out == 0 )
-            {
-               if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
-               else newvar=newvar->suiv;
-            }
-            if ( out == 1 )
-            {
-               /* remove the variable                                         */
-               RemoveWordCUR_0(fortranout,(long)(-strlen(ident)),
-                                     strlen(ident));
-               fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR);
-               /* then write the new name                                     */
-               if ( retour77 == 0 )
-               {
-                  fprintf(fortranout," Agrif_tabvars & \n      ");
-               }
-               else
-               {
-                  fprintf(fortranout," \n     & Agrif_tabvars");
-               }
-               fprintf(fortranout,"%s",
-                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-               colnum = strlen(
-                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
-            }
-         }
-      }
-   }
-}
-
-
+        }
+    }
+}
 
 /******************************************************************************/
@@ -348,40 +211,36 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_SubroutineWhereAgrifUsed_1(char *sub,char *mod)
-{
-  listnom *listnomtmp;
-  listnom *parcours;
-
-  if ( firstpass == 1 )
-  {
-  if ( !List_SubroutineWhereAgrifUsed )
-  {
-     listnomtmp=(listnom *)malloc(sizeof(listnom));
-     strcpy(listnomtmp->o_nom,sub);
-     Save_Length(sub,23);
-     strcpy(listnomtmp->o_module,mod);
-     Save_Length(mod,24);
-     listnomtmp->suiv = NULL;
-     List_SubroutineWhereAgrifUsed  =  listnomtmp;
-  }
-  else
-  {
-    parcours = List_SubroutineWhereAgrifUsed;
-    while ( parcours && strcasecmp(parcours->o_nom,sub) )
-    {
-       parcours = parcours->suiv;
-    }
-    if ( !parcours )
-    {
-       listnomtmp=(listnom *)malloc(sizeof(listnom));
-       strcpy(listnomtmp->o_nom,sub);
-       Save_Length(sub,23);
-       strcpy(listnomtmp->o_module,mod);
-       Save_Length(mod,24);
-       listnomtmp->suiv = List_SubroutineWhereAgrifUsed;
-       List_SubroutineWhereAgrifUsed  =  listnomtmp;
-    }
-  }
-  }
+void Add_SubroutineWhereAgrifUsed_1(const char *sub, const char *mod)
+{
+    listnom *listnomtmp;
+    listnom *parcours;
+
+    if ( firstpass == 1 )
+    {
+        if ( !List_SubroutineWhereAgrifUsed )
+        {
+            listnomtmp = (listnom*) calloc(1, sizeof(listnom));
+            strcpy(listnomtmp->o_nom, sub);
+            strcpy(listnomtmp->o_module, mod);
+            listnomtmp->suiv = NULL;
+            List_SubroutineWhereAgrifUsed = listnomtmp;
+        }
+        else
+        {
+            parcours = List_SubroutineWhereAgrifUsed;
+            while ( parcours && strcasecmp(parcours->o_nom,sub) )
+            {
+                parcours = parcours->suiv;
+            }
+            if ( !parcours )
+            {
+                listnomtmp = (listnom*) calloc(1, sizeof(listnom));
+                strcpy(listnomtmp->o_nom, sub);
+                strcpy(listnomtmp->o_module, mod);
+                listnomtmp->suiv = List_SubroutineWhereAgrifUsed;
+                List_SubroutineWhereAgrifUsed = listnomtmp;
+            }
+        }
+    }
 }
 
@@ -411,7 +270,11 @@
      parcours = List_SubroutineWhereAgrifUsed;
      while ( parcours && strcasecmp(parcours->o_nom,subroutinename) )
-                                                    parcours = parcours -> suiv;
+     {
+        parcours = parcours -> suiv;
+     }
      if ( parcours && parcours->o_val != 0 )
-                                   fprintf(fileout,"\n      USE Agrif_Util \n");
+        fprintf(fileout,"\n      use Agrif_Util\n");
+     else
+        fprintf(fileout,"\n      use Agrif_Types, only : Agrif_tabvars\n");
   }
 }
@@ -419,25 +282,26 @@
 void  AddUseAgrifUtilBeforeCall_0(FILE *fileout)
 {
-  listusemodule *parcours;
-
-  int out;
-
-  if ( firstpass == 0 )
-  {
-     parcours = List_NameOfModuleUsed;
-     out = 0 ;
-     while ( parcours && out == 0 )
-     {
-        if ( !strcasecmp(parcours->u_usemodule,"Agrif_Util")     &&
-             !strcasecmp(parcours->u_modulename,curmodulename)   &&
-             !strcasecmp(parcours->u_cursubroutine,subroutinename)
-            ) out = 1;
-        else parcours = parcours->suiv;
-     }
-     if ( out == 0 )
-     {
-        fprintf(fileout,"\n      USE Agrif_Util \n");
-     }
-  }
+    listusemodule *parcours;
+
+    int out;
+
+    if ( firstpass == 0 )
+    {
+        parcours = List_NameOfModuleUsed;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->u_usemodule, "Agrif_Util")   &&
+                 !strcasecmp(parcours->u_modulename, curmodulename) &&
+                 !strcasecmp(parcours->u_cursubroutine, subroutinename) )
+                out = 1;
+            else
+                parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            fprintf(fileout,"\n      use Agrif_Util\n");
+        }
+    }
 }
 
@@ -451,164 +315,163 @@
 /*                                                                            */
 /******************************************************************************/
-void NotifyAgrifFunction_0(char *ident)
-{
-   if ( firstpass == 0 )
-   {
-      if ( !strcasecmp(ident,"Agrif_parent") )
-      {
-         InAgrifParentDef = 1;
-         pos_curagrifparent = setposcur()-12;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") )
-      {
-         InAgrifParentDef = 2;
-         pos_curagrifparent = setposcur()-21;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Rhox") )
-      {
-         InAgrifParentDef = 3;
-         pos_curagrifparent = setposcur()-10;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") )
-      {
-         InAgrifParentDef = 4;
-         pos_curagrifparent = setposcur()-17;
-      }
-      else if ( !strcasecmp(ident,"Agrif_IRhox") )
-      {
-         InAgrifParentDef = 5;
-         pos_curagrifparent = setposcur()-11;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") )
-      {
-         InAgrifParentDef = 6;
-         pos_curagrifparent = setposcur()-18;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Rhoy") )
-      {
-         InAgrifParentDef = 7;
-         pos_curagrifparent = setposcur()-10;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") )
-      {
-         InAgrifParentDef = 8;
-         pos_curagrifparent = setposcur()-17;
-      }
-      else if ( !strcasecmp(ident,"Agrif_IRhoy") )
-      {
-         InAgrifParentDef = 9;
-         pos_curagrifparent = setposcur()-11;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") )
-      {
-         InAgrifParentDef = 10;
-         pos_curagrifparent = setposcur()-18;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Rhoz") )
-      {
-         InAgrifParentDef = 11;
-         pos_curagrifparent = setposcur()-10;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") )
-      {
-         InAgrifParentDef = 12;
-         pos_curagrifparent = setposcur()-17;
-      }
-      else if ( !strcasecmp(ident,"Agrif_IRhoz") )
-      {
-         InAgrifParentDef = 13;
-         pos_curagrifparent = setposcur()-11;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") )
-      {
-         InAgrifParentDef = 14;
-         pos_curagrifparent = setposcur()-18;
-      }
-      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") )
-      {
-         InAgrifParentDef = 15;
-         pos_curagrifparent = setposcur()-23;
-      }
-      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") )
-      {
-         InAgrifParentDef = 16;
-         pos_curagrifparent = setposcur()-23;
-      }
-      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") )
-      {
-         InAgrifParentDef = 17;
-         pos_curagrifparent = setposcur()-23;
-      }
-      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") )
-      {
-         InAgrifParentDef = 18;
-         pos_curagrifparent = setposcur()-26;
-      }
-      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") )
-      {
-         InAgrifParentDef = 19;
-         pos_curagrifparent = setposcur()-26;
-      }
-      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") )
-      {
-         InAgrifParentDef = 20;
-         pos_curagrifparent = setposcur()-26;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Get_parent_id") )
-      {
-         InAgrifParentDef = 21;
-         pos_curagrifparent = setposcur()-19;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Get_grid_id") )
-      {
-         InAgrifParentDef = 22;
-         pos_curagrifparent = setposcur()-17;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_Iz") )
-      {
-         InAgrifParentDef = 23;
-         pos_curagrifparent = setposcur()-15;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_Iy") )
-      {
-         InAgrifParentDef = 24;
-         pos_curagrifparent = setposcur()-15;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Parent_Ix") )
-      {
-         InAgrifParentDef = 25;
-         pos_curagrifparent = setposcur()-15;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Iz") )
-      {
-         InAgrifParentDef = 26;
-         pos_curagrifparent = setposcur()-8;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Iy") )
-      {
-         InAgrifParentDef = 27;
-         pos_curagrifparent = setposcur()-8;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Ix") )
-      {
-         InAgrifParentDef = 28;
-         pos_curagrifparent = setposcur()-8;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") )
-      {
-         InAgrifParentDef = 29;
-         pos_curagrifparent = setposcur()-20;
-      }
-      else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") )
-      {
-         InAgrifParentDef = 29;
-         pos_curagrifparent = setposcur()-19;
-      }
-      else if ( !strcasecmp(ident,"AGRIF_Nb_Step") )
-      {
-         InAgrifParentDef = 30;
-         pos_curagrifparent = setposcur()-13;
-      }
-   }
+void NotifyAgrifFunction_0(const char *ident)
+{
+    if ( firstpass == 1 )   return;
+
+    if ( !strcasecmp(ident,"Agrif_parent") )
+    {
+        InAgrifParentDef = 1;
+        pos_curagrifparent = setposcur()-12;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") )
+    {
+        InAgrifParentDef = 2;
+        pos_curagrifparent = setposcur()-21;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Rhox") )
+    {
+        InAgrifParentDef = 3;
+        pos_curagrifparent = setposcur()-10;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") )
+    {
+        InAgrifParentDef = 4;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_IRhox") )
+    {
+        InAgrifParentDef = 5;
+        pos_curagrifparent = setposcur()-11;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") )
+    {
+        InAgrifParentDef = 6;
+        pos_curagrifparent = setposcur()-18;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Rhoy") )
+    {
+        InAgrifParentDef = 7;
+        pos_curagrifparent = setposcur()-10;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") )
+    {
+        InAgrifParentDef = 8;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_IRhoy") )
+    {
+        InAgrifParentDef = 9;
+        pos_curagrifparent = setposcur()-11;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") )
+    {
+        InAgrifParentDef = 10;
+        pos_curagrifparent = setposcur()-18;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Rhoz") )
+    {
+        InAgrifParentDef = 11;
+        pos_curagrifparent = setposcur()-10;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") )
+    {
+        InAgrifParentDef = 12;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_IRhoz") )
+    {
+        InAgrifParentDef = 13;
+        pos_curagrifparent = setposcur()-11;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") )
+    {
+        InAgrifParentDef = 14;
+        pos_curagrifparent = setposcur()-18;
+    }
+    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") )
+    {
+        InAgrifParentDef = 15;
+        pos_curagrifparent = setposcur()-23;
+    }
+    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") )
+    {
+        InAgrifParentDef = 16;
+        pos_curagrifparent = setposcur()-23;
+    }
+    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") )
+    {
+        InAgrifParentDef = 17;
+        pos_curagrifparent = setposcur()-23;
+    }
+    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") )
+    {
+        InAgrifParentDef = 18;
+        pos_curagrifparent = setposcur()-26;
+    }
+    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") )
+    {
+        InAgrifParentDef = 19;
+        pos_curagrifparent = setposcur()-26;
+    }
+    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") )
+    {
+        InAgrifParentDef = 20;
+        pos_curagrifparent = setposcur()-26;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Get_parent_id") )
+    {
+        InAgrifParentDef = 21;
+        pos_curagrifparent = setposcur()-19;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Get_grid_id") )
+    {
+        InAgrifParentDef = 22;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Iz") )
+    {
+        InAgrifParentDef = 23;
+        pos_curagrifparent = setposcur()-15;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Iy") )
+    {
+        InAgrifParentDef = 24;
+        pos_curagrifparent = setposcur()-15;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Ix") )
+    {
+        InAgrifParentDef = 25;
+        pos_curagrifparent = setposcur()-15;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Iz") )
+    {
+        InAgrifParentDef = 26;
+        pos_curagrifparent = setposcur()-8;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Iy") )
+    {
+        InAgrifParentDef = 27;
+        pos_curagrifparent = setposcur()-8;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Ix") )
+    {
+        InAgrifParentDef = 28;
+        pos_curagrifparent = setposcur()-8;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") )
+    {
+        InAgrifParentDef = 29;
+        pos_curagrifparent = setposcur()-20;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") )
+    {
+        InAgrifParentDef = 29;
+        pos_curagrifparent = setposcur()-19;
+    }
+    else if ( !strcasecmp(ident,"AGRIF_Nb_Step") )
+    {
+        InAgrifParentDef = 30;
+        pos_curagrifparent = setposcur()-13;
+    }
 }
 
@@ -622,9 +485,8 @@
 /*                                                                            */
 /******************************************************************************/
-void ModifyTheAgrifFunction_0(char *ident)
+void ModifyTheAgrifFunction_0(const char *ident)
 {
    if ( InAgrifParentDef != 0 )
           AgriffunctionModify_0(ident,InAgrifParentDef);
-   /*                                                                         */
    InAgrifParentDef = 0;
 }
@@ -700,240 +562,228 @@
 /*                                                                            */
 /******************************************************************************/
-void AgriffunctionModify_0(char *ident,int whichone)
-{
-   char toprint[LONG_C];
-   if ( firstpass == 0 )
-   {
-      strcpy(toprint,"");
-      pos_end = setposcur();
-      fseek(fortranout,pos_curagrifparent,SEEK_SET);
-      if ( whichone == 1 || whichone == 2 )
-      {
-         /*                                                                   */
-         FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1);
-         if ( !strcasecmp(ident,toprint) )
-         {
-            /* la liste des use de cette subroutine                           */
-            strcpy(toprint,"");
-            FindAndChangeNameToTabvars(ident,
-                                          toprint,List_Common_Var,whichone);
-         }
-         if ( !strcasecmp(ident,toprint) )
-         {
-            /* la liste des use de cette subroutine                           */
-            strcpy(toprint,"");
-            FindAndChangeNameToTabvars(ident,
-                                          toprint,List_ModuleUsed_Var,whichone);
-         }
-      }
-      else if ( whichone == 3 ) /* Agrif_Rhox                                 */
-      {
-         sprintf(toprint,"REAL(");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"Agrif_Curgrid % spaceref(1))");
-      }
-      else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */
-      {
-         sprintf(toprint,"REAL(");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))");
-      }
-      else if ( whichone == 5 ) /* Agrif_Rhox                                 */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% spaceref(1)");
-      }
-      else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % spaceref(1)");
-      }
-      else if ( whichone == 7 ) /* Agrif_Rhoy                                 */
-      {
-         sprintf(toprint,"REAL(Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% spaceref(2))");
-      }
-      else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */
-      {
-         sprintf(toprint,"REAL(Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % spaceref(2))");
-      }
-      else if ( whichone == 9 ) /* Agrif_Rhoy                                 */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% spaceref(2)");
-      }
-      else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % spaceref(2)");
-      }
-      else if ( whichone == 11 ) /* Agrif_Rhoz                                */
-      {
-         sprintf(toprint,"REAL(Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% spaceref(3))");
-      }
-      else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */
-      {
-         sprintf(toprint,"REAL(Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % spaceref(3))");
-      }
-      else if ( whichone == 13 ) /* Agrif_Rhoz                                */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% spaceref(3)");
-      }
-      else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % spaceref(3)");
-      }
-      else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% NearRootBorder(1)");
-      }
-      else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% NearRootBorder(2)");
-      }
-      else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% NearRootBorder(3)");
-      }
-      else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
+void AgriffunctionModify_0(const char *ident,int whichone)
+{
+    char toprint[LONG_M];
+    if ( firstpass == 0 )
+    {
+        strcpy(toprint,"");
+        pos_end = setposcur();
+        fseek(fortran_out,pos_curagrifparent,SEEK_SET);
+        if ( whichone == 1 || whichone == 2 )
+        {
+            FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1);
+            if ( !strcasecmp(ident,toprint) )
+            {
+                /* la liste des use de cette subroutine                           */
+                strcpy(toprint,"");
+                FindAndChangeNameToTabvars(ident,toprint,List_Common_Var,whichone);
+            }
+            if ( !strcasecmp(ident,toprint) )
+            {
+                /* la liste des use de cette subroutine                           */
+                strcpy(toprint,"");
+                FindAndChangeNameToTabvars(ident,toprint,List_ModuleUsed_Var,whichone);
+            }
+        }
+        else if ( whichone == 3 ) /* Agrif_Rhox                                 */
+        {
+            sprintf(toprint,"REAL(");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"Agrif_Curgrid % spaceref(1))");
+        }
+        else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */
+        {
+            sprintf(toprint,"REAL(");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))");
+        }
+        else if ( whichone == 5 ) /* Agrif_Rhox                                 */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(1)");
+        }
+        else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(1)");
+        }
+        else if ( whichone == 7 ) /* Agrif_Rhoy                                 */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(2))");
+        }
+        else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(2))");
+        }
+        else if ( whichone == 9 ) /* Agrif_Rhoy                                 */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(2)");
+        }
+        else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(2)");
+        }
+        else if ( whichone == 11 ) /* Agrif_Rhoz                                */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(3))");
+        }
+        else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(3))");
+        }
+        else if ( whichone == 13 ) /* Agrif_Rhoz                                */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(3)");
+        }
+        else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(3)");
+        }
+        else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% NearRootBorder(1)");
+        }
+        else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% NearRootBorder(2)");
+        }
+        else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% NearRootBorder(3)");
+        }
+        else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
          strcat(toprint,"% DistantRootBorder(1)");
-      }
-      else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% DistantRootBorder(2)");
-      }
-      else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% DistantRootBorder(3)");
-      }
-      else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % grid_id");
-      }
-      else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% grid_id");
-      }
-      else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % ix(3)");
-      }
-      else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % ix(2)");
-      }
-      else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% parent % ix(1)");
-      }
-      else if ( whichone == 26 ) /* Agrif_Iz                                  */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint," % ix(3)");
-      }
-      else if ( whichone == 27 ) /* Agrif_Iy                                  */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% ix(2)");
-      }
-      else if ( whichone == 28 ) /* Agrif_Ix                                  */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% ix(1)");
-      }
-      else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */
-      {
-         sprintf(toprint,"Agrif_nbfixedgrids");
-      }
-      else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */
-      {
-         sprintf(toprint,"Agrif_Curgrid");
-         if( retour77 == 0 ) strcat(toprint," & \n");
-         else strcat(toprint,"\n     & ");
-         strcat(toprint,"% ngridstep");
-      }
-      /*                                                                      */
-      if ( whichone == 1 || whichone == 2 )
-      {
-         Save_Length(toprint,43);
-         tofich(fortranout,toprint,2);
-      }
-      else
-      {
-/*         if( retour77 == 0 ) fprintf(fortranout," & \n");
-         else fprintf(fortranout,"\n     & ");*/
-         Save_Length(toprint,43);
-         fprintf(fortranout,"%s",toprint);
-      }
-   }
-}
-
+        }
+        else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% DistantRootBorder(2)");
+        }
+        else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% DistantRootBorder(3)");
+        }
+        else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % grid_id");
+        }
+        else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% grid_id");
+        }
+        else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % ix(3)");
+        }
+        else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % ix(2)");
+        }
+        else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % ix(1)");
+        }
+        else if ( whichone == 26 ) /* Agrif_Iz                                  */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint," % ix(3)");
+        }
+        else if ( whichone == 27 ) /* Agrif_Iy                                  */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% ix(2)");
+        }
+        else if ( whichone == 28 ) /* Agrif_Ix                                  */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% ix(1)");
+        }
+        else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */
+        {
+            sprintf(toprint,"Agrif_nbfixedgrids");
+        }
+        else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% ngridstep");
+        }
+
+        Save_Length(toprint,43);
+
+        if ( whichone == 1 || whichone == 2 )   tofich(fortran_out,toprint,0);
+        else                                    fprintf(fortran_out,"%s",toprint);
+    }
+}
 
 /******************************************************************************/
@@ -946,51 +796,43 @@
 /*                                                                            */
 /******************************************************************************/
-void Instanciation_0(char *ident)
-{
-   listvar *newvar;
-   int out;
-
-   if ( firstpass == 0 && sameagrifargument == 1 )
-   {
-      newvar = List_Global_Var;
-
-      out=0;
-      while ( newvar && out == 0 )
-      {
-         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-         else newvar=newvar->suiv;
-      }
-
-      if ( out == 0 )
-      {
-         newvar = List_Common_Var;
-
-         out=0;
-         while ( newvar && out == 0 )
-         {
+void Instanciation_0(const char *ident)
+{
+    listvar *newvar;
+    int out;
+
+    if ( firstpass == 0 && sameagrifargument == 1 )
+    {
+        newvar = List_Global_Var;
+        out = 0;
+        while ( newvar && out == 0 )
+        {
             if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-      if ( out == 0 )
-      {
-         newvar = List_ModuleUsed_Var;
-
-         out=0;
-         while ( newvar && out == 0 )
-         {
-            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
-            else newvar=newvar->suiv;
-         }
-      }
-
-      if ( out == 1 )
-      {
-         /* then write the instanciation                                      */
-         fprintf(fortranout,"\n      %s = %s",ident,
-                                          vargridcurgridtabvars(newvar->var,3));
-         colnum = 0;
-      }
-   }
-   sameagrifargument = 0;
-}
+            else newvar = newvar->suiv;
+        }
+        if ( out == 0 )
+        {
+            newvar = List_Common_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+                else newvar = newvar->suiv;
+            }
+        }
+        if ( out == 0 )
+        {
+            newvar = List_ModuleUsed_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+                else newvar = newvar->suiv;
+            }
+        }
+//         if ( out == 1 )
+//         {
+//             /* then write the instanciation                                      */
+//             fprintf(fortran_out,"\n      %s = %s",ident,vargridcurgridtabvars(newvar->var,3));
+//             printf("#\n# Instanciation_0: |%s = %s|\n#\n", ident,vargridcurgridtabvars(newvar->var,3));
+//         }
+    }
+    sameagrifargument = 0;
+}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c	(revision 5682)
@@ -46,10 +46,10 @@
 /*                                                                            */
 /******************************************************************************/
-/* if  whichone = 0 ----> Agrif_tabvars(i) % var % array2                     */
-/*                                                                            */
-/* if  whichone = 1 ----> Agrif_tabvars(i) % parentvar % var % array2         */
-/*                                                                            */
-/******************************************************************************/
-void FindAndChangeNameToTabvars(char name[LONG_C],char toprint[LONG_4C],
+/* if  whichone = 0 ----> Agrif_tabvars(i) % array2                           */
+/*                                                                            */
+/* if  whichone = 1 ----> Agrif_tabvars(i) % parentvar % array2               */
+/*                                                                            */
+/******************************************************************************/
+void FindAndChangeNameToTabvars(const char name[LONG_M],char toprint[LONG_M],
                                               listvar * listtosee, int whichone)
 {
@@ -71,5 +71,5 @@
             {
                out = 1;
-               strcat(toprint,vargridcurgridtabvars(newvar->var,whichone));
+               strcat(toprint,vargridcurgridtabvars(newvar->var, whichone));
             }
             else newvar=newvar->suiv;
@@ -92,82 +92,37 @@
 /*                                                                            */
 /******************************************************************************/
-char *ChangeTheInitalvaluebyTabvarsName(char *nom,listvar *listtoread,
-                                                                   int whichone)
-{
-   char toprinttmp[LONG_4C];
-   int i;
-   char chartmp[2];
-
-   i=0;
-   strcpy(toprintglob,"");
-   strcpy(toprinttmp,"");
-
-   /*                                                                         */
-   while ( i < strlen(nom) )
-   {
-      if ( nom[i] == '+' )
-      {
-        FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,"+");
-      }
-      else if ( nom[i] == '-' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,"-");
-      }
-      else if ( nom[i] == '*' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,"*");
-      }
-      else if ( nom[i] == '/' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,"/");
-      }
-      else if ( nom[i] == '(' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,"(");
-      }
-      else if ( nom[i] == ')' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,")");
-      }
-      else if ( nom[i] == ':' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,":");
-      }
-      else if ( nom[i] == ',' )
-      {
-         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-         strcpy(toprinttmp,"");
-         strcat(toprintglob,",");
-      }
-      else
-      {
-         sprintf(chartmp,"%c",nom[i]);
-         strcat(toprinttmp,chartmp);
-      }
-      /*                                                                      */
-      i=i+1;
-   }
-   FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
-   strcpy(toprinttmp,"");
-
-   Save_Length(toprinttmp,44);
-   Save_Length(toprintglob,39);
-
-   /*                                                                         */
-   return toprintglob;
+const char *ChangeTheInitalvaluebyTabvarsName(const char *nom, listvar *listtoread)
+{
+    char toprinttmp[LONG_M];
+    char chartmp[2];
+    size_t i = 0;
+
+    strcpy(toprintglob, "");
+    strcpy(toprinttmp,  "");
+
+    while ( i < strlen(nom) )
+    {
+        if ( (nom[i] == '+') || (nom[i] == '-') || (nom[i] == '*') || (nom[i] == '/') ||
+             (nom[i] == '(') || (nom[i] == ')') || (nom[i] == ':') || (nom[i] == ',') )
+        {
+            FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,0);
+            strcpy(toprinttmp, "");
+            sprintf(chartmp, "%c", nom[i]);
+            strcat(toprintglob, chartmp);
+        }
+        else
+        {
+            sprintf(chartmp, "%c", nom[i]);
+            strcat(toprinttmp, chartmp);
+        }
+        i += 1;
+    }
+    FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,0);
+    strcpy(toprinttmp,"");
+
+    Save_Length(toprinttmp,44);
+    Save_Length(toprintglob,39);
+
+    return toprintglob;
 }
 
@@ -181,19 +136,10 @@
 /*                                                                            */
 /******************************************************************************/
-int IsVariableReal(char *nom)
-{
-   int Real;
-
-   Real = 0;
-   if ( ( nom[0] >= 'a' && nom[0] <= 'h' ) ||
+int IsVariableReal(const char *nom)
+{
+    return ( ( nom[0] >= 'a' && nom[0] <= 'h' ) ||
         ( nom[0] >= 'A' && nom[0] <= 'H' ) ||
         ( nom[0] >= 'o' && nom[0] <= 'z' ) ||
-        ( nom[0] >= 'O' && nom[0] <= 'Z' )
-       )
-       {
-          Real = 1;
-       }
-   /*                                                                         */
-   return Real;
+        ( nom[0] >= 'O' && nom[0] <= 'Z' ) );
 }
 /******************************************************************************/
@@ -206,5 +152,5 @@
 /*                                                                            */
 /******************************************************************************/
-void IsVarInUseFile(char *nom)
+void IsVarInUseFile(const char *nom)
 {
    listvar *parcours;
@@ -217,5 +163,5 @@
    while( parcours && out == 0 )
    {
-      if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ;
+      if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ;
      else parcours=parcours->suiv;
    }
@@ -225,4 +171,13 @@
       while( parcours && out == 0 )
       {
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ;
+        else parcours=parcours->suiv;
+      }
+   }
+   if ( out == 0 )
+   {
+      parcours = List_GlobalParameter_Var;
+      while( parcours && out == 0 )
+      {
          if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ;
         else parcours=parcours->suiv;
@@ -231,17 +186,8 @@
    if ( out == 0 )
    {
-      parcours = List_GlobalParameter_Var;
-      while( parcours && out == 0 )
-      {
-         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ;
-        else parcours=parcours->suiv;
-      }
-   }
-   if ( out == 0 )
-   {
       parcours = List_Parameter_Var;
       while( parcours && out == 0 )
       {
-         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ;
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ;
         else parcours=parcours->suiv;
       }
@@ -252,5 +198,5 @@
       while( parcoursparam && out == 0 )
       {
-         if ( !strcasecmp(nom,parcoursparam->p_name) ) out =2 ;
+         if ( !strcasecmp(nom,parcoursparam->p_name) ) out = 2 ;
          else parcoursparam=parcoursparam->suiv;
       }
@@ -261,5 +207,5 @@
       while( parcours && out == 0 )
       {
-         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =2 ;
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 2 ;
         else parcours=parcours->suiv;
       }
@@ -270,5 +216,5 @@
       while( parcoursparam && out != 1 )
       {
-         if ( !strcasecmp(nom,parcoursparam->p_name) ) out =1 ;
+         if ( !strcasecmp(nom,parcoursparam->p_name) ) out = 1 ;
          else parcoursparam=parcoursparam->suiv;
       }
@@ -299,13 +245,12 @@
 /*                                                                            */
 /******************************************************************************/
-listnom *DecomposeTheNameinlistnom(char *nom, listnom * listout)
-{
-   char toprinttmp[LONG_4C];
-   int i;
+listnom *DecomposeTheNameinlistnom(const char *nom, listnom * listout)
+{
+   char toprinttmp[LONG_M];
    char chartmp[2];
-
-   i=0;
+   size_t i = 0;
+
    strcpy(toprinttmp,"");
-   /*                                                                         */
+
    while ( i < strlen(nom) )
    {
@@ -320,5 +265,4 @@
          )
       {
-
          if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
          {
@@ -331,7 +275,5 @@
          sprintf(chartmp,"%c",nom[i]);
          strcat(toprinttmp,chartmp);
-
-      }
-      /*                                                                      */
+      }
       i=i+1;
    }
@@ -340,6 +282,6 @@
       listout = Addtolistnom(toprinttmp,listout,0);
    }
+   Save_Length(toprinttmp,44);
    strcpy(toprinttmp,"");
-   Save_Length(toprinttmp,44);
 
    return listout;
@@ -356,13 +298,12 @@
 /*                                                                            */
 /******************************************************************************/
-void DecomposeTheName(char *nom)
-{
-   char toprinttmp[LONG_4C];
-   int i;
+void DecomposeTheName(const char *nom)
+{
+   char toprinttmp[LONG_M];
    char chartmp[2];
-
-   i=0;
+   size_t i = 0;
+   
    strcpy(toprinttmp,"");
-   /*                                                                         */
+
    while ( i < strlen(nom) )
    {
@@ -390,8 +331,6 @@
          strcat(toprinttmp,chartmp);
       }
-      /*                                                                      */
       i=i+1;
    }
-   Save_Length(toprinttmp,44);
    if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
    {
@@ -400,26 +339,27 @@
       IsVarInUseFile(toprinttmp);
    }
+   Save_Length(toprinttmp,44);
    strcpy(toprinttmp,"");
 
 }
 
-void convert2lower(char *name)
-{
-   int l;
-   int i;
-   int caractere;
-
-   l=strlen(name)-1;
-   for (i=0;i<=l;i++)
-   {
-      caractere=name[i];
-      if ((caractere>=65 && caractere<=90)||(caractere>=192 && caractere<=221))
-      {
-         name[i]+=32;
-      }
-   }
-}
-
-int convert2int(char *name)
+void convert2lower(char *lowername, const char* inputname)
+{
+    int i, l, caractere;
+
+    strcpy(lowername, inputname);
+    l = strlen(lowername)-1;
+
+    for ( i=0 ; i<=l ; i++)
+    {
+        caractere = lowername[i];
+        if ( (caractere>=65 && caractere<=90) || (caractere>=192 && caractere<=221) )
+        {
+            lowername[i] += 32;
+        }
+    }
+}
+
+int convert2int(const char *name)
 {
    int i;
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c	(revision 5682)
@@ -40,31 +40,29 @@
 
 /******************************************************************************/
-/*                            associate                                       */
+/*                         open_for_write                                     */
 /******************************************************************************/
 /* This subroutine is used to open a file                                     */
 /******************************************************************************/
-FILE * associate (char *filename)
+FILE* open_for_write (const char *filename)
 {
-  char filefich[LONG_C];
-  sprintf(filefich,"%s/%s",nomdir,filename);
-  return fopen (filefich, "w");
+    char filefich[LONG_FNAME];
+    sprintf(filefich,"%s/%s",include_dir,filename);
+    return fopen(filefich, "w");
 }
 
-
 /******************************************************************************/
-/*                          associateaplus                                    */
+/*                          open_for_append                                   */
 /******************************************************************************/
 /* This subroutine is used to open a file with option a+                      */
 /******************************************************************************/
-FILE * associateaplus (char *filename)
+FILE* open_for_append (const char *filename)
 {
-  char filefich[LONG_C];
-  sprintf(filefich,"%s/%s",nomdir,filename);
-  return fopen (filefich, "a+");
+    char filefich[LONG_M];
+    sprintf(filefich,"%s/%s",include_dir,filename);
+    return fopen(filefich, "a+");
 }
 
-
 /******************************************************************************/
-/*                           setposcurname                                       */
+/*                           setposcurname                                    */
 /******************************************************************************/
 /* This subroutine is used to know the current position in the file in argument    */
@@ -76,6 +74,6 @@
 long int setposcurname(FILE *fileout)
 {
-   fflush(fileout);
-   return ftell(fileout);
+    fflush(fileout);
+    return ftell(fileout);
 }
 
@@ -91,21 +89,5 @@
 long int setposcur()
 {
-   fflush(fortranout);
-   return ftell(fortranout);
-}
-
-/******************************************************************************/
-/*                      setposcurinoldfortranout                              */
-/******************************************************************************/
-/* This subroutine is used to know the position in the oldfortranout         */
-/******************************************************************************/
-/*                                                                            */
-/*             setposcurinoldfortranout ---------> position in file           */
-/*                                                                            */
-/******************************************************************************/
-long int setposcurinoldfortranout()
-{
-   fflush(oldfortranout);
-   return ftell(oldfortranout);
+    return setposcurname(fortran_out);
 }
 
@@ -114,16 +96,16 @@
 /******************************************************************************/
 /* Firstpass 0                                                                */
-/* We should write in the fortranout the USE tok_name                         */
+/* We should write in the fortran_out the USE tok_name                         */
 /* read in the original file                                                  */
 /******************************************************************************/
 /*                                                                            */
 /******************************************************************************/
-void copyuse_0(char *namemodule)
+void copyuse_0(const char *namemodule)
 {
-   if (firstpass == 0 && IsTabvarsUseInArgument_0() == 1 )
-   {
-      /* We should write this declaration into the original subroutine too    */
-      fprintf(oldfortranout,"      USE %s \n",namemodule);
-   }
+    if ( IsTabvarsUseInArgument_0() == 1 )
+    {
+        /* We should write this declaration into the original subroutine too    */
+        fprintf(oldfortran_out,"      use %s\n", namemodule);
+    }
 }
 
@@ -132,15 +114,15 @@
 /******************************************************************************/
 /* Firstpass 0                                                                */
-/* We should write in the fortranout the USE tok_name, only                   */
+/* We should write in the fortran_out the USE tok_name, only                   */
 /* read in the original file                                                  */
 /******************************************************************************/
 /*                                                                            */
 /******************************************************************************/
-void copyuseonly_0(char *namemodule)
+void copyuseonly_0(const char *namemodule)
 {
    if (firstpass == 0 && IsTabvarsUseInArgument_0() == 1 )
    {
       /* We should write this declaration into the original subroutine too    */
-      fprintf(oldfortranout,"      USE %s , ONLY : \n",namemodule);
+      fprintf(oldfortran_out,"      use %s , only : \n", namemodule);
    }
 }
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c	(revision 5682)
@@ -43,19 +43,15 @@
 /* This subroutine is used to initialized grid dimension variable             */
 /******************************************************************************/
-/*                                                                            */
-/*                                                                            */
-/*                                                                            */
-/******************************************************************************/
-void initdimprob(int dimprobmod, char * nx, char * ny,char* nz)
-{
-  dimprob = dimprobmod;
-
-  strcpy(nbmaillesX,nx);
-  strcpy(nbmaillesY,ny);
-  strcpy(nbmaillesZ,nz);
-}
-
-/******************************************************************************/
-/*                      Variableshouldberemove                                */
+void initdimprob(int dimprobmod, const char * nx, const char * ny, const char* nz)
+{
+    dimprob = dimprobmod;
+
+    strcpy(nbmaillesX, nx);
+    strcpy(nbmaillesY, ny);
+    strcpy(nbmaillesZ, nz);
+}
+
+/******************************************************************************/
+/*                      Variableshouldberemoved                               */
 /******************************************************************************/
 /* Firstpass 0                                                                */
@@ -65,14 +61,7 @@
 /*                                                                            */
 /******************************************************************************/
-int Variableshouldberemove(char *nom)
-{
-
-   int remove;
-
-   remove = 0 ;
-
-   if ( remove == 0 && Agrif_in_Tok_NAME(nom) == 1 ) remove = 1 ;
-
-   return remove;
+int Variableshouldberemoved(const char *nom)
+{
+    return Agrif_in_Tok_NAME(nom);
 }
 
@@ -97,18 +86,17 @@
         /* Now we should give the definition of the variable in the           */
         /* table List_UsedInSubroutine_Var                                    */
-        printf("QDKFLSDFKSLDF\n");
-        strcpy(curvar->var->v_typevar,newvar->var->v_typevar);
-        strcpy(curvar->var->v_dimchar,newvar->var->v_dimchar);
-        curvar->var->v_nbdim = newvar->var->v_nbdim;
+        strcpy(curvar->var->v_typevar, newvar->var->v_typevar);
+        strcpy(curvar->var->v_dimchar, newvar->var->v_dimchar);
+        curvar->var->v_nbdim          = newvar->var->v_nbdim;
         curvar->var->v_dimensiongiven = newvar->var->v_dimensiongiven;
-        curvar->var->v_allocatable = newvar->var->v_allocatable;
-        curvar->var->v_target = newvar->var->v_target;
+        curvar->var->v_allocatable    = newvar->var->v_allocatable;
+        curvar->var->v_target         = newvar->var->v_target;
+        curvar->var->v_catvar         = newvar->var->v_catvar;
         curvar->var->v_pointerdeclare = newvar->var->v_pointerdeclare;
-        curvar->var->v_indicetabvars = newvar->var->v_indicetabvars;
-        strcpy(curvar->var->v_nameinttypename,newvar->var->v_nameinttypename);
-        strcpy(curvar->var->v_precision,newvar->var->v_precision);
-        strcpy(curvar->var->v_readedlistdimension,
-                                            newvar->var->v_readedlistdimension);
-        strcpy(curvar->var->v_commoninfile,newvar->var->v_commoninfile);
+        curvar->var->v_indicetabvars  = newvar->var->v_indicetabvars;
+        strcpy(curvar->var->v_nameinttypename, newvar->var->v_nameinttypename);
+        strcpy(curvar->var->v_precision, newvar->var->v_precision);
+        strcpy(curvar->var->v_readedlistdimension, newvar->var->v_readedlistdimension);
+        strcpy(curvar->var->v_commoninfile, newvar->var->v_commoninfile);
      }
      else
@@ -128,13 +116,12 @@
   present = 0;
   newvar = listin;
+
   while ( newvar && present == 0 )
   {
      if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) &&
-          !strcasecmp(newvar->var->v_subroutinename,
-                                    curvar->var->v_subroutinename)
-        )
+          !strcasecmp(newvar->var->v_subroutinename, curvar->var->v_subroutinename) )
      {
         strcpy(curvar->var->v_commoninfile,newvar->var->v_commoninfile);
-        CopyRecord(curvar->var,newvar->var);
+        Merge_Variables(curvar->var,newvar->var);
         present = 1;
      }
@@ -156,5 +143,5 @@
      if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) )
      {
-        CopyRecord(curvar->var,newvar->var);
+        Merge_Variables(curvar->var,newvar->var);
         present = 1;
      }
@@ -170,5 +157,5 @@
 /* This subroutine is to know if a variable is global                         */
 /******************************************************************************/
-void variableisglobalinmodule(listcouple *listin, char *module, FILE *fileout, long int oldposcuruse)
+void variableisglobalinmodule(listcouple *listin, const char *module, FILE *fileout, long int oldposcuruse)
 {
   int Globalite;
@@ -178,5 +165,5 @@
   listvar *newvar2;
   int out;
-  char truename[LONG_C];  
+  char truename[LONG_VNAME];
 
   Globalite = 1;
@@ -195,5 +182,5 @@
        strcpy(truename,newvar->c_namepointedvar);
      }
-     
+
      out = 0;
      newvar2 = tempo;
@@ -227,11 +214,10 @@
   {
      pos_end = setposcurname(fileout);
-     RemoveWordSET_0(fileout,oldposcuruse,
-                                pos_end-oldposcuruse);
-                                  
+     RemoveWordSET_0(fileout,oldposcuruse,pos_end-oldposcuruse);
+
      newvar = listin;
      while ( newvar )
      {
-        fprintf(fileout,"      USE %s, ONLY : %s \n",module,newvar->c_namevar);
+        fprintf(fileout,"      use %s, only : %s \n",module,newvar->c_namevar);
         newvar = newvar->suiv;
      }
@@ -239,40 +225,13 @@
 }
 
-
-void Remove_Word_Contains_0()
-{
-   if ( firstpass == 0 )
-   {
-      RemoveWordCUR_0(fortranout,(long)(-9),9);
-   }
-}
-
-void Remove_Word_end_module_0(int modulenamelength)
-{
-   if ( firstpass == 0 )
-   {
-      RemoveWordCUR_0(fortranout,(long)(-modulenamelength-12),
-                                         modulenamelength+11);
-   }
-}
-
-void Write_Word_Contains_0()
-{
-   if ( firstpass == 0 )
-   {
-      fprintf(fortranout,"\n      contains\n");
-   }
-}
-
-
 void Write_Word_end_module_0()
 {
-   if ( firstpass == 0 )
-   {
-      fprintf(fortranout,"\n      end module %s",curmodulename);
-   }
-}
-
-void Add_Subroutine_For_Alloc(char *nom)
+    if ( firstpass == 0 )
+    {
+        fprintf(fortran_out,"\n      end module %s",curmodulename);
+    }
+}
+
+void Add_Subroutine_For_Alloc(const char *nom)
 {
    listnom *parcours;
@@ -280,7 +239,6 @@
    int out;
 
-   newvar = (listnom *)malloc(sizeof(listnom));
+   newvar = (listnom*) calloc(1, sizeof(listnom));
    strcpy(newvar->o_nom,nom);
-   Save_Length(nom,23);
    newvar->suiv = NULL;
 
@@ -306,270 +264,137 @@
 }
 
-
-void Write_Alloc_Subroutine_0()
-{
-   listnom *parcours_nom;
-   listnom *parcours_nomprec;
-   int out;
-   char ligne[LONG_C];
-
-   if ( firstpass == 0 )
-   {
-      parcours_nomprec = (listnom *)NULL;
-      parcours_nom = List_NameOfModule;
-      out = 0 ;
-      while ( parcours_nom && out == 0 )
-      {
-         /*                                                                   */
-         if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1;
-         else parcours_nom = parcours_nom -> suiv;
-      }
-      if ( out == 1 )
-      {
-         if ( parcours_nom->o_val == 1 )
-         {
-            strcpy (ligne, "\n      PUBLIC Alloc_agrif_");
-            strcat (ligne, curmodulename);
-            strcat (ligne, "\n");
-            convert2lower(ligne);
-            fprintf(fortranout,ligne);
-         }
-      }
-      Write_Word_Contains_0();
-      if ( out == 1 )
-      {
-         if ( parcours_nom->o_val == 1 )
-         {
-            sprintf (ligne, "Subroutine Alloc_agrif_%s(Agrif_Gr)",
-                                                                 curmodulename);
-            tofich(fortranout,ligne,1);
-            strcpy(ligne,"Use Agrif_Util");
-            tofich(fortranout,ligne,1);
-            strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr");
-            tofich(fortranout,ligne,1);
-            strcpy(ligne, "INTEGER :: i");
-            tofich (fortranout, ligne,1);
-            strcpy (ligne, "\n#include \"alloc_agrif_");
-            strcat (ligne, curmodulename);
-            strcat (ligne, ".h\"\n");
-            convert2lower(ligne);
-            fprintf(fortranout,ligne);
-            strcpy (ligne, "Return");
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "End Subroutine Alloc_agrif_%s",curmodulename);
-            tofich(fortranout,ligne,1);
-            /* List all Call Alloc_agrif_                                     */
+void Write_Closing_Module(int forend)
+{
+    listvar *parcours;
+    listnom *parcours_nom;
+    listnom *parcours_nomprec;
+    variable *v;
+    int out = 0;
+    int headtypewritten = 0;
+    char ligne[LONG_M];
+    int changeval;
+
+    // Write Global Parameter Declaration
+    parcours = List_GlobalParameter_Var;
+    while( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_modulename, curmodulename) )
+        {
+            WriteVarDeclaration(parcours->var, module_declar, 0, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+
+    // Write Global Type declaration
+    parcours = List_Global_Var;
+    while( parcours )
+    {
+        v = parcours->var;
+        if ( !strcasecmp(v->v_modulename, curmodulename) &&
+             !strcasecmp(v->v_typevar, "type") )
+        {
+            if ( headtypewritten == 0 )
+            {
+                fprintf(fortran_out, "\n      type Agrif_%s\n", curmodulename);
+                headtypewritten = 1;
+            }
+            changeval = 0;
+            if ( v->v_allocatable )
+            {
+                changeval = 1;
+                v->v_allocatable = 0;
+                v->v_pointerdeclare = 1;
+            }
+            WriteVarDeclaration(v, fortran_out, 0, 0);
+            if ( changeval )
+            {
+                v->v_allocatable = 1;
+                v->v_pointerdeclare = 0;
+            }
+            out = 1;
+        }
+        parcours = parcours -> suiv;
+    }
+    if (out == 1)
+    {
+        fprintf(fortran_out, "      end type Agrif_%s\n", curmodulename);
+        sprintf(ligne, "type(Agrif_%s), dimension(:), allocatable :: Agrif_%s_var",curmodulename, curmodulename);
+        tofich(fortran_out,ligne,1);
+        fprintf(fortran_out, "      public :: Agrif_%s\n", curmodulename);
+        fprintf(fortran_out, "      public :: Agrif_%s_var\n", curmodulename);
+    }
+
+    // Write NotGridDepend declaration
+    parcours = List_NotGridDepend_Var;
+    while( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
+        {
+            WriteVarDeclaration(parcours->var, fortran_out, 0, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+
+    // Write Alloc_agrif_'modulename' subroutine
+    parcours_nomprec = (listnom*) NULL;
+    parcours_nom = List_NameOfModule;
+    out = 0 ;
+    while ( parcours_nom && out == 0 )
+    {
+        if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1;
+        else parcours_nom = parcours_nom -> suiv;
+    }
+    if ( ! out )
+    {
+        printf("#\n# Write_Closing_Module : OUT == 0   *** /!\\ ***\n");
+        printf("# FIXME: POSSIBLE BUG in CONV !!!\n#\n");
+    }
+    if ( out )
+    {
+        if ( parcours_nom->o_val == 1 )
+        {
+            fprintf(fortran_out,"\n      public :: Alloc_agrif_%s\n",curmodulename);
+        }
+        if ( (forend == 0) || (parcours_nom->o_val == 1) )
+        {
+           fprintf(fortran_out,"\n      contains\n");
+        }
+        if ( parcours_nom->o_val == 1 )
+        {
+            fprintf(fortran_out, "      subroutine Alloc_agrif_%s(Agrif_Gr)\n", curmodulename);
+            fprintf(fortran_out, "          use Agrif_Util\n");
+            fprintf(fortran_out, "          type(Agrif_grid), pointer :: Agrif_Gr\n");
+            fprintf(fortran_out, "          integer :: i\n");
+            fprintf(fortran_out, "\n#include \"alloc_agrif_%s.h\"\n", curmodulename);
+            fprintf(fortran_out, "      end subroutine Alloc_agrif_%s\n", curmodulename);
             Add_Subroutine_For_Alloc(curmodulename);
-         }
-         else
-         {
+        }
+        else
+        {
             parcours_nom = List_Subroutine_For_Alloc;
             out = 0;
             while ( parcours_nom && out == 0 )
             {
-               if ( !strcasecmp(parcours_nom->o_nom,curmodulename) ) out = 1;
-               else
-               {
-                  parcours_nomprec = parcours_nom;
-                  parcours_nom = parcours_nom->suiv;
-               }
-            }
-            if ( out == 1 )
-            {
-               if ( parcours_nom == List_Subroutine_For_Alloc)
-               {
-                  List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv;
-               }
-               else
-               {
-                  parcours_nomprec->suiv = parcours_nom->suiv;
-                  parcours_nom = parcours_nomprec->suiv ;
-               }
-            }
-         }
-      }
-   }
-}
-
-
-void Write_Alloc_Subroutine_For_End_0()
-{
-   listnom *parcours_nom;
-   listnom *parcours_nomprec;
-   int out;
-   char ligne[LONG_C];
-
-   if ( firstpass == 0 )
-   {
-      parcours_nomprec = (listnom *)NULL;
-      parcours_nom = List_NameOfModule;
-      out = 0 ;
-      while ( parcours_nom && out == 0 )
-      {
-         /*                                                                   */
-         if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1;
-         else parcours_nom = parcours_nom -> suiv;
-      }
-      if ( out == 1 )
-      {
-         if ( parcours_nom->o_val == 1 )
-         {
-            strcpy (ligne, "\n      PUBLIC Alloc_agrif_");
-            strcat (ligne, curmodulename);
-            strcat (ligne, "\n");
-            convert2lower(ligne);
-            fprintf(fortranout,ligne);
-            strcpy (ligne, "\n      contains\n");
-            fprintf(fortranout,ligne);
-            sprintf (ligne, "Subroutine Alloc_agrif_%s(Agrif_Gr)",
-                                                                 curmodulename);
-            tofich(fortranout,ligne,1);
-            strcpy(ligne,"Use Agrif_Util");
-            tofich(fortranout,ligne,1);
-            strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr");
-            tofich(fortranout,ligne,1);
-            strcpy(ligne, "INTEGER :: i");
-            tofich (fortranout, ligne,1);
-            strcpy (ligne, "\n#include \"alloc_agrif_");
-            strcat (ligne, curmodulename);
-            strcat (ligne, ".h\"\n");
-            convert2lower(ligne);
-            fprintf(fortranout,ligne);
-            strcpy (ligne, "Return");
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "End Subroutine Alloc_agrif_%s",curmodulename);
-            tofich(fortranout,ligne,1);
-            /* List all Call Alloc_agrif                                      */
-            Add_Subroutine_For_Alloc(parcours_nom->o_nom);
-         }
-         else
-         {
-            parcours_nom = List_Subroutine_For_Alloc;
-            out = 0;
-            while ( parcours_nom && out == 0 )
-            {
-               if ( !strcasecmp(parcours_nom->o_nom,curmodulename) ) out = 1;
-               else
-               {
-                  parcours_nomprec = parcours_nom;
-                  parcours_nom = parcours_nom->suiv;
-               }
-            }
-            if ( out == 1 )
-            {
-               if ( parcours_nom == List_Subroutine_For_Alloc)
-               {
-                  List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv;
-               }
-               else
-               {
-                  parcours_nomprec->suiv = parcours_nom->suiv;
-                  parcours_nom = parcours_nomprec->suiv ;
-               }
-            }
-         }
-      }
-   }
-}
-
-void Write_GlobalParameter_Declaration_0()
-{
-   listvar *parcours;
-
-   if ( firstpass == 0 )
-   {
-      parcours = List_GlobalParameter_Var;
-      while( parcours )
-      {
-         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
-         {
-            writevardeclaration(parcours,module_declar,0,1);
-         }
-         parcours = parcours -> suiv;
-      }
-   }
-}
-
-void Write_GlobalType_Declaration_0()
-{
-   listvar *parcours;
-   int out = 0;
-   int headtypewritten = 0;
-   char ligne[LONGNOM];
-   int changeval;
-
-   if ( firstpass == 0 )
-   {
-      parcours = List_Global_Var;
-      while( parcours )
-      {
-         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
-         {
-           if (!strcasecmp(parcours->var->v_typevar,"type"))
-           {
-            out = 1;
-            if (headtypewritten == 0)
-              {
-/*RB*/
-                sprintf (ligne, "Module_DeclarType_%s.h",curmodulename);
-                module_declar_type = associate(ligne);
-                sprintf (ligne, " ");
-                tofich (module_declar_type, ligne,1);
-                sprintf(ligne,"TYPE :: Agrif_%s",curmodulename);
-                tofich(module_declar_type,ligne,1);
-                headtypewritten = 1;
-/*RBend*/
-              }
-            changeval = 0;
-            if (parcours->var->v_allocatable == 1)
-             {
-               changeval = 1;
-               parcours->var->v_allocatable = 0;
-               parcours->var->v_pointerdeclare = 1;
-             }
-/*RB*/
-            writevardeclaration(parcours,module_declar_type,0,0);
-/*RBend*/
-            if (changeval == 1)
-              {
-               parcours->var->v_allocatable = 1;
-               parcours->var->v_pointerdeclare = 0;
-              }
-            }
-         }
-         parcours = parcours -> suiv;
-      }
-      if (out == 1)
-        {
-/*RB*/
-                sprintf(ligne,"END TYPE Agrif_%s",curmodulename);
-                tofich(module_declar_type,ligne,1);
-                sprintf(ligne,"TYPE(Agrif_%s), DIMENSION(:), ALLOCATABLE :: Agrif_%s_var",curmodulename,curmodulename); 
-                tofich(module_declar_type,ligne,1);
-                sprintf(ligne,"PUBLIC :: Agrif_%s",curmodulename); 
-                tofich(module_declar_type,ligne,1);
-                sprintf(ligne,"PUBLIC :: Agrif_%s_var",curmodulename); 
-                tofich(module_declar_type,ligne,1);
-/*RBend*/
-        }
-   }
-}
-
-void Write_NotGridDepend_Declaration_0()
-{
-   listvar *parcours;
-
-   if ( firstpass == 0 )
-   {
-      parcours = List_NotGridDepend_Var;
-      while( parcours )
-      {
-         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
-         {
-            writevardeclaration(parcours,fortranout,0,1);
-         }
-         parcours = parcours -> suiv;
-      }
-   }
+                if ( !strcasecmp(parcours_nom->o_nom, curmodulename) ) out = 1;
+                else
+                {
+                    parcours_nomprec = parcours_nom;
+                    parcours_nom = parcours_nom->suiv;
+                }
+            }
+            if ( out )
+            {
+                if ( parcours_nom == List_Subroutine_For_Alloc)
+                {
+                    List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv;
+                }
+                else
+                {
+                    parcours_nomprec->suiv = parcours_nom->suiv;
+                    parcours_nom = parcours_nomprec->suiv ;
+                }
+            }
+        }
+    }
 }
 
@@ -669,7 +494,6 @@
       if ( !List_Pointer_Var )
       {
-         newvar = (listname *)malloc(sizeof(listname));
-         strcpy(newvar->n_name,nom);
-         Save_Length(nom,20);
+         newvar = (listname*) calloc(1, sizeof(listname));
+         strcpy(newvar->n_name, nom);
          newvar->suiv = NULL;
          List_Pointer_Var = newvar;
@@ -691,7 +515,6 @@
             {
                /* add the record                                              */
-              newvar = (listname *)malloc(sizeof(listname));
+              newvar = (listname*) calloc(1, sizeof(listname));
               strcpy(newvar->n_name,nom);
-              Save_Length(nom,20);
               newvar->suiv = NULL;
               parcours->suiv = newvar;
@@ -745,5 +568,5 @@
       while( parcours && out == 0 )
       {
-         if ( !strcasecmp(ident,parcours->var->v_nomvar) ) 
+         if ( !strcasecmp(ident,parcours->var->v_nomvar) )
              {
              if (!strcasecmp(parcours->var->v_typevar,"type")) out = 1;
@@ -757,45 +580,56 @@
 
 /******************************************************************************/
-/*                          VariableIsNotFunction                             */
-/******************************************************************************/
-/*                                                                            */
-/******************************************************************************/
-int VariableIsNotFunction(char *ident)
-{
-   int out;
-   listvar *newvar;
-
-   out =0;
-
-   if ( !strcasecmp(ident,"size") ||
-        !strcasecmp(ident,"if")   ||
-        !strcasecmp(ident,"max")  ||
-        !strcasecmp(ident,"min")
-      )
-   {
-      newvar = List_SubroutineDeclaration_Var;
-      while ( newvar && out == 0 )
-      {
-         if ( !strcasecmp(subroutinename, newvar->var->v_subroutinename) &&
-              !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1;
-         newvar = newvar -> suiv ;
-      }
-      if ( out == 1 ) out = 0;
-      else out = 1;
-      /* if it has not been found                                             */
-      if ( out == 1 )
-      {
-         out = 0;
-         newvar = List_Global_Var;
-         while ( newvar && out == 0 )
-         {
-            if ( !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1;
+/*                          VariableIsFunction                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int VariableIsFunction(const char *ident)
+{
+    int out;
+    listvar *newvar;
+
+    out = 0;
+
+    if ( !strcasecmp(ident,"size") ||
+         !strcasecmp(ident,"if")   ||
+         !strcasecmp(ident,"max")  ||
+         !strcasecmp(ident,"min")  )
+    {
+        newvar = List_SubroutineDeclaration_Var;
+        while ( newvar && out == 0 )
+        {
+            if ( !strcasecmp(subroutinename, newvar->var->v_subroutinename) &&
+                 !strcasecmp(ident, newvar->var->v_nomvar) )
+            {
+                out = 1;
+            }
             newvar = newvar -> suiv ;
-         }
-         if ( out == 1 ) out = 0;
-         else out = 1;
-      }
-   }
-   /*                                                                         */
-   return out;
-}
+        }
+        if ( out == 0 ) /* if it has not been found */
+        {
+            newvar = List_Global_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1;
+                newvar = newvar -> suiv ;
+            }
+        }
+    }
+    return (out == 0);
+}
+
+void dump_var(const variable* var)
+{
+    fprintf(stderr, "   var->v_nomvar : %s\n",var->v_nomvar);
+    fprintf(stderr, "   var->v_indice : %d\n",var->v_indicetabvars);
+    fprintf(stderr, "   var->v_typevar: %s\n",var->v_typevar);
+    fprintf(stderr, "   var->v_catvar : %d\n",var->v_catvar);
+    fprintf(stderr, "   var->v_modulename: %s\n",var->v_modulename);
+    fprintf(stderr, "   var->v_subroutinename: %s\n",var->v_subroutinename);
+    fprintf(stderr, "   var->v_commonname: %s\n",var->v_commonname);
+    fprintf(stderr, "   var->v_commoninfile: %s\n",var->v_commoninfile);
+    fprintf(stderr, "   var->v_nbdim: %d\n",var->v_nbdim);
+    fprintf(stderr, "   var->v_common: %d\n",var->v_common);
+    fprintf(stderr, "   var->v_module: %d\n",var->v_module);
+    fprintf(stderr, "   var->v_initialvalue: %s\n",var->v_initialvalue);
+}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c	(revision 5682)
@@ -41,18 +41,18 @@
 void Init_Variable(variable *var)
 {
-   strcpy(var->v_typevar            ,"");
-   strcpy(var->v_nomvar             ,"");
-   strcpy(var->v_oldname            ,"");
-   strcpy(var->v_dimchar            ,"");
-   strcpy(var->v_modulename         ,"");
-   strcpy(var->v_commonname         ,"");
-   strcpy(var->v_vallengspec        ,"");
-   strcpy(var->v_nameinttypename    ,"");
-   strcpy(var->v_commoninfile       ,"");
-   strcpy(var->v_subroutinename     ,"");
-   strcpy(var->v_precision          ,"");
-   strcpy(var->v_initialvalue       ,"");
-   strcpy(var->v_IntentSpec         ,"");
-   strcpy(var->v_readedlistdimension,"");
+   strcpy(var->v_typevar            , "");
+   strcpy(var->v_nomvar             , "");
+   strcpy(var->v_oldname            , "");
+   strcpy(var->v_dimchar            , "");
+   strcpy(var->v_modulename         , "");
+   strcpy(var->v_commonname         , "");
+   strcpy(var->v_vallengspec        , "");
+   strcpy(var->v_nameinttypename    , "");
+   strcpy(var->v_commoninfile       , "");
+   strcpy(var->v_subroutinename     , "");
+   strcpy(var->v_precision          , "");
+   strcpy(var->v_initialvalue       , "");
+   strcpy(var->v_IntentSpec         , "");
+   strcpy(var->v_readedlistdimension, "");
    var->v_nbdim               = 0 ;
    var->v_common              = 0 ;
@@ -60,4 +60,5 @@
    var->v_module              = 0 ;
    var->v_save                = 0 ;
+   var->v_catvar              = 0 ;
    var->v_VariableIsParameter = 0 ;
    var->v_PublicDeclare       = 0 ;
@@ -74,5 +75,5 @@
    var->v_target              = 0 ;
    var->v_dimsempty           = 0 ;
-   var->v_dimension = (listdim *)NULL;
+   var->v_dimension = (listdim *) NULL;
 }
 /******************************************************************************/
@@ -89,18 +90,19 @@
 /*                                                                            */
 /******************************************************************************/
-listvar * AddListvarToListvar(listvar *l,listvar *glob,int ValueFirstpass)
-{
-   listvar *newvar;
-   if ( firstpass == ValueFirstpass )
-   {
-      if ( !glob) glob = l ;
-      else
-      {
-         newvar=glob;
-         while (newvar->suiv) newvar = newvar->suiv;
-         newvar->suiv = l;
-      }
-   }
-   return glob;
+listvar * AddListvarToListvar ( listvar *l, listvar *glob, int ValueFirstpass )
+{
+    listvar *newvar;
+    if ( firstpass == ValueFirstpass )
+    {
+        if ( !glob ) glob = l;
+        else
+        {
+            newvar = glob;
+            while (newvar->suiv)
+                newvar = newvar->suiv;
+            newvar->suiv = l;
+        }
+    }
+    return glob;
 }
 
@@ -113,65 +115,81 @@
 /*                                                                            */
 /******************************************************************************/
-void CreateAndFillin_Curvar(char *type,variable *curvar)
-{
-   if (!strcasecmp(type,"character") && strcasecmp(CharacterSize,"") )
-   {
-      strcpy(curvar->v_dimchar,CharacterSize);
-      Save_Length(CharacterSize,5);
-   }
-
-  /* On donne la precision de la variable si elle a ete donnee                */
-  curvar->v_c_star = 0;
-  if ( c_star == 1 ) curvar->v_c_star = 1;
-  /*                                                                          */
-  strcpy(curvar->v_vallengspec,"");
-  if ( strcasecmp(vallengspec,"") )
-  {
-     strcpy(curvar->v_vallengspec,vallengspec);
-     Save_Length(vallengspec,8);
-  }
-
-  strcpy(curvar->v_precision,"");
-  if ( strcasecmp(NamePrecision,"") )
-  {
-     strcpy(curvar->v_precision,NamePrecision);
-     Save_Length(NamePrecision,12);
-  }
-  /* Si cette variable a ete declaree dans un module on met curvar->module=1  */
-  if ( inmoduledeclare == 1 || SaveDeclare == 1)
-  {
-      curvar->v_module = 1;
-   }
-   /* Puis on donne le nom du module dans curvar->v_modulename                */
-   strcpy(curvar->v_modulename,curmodulename);
-   Save_Length(curmodulename,6);
-   /* Si cette variable a ete initialisee                                     */
-/*RB*/
-   if ( ! strcmp(InitialValueGiven,"=")  ) 
-/*RBend*/
-   {
-      strcpy(curvar->v_initialvalue,InitValue);
-      Save_Length(InitValue,14);
-   }
-   /* Si cette variable est declaree en save                                  */
-/*RB*/
-   if (SaveDeclare == 1 &&  !strcasecmp(curvar->v_typevar,"type")) {
-/*RBend*/
-   curvar->v_save = 1;
-   }
-
-   /* Si cette variable est v_allocatable                                     */
-   if (Allocatabledeclare == 1 ) curvar->v_allocatable=1;
-   
-   /* Si cette variable est v_targer                                     */
-   if (Targetdeclare == 1 ) curvar->v_target=1;
-   /* if INTENT spec has been given                                           */
-   if ( strcasecmp(IntentSpec,"") )
-   {
-      strcpy(curvar->v_IntentSpec,IntentSpec);
-      Save_Length(IntentSpec,13);
-   }
-}
-
+void CreateAndFillin_Curvar(const char *type, variable *curvar)
+{
+    if ( !strcasecmp(type, "character") && strcasecmp(CharacterSize, "") )
+    {
+        strcpy(curvar->v_dimchar, CharacterSize);
+    }
+
+    /* On donne la precision de la variable si elle a ete donnee                */
+    curvar->v_c_star = 0;
+    if ( c_star == 1 )  curvar->v_c_star = 1;
+
+    strcpy(curvar->v_vallengspec,"");
+    if ( strcasecmp(vallengspec,"") )
+    {
+        strcpy(curvar->v_vallengspec,vallengspec);
+        Save_Length(vallengspec,8);
+    }
+
+    strcpy(curvar->v_precision,"");
+    if ( strcasecmp(NamePrecision,"") )
+    {
+        strcpy(curvar->v_precision,NamePrecision);
+        addprecision_derivedfromkind(curvar);
+        Save_Length(NamePrecision,12);
+    }
+    /* Si cette variable a ete declaree dans un module on met curvar->module=1  */
+    if ( inmoduledeclare == 1 || SaveDeclare == 1 )
+    {
+        curvar->v_module = 1;
+    }
+    /* Puis on donne le nom du module dans curvar->v_modulename                */
+    strcpy(curvar->v_modulename,curmodulename);
+    /* Si cette variable a ete initialisee                                     */
+    if (InitialValueGiven == 1 )
+    {
+        strcpy(curvar->v_initialvalue,InitValue);
+        Save_Length(InitValue,14);
+    }
+    /* Si cette variable est declaree en save                                  */
+    if (SaveDeclare == 1 && !strcasecmp(curvar->v_typevar,"type")) curvar->v_save = 1;
+
+    /* Si cette variable est v_allocatable                                     */
+    if (Allocatabledeclare == 1 ) curvar->v_allocatable=1;
+
+    /* Si cette variable est v_target                                     */
+    if (Targetdeclare == 1 ) curvar->v_target=1;
+
+    /* if INTENT spec has been given                                           */
+    if ( strcasecmp(IntentSpec,"") )
+    {
+        strcpy(curvar->v_IntentSpec,IntentSpec);
+        Save_Length(IntentSpec,13);
+    }
+}
+
+
+void addprecision_derivedfromkind(variable *curvar)
+{
+    listnom *parcours;
+    char kind[LONG_VNAME];
+    char kind_val[LONG_C];
+
+    sscanf(curvar->v_precision, "%100s =", kind_val);
+
+    if ( !strcasecmp(kind_val, "kind") )
+        sscanf(curvar->v_precision, "%50s = %50s", kind, kind_val);
+
+    parcours = listofkind;
+    while (parcours)
+    {
+        if ( !strcasecmp(parcours->o_nom, kind_val) )
+        {
+            sprintf(curvar->v_nameinttypename, "%d", parcours->o_val);
+        }
+        parcours=parcours->suiv;
+    }
+}
 
 /******************************************************************************/
@@ -180,79 +198,74 @@
 /*                                                                            */
 /******************************************************************************/
-void duplicatelistvar(listvar *orig)
-{
-   listvar *parcours;
-   listvar *tmplistvar;
-   listvar *tmplistvarprec;
-   listdim *tmplistdim;
-   variable *tmpvar;
-
-   tmplistvarprec = (listvar *)NULL;
-   parcours = orig;
-   while ( parcours )
-   {
-      tmplistvar = (listvar *)malloc(sizeof(listvar));
-      tmpvar = (variable *)malloc(sizeof(variable));
-      /*                                                                      */
-      Init_Variable(tmpvar);
-      /*                                                                      */
-      strcpy(tmpvar->v_typevar,parcours->var->v_typevar);
-      strcpy(tmpvar->v_nomvar,parcours->var->v_nomvar);
-      strcpy(tmpvar->v_oldname,parcours->var->v_oldname);
-      strcpy(tmpvar->v_dimchar,parcours->var->v_dimchar);
-      if ( parcours->var->v_dimension )
-      {
-         tmplistdim = (listdim *)malloc(sizeof(listdim));
-         tmplistdim = parcours->var->v_dimension;
-         tmpvar->v_dimension = tmplistdim;
-      }
-      tmpvar->v_nbdim=parcours->var->v_nbdim;
-      tmpvar->v_common=parcours->var->v_common;
-      tmpvar->v_positioninblock=parcours->var->v_positioninblock;
-      tmpvar->v_module=parcours->var->v_module;
-      tmpvar->v_save=parcours->var->v_save;
-      tmpvar->v_VariableIsParameter=parcours->var->v_VariableIsParameter;
-      printf("QLKDF\n");
-      tmpvar->v_indicetabvars=parcours->var->v_indicetabvars;
-      strcpy(tmpvar->v_modulename,parcours->var->v_modulename);
-      strcpy(tmpvar->v_commonname,parcours->var->v_commonname);
-      strcpy(tmpvar->v_vallengspec,parcours->var->v_vallengspec);
-
-      strcpy(tmpvar->v_nameinttypename,parcours->var->v_nameinttypename);
-            
-      tmpvar->v_pointedvar=parcours->var->v_pointedvar;
-      strcpy(tmpvar->v_commoninfile,mainfile);
-      Save_Length(mainfile,10);
-      strcpy(tmpvar->v_subroutinename,parcours->var->v_subroutinename);
-      tmpvar->v_dimensiongiven=parcours->var->v_dimensiongiven;
-      tmpvar->v_c_star=parcours->var->v_c_star;
-      strcpy(tmpvar->v_precision,parcours->var->v_precision);
-      strcpy(tmpvar->v_initialvalue,parcours->var->v_initialvalue);
-      tmpvar->v_pointerdeclare=parcours->var->v_pointerdeclare;
-      tmpvar->v_optionaldeclare=parcours->var->v_optionaldeclare;
-      tmpvar->v_allocatable=parcours->var->v_allocatable;
-      tmpvar->v_target=parcours->var->v_target;
-      strcpy(tmpvar->v_IntentSpec,parcours->var->v_IntentSpec);
-      tmpvar->v_dimsempty=parcours->var->v_dimsempty;
-      strcpy(tmpvar->v_readedlistdimension,
-                                          parcours->var->v_readedlistdimension);
-      /*                                                                      */
-      tmplistvar->var = tmpvar;
-      tmplistvar->suiv = NULL;
-      /*                                                                      */
-      if ( !listduplicated )
-      {
-         listduplicated = tmplistvar;
-         tmplistvarprec = listduplicated;
-      }
-      else
-      {
-         tmplistvarprec->suiv = tmplistvar;
-         tmplistvarprec = tmplistvar;
-      }
-      /*                                                                      */
-      parcours = parcours->suiv;
-   }
-}
+// void duplicatelistvar(listvar *orig)
+// {
+//    listvar *parcours;
+//    listvar *tmplistvar;
+//    listvar *tmplistvarprec;
+//    listdim *tmplistdim;
+//    variable *tmpvar;
+//
+//    tmplistvarprec = (listvar *)NULL;
+//    parcours = orig;
+//    while ( parcours )
+//    {
+//       tmplistvar = (listvar *)calloc(1,sizeof(listvar));
+//       tmpvar = (variable *)calloc(1,sizeof(variable));
+//       /*                                                                      */
+//       Init_Variable(tmpvar);
+//       /*                                                                      */
+//       strcpy(tmpvar->v_typevar, parcours->var->v_typevar);
+//       strcpy(tmpvar->v_nomvar,  parcours->var->v_nomvar);
+//       strcpy(tmpvar->v_oldname, parcours->var->v_oldname);
+//       strcpy(tmpvar->v_dimchar, parcours->var->v_dimchar);
+//       if ( parcours->var->v_dimension )
+//       {
+//          tmplistdim = (listdim*) calloc(1,sizeof(listdim));
+//          tmplistdim = parcours->var->v_dimension;
+//          tmpvar->v_dimension = tmplistdim;
+//       }
+//       tmpvar->v_nbdim  = parcours->var->v_nbdim;
+//       tmpvar->v_common = parcours->var->v_common;
+//       tmpvar->v_module = parcours->var->v_module;
+//       tmpvar->v_save   = parcours->var->v_save;
+//       tmpvar->v_positioninblock = parcours->var->v_positioninblock;
+//       tmpvar->v_VariableIsParameter = parcours->var->v_VariableIsParameter;
+//       tmpvar->v_indicetabvars = parcours->var->v_indicetabvars;
+//       tmpvar->v_pointedvar    = parcours->var->v_pointedvar;
+//       tmpvar->v_dimensiongiven = parcours->var->v_dimensiongiven;
+//       tmpvar->v_c_star = parcours->var->v_c_star;
+//       tmpvar->v_catvar = parcours->var->v_catvar;
+//       tmpvar->v_pointerdeclare = parcours->var->v_pointerdeclare;
+//       tmpvar->v_optionaldeclare = parcours->var->v_optionaldeclare;
+//       tmpvar->v_allocatable = parcours->var->v_allocatable;
+//       tmpvar->v_target      = parcours->var->v_target;
+//       tmpvar->v_dimsempty   = parcours->var->v_dimsempty;
+//       strcpy(tmpvar->v_modulename,  parcours->var->v_modulename);
+//       strcpy(tmpvar->v_commonname,  parcours->var->v_commonname);
+//       strcpy(tmpvar->v_vallengspec, parcours->var->v_vallengspec);
+//       strcpy(tmpvar->v_nameinttypename, parcours->var->v_nameinttypename);
+//       strcpy(tmpvar->v_commoninfile, cur_filename);
+//       strcpy(tmpvar->v_subroutinename, parcours->var->v_subroutinename);
+//       strcpy(tmpvar->v_precision, parcours->var->v_precision);
+//       strcpy(tmpvar->v_initialvalue, parcours->var->v_initialvalue);
+//       strcpy(tmpvar->v_IntentSpec, parcours->var->v_IntentSpec);
+//       strcpy(tmpvar->v_readedlistdimension, parcours->var->v_readedlistdimension);
+//
+//       tmplistvar->var = tmpvar;
+//       tmplistvar->suiv = NULL;
+//
+//       if ( !listduplicated )
+//       {
+//          listduplicated = tmplistvar;
+//          tmplistvarprec = listduplicated;
+//       }
+//       else
+//       {
+//          tmplistvarprec->suiv = tmplistvar;
+//          tmplistvarprec = tmplistvar;
+//       }
+//       parcours = parcours->suiv;
+//    }
+// }
 
 /******************************************************************************/
@@ -273,5 +286,5 @@
    listdim *parcours ;
 
-   newdim=(listdim *) malloc (sizeof (listdim));
+   newdim=(listdim *) calloc(1,sizeof(listdim));
    newdim->dim=nom;
    newdim->suiv=NULL;
@@ -310,7 +323,6 @@
    while(parcours_var)
    {
-      v=parcours_var->var;
+      v = parcours_var->var;
       strcpy(v->v_dimchar,(lin->dim).last);
-      Save_Length((lin->dim).last,5);
       parcours_var=parcours_var->suiv;
    }
@@ -319,24 +331,24 @@
 
 /******************************************************************************/
-/*                                num_dims                                    */
+/*                              get_num_dims                                  */
 /******************************************************************************/
 /* This subroutine is used to know the dimension of a table                   */
 /******************************************************************************/
 /*                                                                            */
-/*             Dimension(jpi,jpj,jpk) ----------> num_dims = 3                */
-/*                                                                            */
-/******************************************************************************/
-int num_dims(listdim *d)
-{
-   listdim *parcours;
-   int compteur = 0;
-
-   parcours = d;
-   while(parcours)
-   {
-     compteur++;
-     parcours=parcours->suiv;
-   }
-   return compteur;
+/*             Dimension(jpi,jpj,jpk) ----------> get_num_dims = 3            */
+/*                                                                            */
+/******************************************************************************/
+int get_num_dims ( const listdim *d )
+{
+    listdim *parcours;
+    int compteur = 0;
+
+    parcours = (listdim *) d;
+    while(parcours)
+    {
+        compteur++;
+        parcours = parcours->suiv;
+    }
+    return compteur;
 }
 
@@ -348,69 +360,62 @@
 /*      struct : variable                                                     */
 /******************************************************************************/
-variable * createvar(char *nom,listdim *d)
-{
-  variable *var;
-  listdim *dims;
-  char ligne[LONG_C];
-  char listdimension[LONG_C];
-
-   var=(variable *) malloc(sizeof(variable));
-   /*                                                                         */
-   Init_Variable(var);
-   /*                                                                         */
-   strcpy(var->v_nomvar,nom);
-   Save_Length(nom,4);
-   /*                                                                         */
-   strcpy(listdimension,"");
-   strcpy(var->v_modulename,curmodulename);
-   Save_Length(curmodulename,6);
-   strcpy(var->v_commoninfile,mainfile);
-   Save_Length(mainfile,10);
-   strcpy(var->v_subroutinename,subroutinename);
-   Save_Length(subroutinename,11);
-   /*                                                                         */
-   if ( strcasecmp(nameinttypename,"") )
-   {
-      strcpy(var->v_nameinttypename,nameinttypename);
-      Save_Length(nameinttypename,9);
-   }
-         
-   if ( optionaldeclare     == 1 ) var->v_optionaldeclare = 1;
-   if ( pointerdeclare      == 1 ) var->v_pointerdeclare = 1;
-   if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ;
-   if ( PublicDeclare       == 1 ) var->v_PublicDeclare = 1 ;
-   if ( PrivateDeclare      == 1 ) var->v_PrivateDeclare = 1;
-   if ( ExternalDeclare     == 1 ) var->v_ExternalDeclare = 1;
-   /*                                                                         */
-   var->v_dimension=d;
+variable * createvar(const char *nom, listdim *d)
+{
+    variable *var;
+    listdim *dims;
+    char ligne[LONG_M];
+    char listdimension[LONG_M];
+
+    var = (variable *) calloc(1,sizeof(variable));
+
+    Init_Variable(var);
+
+    strcpy(listdimension,"");
+    strcpy(var->v_nomvar,nom);
+    strcpy(var->v_modulename,curmodulename);
+    strcpy(var->v_commoninfile,cur_filename);
+    strcpy(var->v_subroutinename,subroutinename);
+
+    if ( strcasecmp(nameinttypename,"") )
+    {
+        strcpy(var->v_nameinttypename,nameinttypename);
+    }
+
+    if ( optionaldeclare     == 1 ) var->v_optionaldeclare = 1;
+    if ( pointerdeclare      == 1 ) var->v_pointerdeclare = 1;
+    if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ;
+    if ( PublicDeclare       == 1 ) var->v_PublicDeclare = 1 ;
+    if ( PrivateDeclare      == 1 ) var->v_PrivateDeclare = 1;
+    if ( ExternalDeclare     == 1 ) var->v_ExternalDeclare = 1;
+
+   var->v_dimension = d;
 
    /* Creation of the string for the dimension of this variable               */
-   dimsempty = 1;
-   if ( d )
-   {
-      var->v_dimensiongiven=1;
-      dims = d;
-      while (dims)
-      {
-         if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
-                                                                  dimsempty = 0;
-         sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
-         strcat(listdimension,ligne);
-         if ( dims->suiv )
-         {
-            strcat(listdimension,",");
-         }
-         dims = dims->suiv;
-      }
-/*RB*/
-      if ( dimsempty == 1 || GlobalDeclarationType == 1 ) var->v_dimsempty=1;
-/*RBend*/
-   }
-   strcpy(var->v_readedlistdimension,listdimension);
-   Save_Length(listdimension,15);
-   /*                                                                         */
-   var->v_nbdim=num_dims(d);
-   /*                                                                         */
-   return var;
+    dimsempty = 1;
+    if ( d )
+    {
+        var->v_dimensiongiven = 1;
+        dims = d;
+        while (dims)
+        {
+            if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
+            {
+                dimsempty = 0;
+            }
+            sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+            strcat(listdimension,ligne);
+            if ( dims->suiv )
+            {
+                strcat(listdimension,",");
+            }
+            dims = dims->suiv;
+        }
+        if ( dimsempty == 1 || GlobalDeclarationType == 1 ) var->v_dimsempty = 1;
+    }
+    strcpy(var->v_readedlistdimension,listdimension);
+    Save_Length(listdimension,15);
+    var->v_nbdim = get_num_dims(d);
+
+    return var;
 }
 
@@ -433,5 +438,5 @@
    listvar *tmpvar ;
 
-   newvar=(listvar *) malloc (sizeof (listvar));
+   newvar=(listvar *) calloc(1,sizeof(listvar));
    newvar->var=v;
    newvar->suiv = NULL;
@@ -466,18 +471,18 @@
 /*                                                                            */
 /******************************************************************************/
-listvar *settype(char *nom,listvar *lin)
+listvar *settype(const char *nom, listvar *lin)
 {
    listvar *newvar;
    variable *v;
 
-   newvar=lin;
+   newvar = lin;
    while (newvar)
    {
-      v=newvar->var;
+      v = newvar->var;
       strcpy(v->v_typevar,nom);
-      Save_Length(nom,3);
-      newvar=newvar->suiv;
-   }
-   newvar=lin;
+      v->v_catvar = get_cat_var(v);
+      newvar = newvar->suiv;
+   }
+   newvar = lin;
    return newvar ;
 }
@@ -511,5 +516,5 @@
    variable *v;
    int out ;
-   
+
    newvar=lin;
    out = 0;
@@ -531,5 +536,5 @@
    listname *tmpvar;
 
-   newvar=(listname *) malloc (sizeof (listname));
+   newvar=(listname *) calloc(1,sizeof(listname));
    strcpy(newvar->n_name,nom);
    newvar->suiv = NULL;
@@ -549,5 +554,5 @@
       }
       tmpvar -> suiv = newvar;
-   }
+      }
       else
       {
@@ -568,22 +573,23 @@
     tmpvar = tmpvar->suiv;
    }
-   
+
    tmpvar->suiv = l2;
-   
+
    return l1;
 }
 
-void *createstringfromlistname(char *ligne, listname *lin)
-{
-listname *tmpvar;
-
-strcpy(ligne,"");
-tmpvar = lin;
-while(tmpvar)
-{
-  strcat(ligne,tmpvar->n_name);
-  if (tmpvar->suiv) strcat(ligne,",");
-  tmpvar=tmpvar->suiv;
-}
+void createstringfromlistname(char *ligne, listname *lin)
+{
+    listname *tmpvar;
+
+    strcpy(ligne,"");
+    tmpvar = lin;
+
+    while(tmpvar)
+    {
+        strcat(ligne,tmpvar->n_name);
+        if (tmpvar->suiv) strcat(ligne,",");
+        tmpvar=tmpvar->suiv;
+    }
 }
 
@@ -607,13 +613,12 @@
 void removeglobfromlist(listname **lin)
 {
-  listname *listemp;
   listname *parcours1;
   listvar *parcours2;
   listname * parcourspres;
   int out;
-  
+
   parcours1 = *lin;
   parcourspres = (listname *)NULL;
-  
+
   while (parcours1)
   {
@@ -644,5 +649,5 @@
    {
    parcourspres = parcours1;
-    parcours1 = parcours1->suiv;  
+    parcours1 = parcours1->suiv;
     }
   }
@@ -651,41 +656,51 @@
 void writelistpublic(listname *lin)
 {
-  listname *parcours1;
-  char ligne[LONG_40M];
-  char tempname[LONG_4M];
-  
-  if (lin)
-  {
-  sprintf(ligne,"public :: ");
-  parcours1 = lin;
-  
-  while (parcours1)
-  {
-    strcat(ligne,parcours1->n_name);
-    if (parcours1->suiv) strcat(ligne,", ");
-    parcours1 = parcours1->suiv;  
-  }
-  tofich(fortranout,ligne,1);
-  }
-
+    listname *parcours1;
+    char ligne[LONG_M];
+
+    if (lin)
+    {
+        sprintf(ligne,"public :: ");
+        parcours1 = lin;
+
+        while ( parcours1 )
+        {
+            strcat(ligne, parcours1->n_name);
+            if ( parcours1->suiv ) strcat(ligne,", ");
+            parcours1 = parcours1->suiv;
+        }
+        tofich(fortran_out,ligne,1);
+    }
 }
 
 void Init_List_Data_Var()
 {
-listvar *parcours;
-
-parcours = List_Data_Var_Cur;
-
-if (List_Data_Var_Cur)
-{
-while (parcours)
-{
- List_Data_Var_Cur = List_Data_Var_Cur->suiv;
- free(parcours);
- parcours = List_Data_Var_Cur;
-}
-}
-
-List_Data_Var_Cur = NULL;
-
-}
+    listvar *parcours;
+
+    parcours = List_Data_Var_Cur;
+
+    if (List_Data_Var_Cur)
+    {
+        while (parcours)
+        {
+            List_Data_Var_Cur = List_Data_Var_Cur->suiv;
+            free(parcours);
+            parcours = List_Data_Var_Cur;
+        }
+    }
+    List_Data_Var_Cur = NULL;
+}
+
+int get_cat_var(variable *var)
+{
+    if (!strcasecmp(var->v_typevar, "CHARACTER"))
+        return 1;
+    else if ((var->v_nbdim == 0 ) && (!strcasecmp(var->v_typevar, "REAL")))
+        return 2;
+    else if (!strcasecmp(var->v_typevar, "LOGICAL"))
+        return 3;
+    else if (!strcasecmp(var->v_typevar, "INTEGER"))
+        return 4;
+    else
+        return 0;
+}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c	(revision 5682)
@@ -71,12 +71,9 @@
    }
    /* if variable does not exist, we add it                                   */
-   newvar=(listvar *)malloc(sizeof(listvar));
-   newvar->var=(variable *)malloc(sizeof(variable));
+   newvar=(listvar *)calloc(1,sizeof(listvar));
+   newvar->var=(variable *)calloc(1,sizeof(variable));
    strcpy(newvar->var->v_nomvar,name);
-   Save_Length(name,4);
-   strcpy(newvar->var->v_commoninfile,mainfile);
-   Save_Length(mainfile,10);
+   strcpy(newvar->var->v_commoninfile,cur_filename);
    strcpy(newvar->var->v_subroutinename,subroutinename);
-   Save_Length(subroutinename,11);
    newvar->var->v_notgrid = 1 ;
    newvar->suiv = List_NotGridDepend_Var;
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c	(revision 5682)
@@ -45,5 +45,5 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_Allocate_Var_1(char *nom,char *nommodule)
+void Add_Allocate_Var_1(const char *nom, const char *nommodule)
 {
    listallocate *newvar;
@@ -55,11 +55,9 @@
       if ( !List_Allocate_Var )
       {
-         newvar = (listallocate *)malloc(sizeof(listallocate));
+         newvar = (listallocate *)calloc(1,sizeof(listallocate));
          strcpy(newvar->a_nomvar,nom);
+         strcpy(newvar->a_subroutine,subroutinename);
+         strcpy(newvar->a_module,nommodule);
          Save_Length(nom,25);
-         strcpy(newvar->a_subroutine,subroutinename);
-         Save_Length(subroutinename,26);
-         strcpy(newvar->a_module,nommodule);
-         Save_Length(nommodule,27);
          newvar->suiv = NULL;
          List_Allocate_Var = newvar;
@@ -71,7 +69,7 @@
          while ( parcours->suiv && out == 0 )
          {
-            if (  !strcasecmp(parcours->a_nomvar,nom) &&
-                  !strcasecmp(parcours->a_subroutine,subroutinename) &&
-                  !strcasecmp(parcours->a_module,nommodule) ) out = 1;
+            if (  !strcasecmp(parcours->a_nomvar, nom) &&
+                  !strcasecmp(parcours->a_subroutine, subroutinename) &&
+                  !strcasecmp(parcours->a_module, nommodule) ) out = 1;
             else
                parcours=parcours->suiv;
@@ -85,11 +83,9 @@
             {
                /* add the record                                              */
-              newvar = (listallocate *)malloc(sizeof(listallocate));
-              strcpy(newvar->a_nomvar,nom);
+              newvar = (listallocate *)calloc(1,sizeof(listallocate));
+              strcpy(newvar->a_nomvar, nom);
+              strcpy(newvar->a_subroutine, subroutinename);
+              strcpy(newvar->a_module, nommodule);
               Save_Length(nom,25);
-              strcpy(newvar->a_subroutine,subroutinename);
-              Save_Length(subroutinename,26);
-              strcpy(newvar->a_module,nommodule);
-              Save_Length(nommodule,27);
               newvar->suiv = NULL;
               parcours->suiv = newvar;
@@ -108,45 +104,19 @@
 /*                                                                            */
 /******************************************************************************/
-int IsVarAllocatable_0(char *ident)
-{
-   listallocate *parcours;
-   int out;
-
-   out = 0 ;
-   if ( firstpass == 0 )
-   {
-      parcours = List_Allocate_Var;
-      while ( parcours && out == 0 )
-      {
-         if ( !strcasecmp(parcours->a_nomvar,ident)  ) out = 1 ;
-         else parcours=parcours->suiv;
-      }
-   }
-   return out;
-}
-
-
-/******************************************************************************/
-/*                          varisallocatable_0                                */
-/******************************************************************************/
-/* Firstpass 0                                                                */
-/******************************************************************************/
-/*                                                                            */
-/******************************************************************************/
-int varisallocatable_0(char *ident)
-{
-   listallocate *newvaralloc;
-   int out;
-
-   out =0;
-   if (firstpass == 0 )
-   {
-         newvaralloc = List_Allocate_Var;
-         while ( newvaralloc && out == 0 )
-         {
-            if ( !strcasecmp(ident,newvaralloc->a_nomvar) )  out = 1;
-            else newvaralloc = newvaralloc->suiv;
-         }
-   }
-   return out;
-}
+// int IsVarAllocatable_0(const char *ident)
+// {
+//    listallocate *parcours;
+//    int out;
+// 
+//    out = 0 ;
+//    if ( firstpass == 0 )
+//    {
+//       parcours = List_Allocate_Var;
+//       while ( parcours && out == 0 )
+//       {
+//          if ( !strcasecmp(parcours->a_nomvar,ident)  ) out = 1 ;
+//          else parcours=parcours->suiv;
+//       }
+//    }
+//    return out;
+// }
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c	(revision 5682)
@@ -47,10 +47,6 @@
 void Add_GlobalParameter_Var_1(listvar *listin)
 {
-   if ( firstpass == 1 )
-   {
-      if ( VariableIsParameter == 1 ) {
-      List_GlobalParameter_Var =  AddListvarToListvar(listin,List_GlobalParameter_Var,1);
-   }
-   }
+    if ( VariableIsParameter )
+        List_GlobalParameter_Var =  AddListvarToListvar(listin, List_GlobalParameter_Var, 1);
 }
 
@@ -64,19 +60,19 @@
 void Add_Parameter_Var_1(listvar *listin)
 {
-   listvar *parcours;
+    listvar *parcours;
 
-   if ( firstpass == 1 && VariableIsParameter == 1 )
-   {
-      if ( !List_Parameter_Var )
-      {
-         List_Parameter_Var = listin;
-      }
-      else
-      {
-         parcours = List_Parameter_Var;
-         while (parcours->suiv) parcours=parcours->suiv;
-         parcours->suiv = listin;
-      }
-   }
+    if ( !VariableIsParameter )    return;
+
+    if ( List_Parameter_Var == NULL )
+    {
+        List_Parameter_Var = listin;
+    }
+    else
+    {
+        parcours = List_Parameter_Var;
+        while ( parcours->suiv )
+            parcours = parcours->suiv;
+        parcours->suiv = listin;
+    }
 }
 
@@ -92,16 +88,14 @@
    listvar *parcours;
 
-   if ( firstpass == 1 )
-   {
-      if ( !List_Dimension_Var )
-      {
-         List_Dimension_Var = listin;
-      }
-      else
-      {
-         parcours = List_Dimension_Var;
-         while (parcours->suiv) parcours=parcours->suiv;
-         parcours->suiv = listin;
-      }
-   }
+    if ( List_Dimension_Var == NULL )
+    {
+        List_Dimension_Var = listin;
+    }
+    else
+    {
+        parcours = List_Dimension_Var;
+        while (parcours->suiv)
+            parcours = parcours->suiv;
+        parcours->suiv = listin;
+    }
 }
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c	(revision 5682)
@@ -46,12 +46,8 @@
 void Add_Globliste_1(listvar *listtoadd)
 {
-   if ( firstpass == 1 )
-   {
-      if ( aftercontainsdeclare == 0 &&
-           VariableIsParameter  == 0 )
-      {
-         List_Global_Var = AddListvarToListvar(listtoadd,List_Global_Var,1);
-      }
-   }
+    if ( aftercontainsdeclare == 0 && VariableIsParameter == 0 )
+    {
+        List_Global_Var = AddListvarToListvar(listtoadd, List_Global_Var, 1);
+    }
 }
 
@@ -100,5 +96,5 @@
    {
     strcpy(oldvar->v_dimension->dim.last,newvar->v_dimension->dim.last);
-    strcpy(oldvar->v_dimension->dim.first,newvar->v_dimension->dim.first);    
+    strcpy(oldvar->v_dimension->dim.first,newvar->v_dimension->dim.first);
    }
    out = 1;
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c	(revision 5682)
@@ -51,10 +51,10 @@
 {
   listvar *newvar;
-  char ligne[LONG_C];
+  char ligne[LONG_M];
 
 //  if ( firstpass == 1 )
 //  {
-     newvar=(listvar *)malloc(sizeof(listvar));
-     newvar->var=(variable *)malloc(sizeof(variable));
+     newvar=(listvar *)calloc(1,sizeof(listvar));
+     newvar->var=(variable *)calloc(1,sizeof(variable));
      /*                                                                       */
      Init_Variable(newvar->var);
@@ -62,17 +62,11 @@
      if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
      strcpy(newvar->var->v_nomvar,name);
-     Save_Length(name,4);
      strcpy(newvar->var->v_subroutinename,subroutinename);
-     Save_Length(subroutinename,11);
      strcpy(newvar->var->v_modulename,curmodulename);
-     Save_Length(curmodulename,6);
-     strcpy(newvar->var->v_commoninfile,mainfile);
-     Save_Length(mainfile,10);
+     strcpy(newvar->var->v_commoninfile,cur_filename);
      if (strchr(values,',') && strncasecmp(values,"'",1))
-            {
-            sprintf(ligne,"(/%s/)",values);
-            }
+        sprintf(ligne,"(/%s/)",values);
      else
-       strcpy(ligne,values);
+        strcpy(ligne,values);
        
      strcpy(newvar->var->v_initialvalue,ligne);
@@ -93,51 +87,59 @@
 void Add_Data_Var_Names_01 (listvar **curlist,listname *l1,listname *l2)
 {
-  listvar *newvar;
-  listvar *tmpvar;
-  listname *tmpvar1;
-  listname *tmpvar2;  
-  char ligne[LONG_C];
+    listvar *newvar;
+    listvar *tmpvar;
+    listname *tmpvar1;
+    listname *tmpvar2;  
+    variable *found_var = NULL;
+    
+    tmpvar1 = l1;
+    tmpvar2 = l2;
   
-  tmpvar1 = l1;
-  tmpvar2 = l2;
-  
-  while (tmpvar1)
-     {
-     newvar=(listvar *)malloc(sizeof(listvar));
-     newvar->var=(variable *)malloc(sizeof(variable));
-     /*                                                                       */
-     Init_Variable(newvar->var);
-     /*                                                                       */
-     if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
-     strcpy(newvar->var->v_nomvar,tmpvar1->n_name);
-     Save_Length(tmpvar1->n_name,4);
-     strcpy(newvar->var->v_subroutinename,subroutinename);
-     Save_Length(subroutinename,11);
-     strcpy(newvar->var->v_modulename,curmodulename);
-     Save_Length(curmodulename,6);
-     strcpy(newvar->var->v_commoninfile,mainfile);
-     Save_Length(mainfile,10);
-       
-     strcpy(newvar->var->v_initialvalue,tmpvar2->n_name);
-     Save_Length(tmpvar2->n_name,14);
-     newvar->suiv = NULL;
+    while (tmpvar1)
+    {
+        newvar = (listvar *) calloc(1,sizeof(listvar));
+        newvar->var = (variable *) calloc(1,sizeof(variable));
+
+        Init_Variable(newvar->var);
+
+        if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
      
-     if ( ! (*curlist) )
-     {
-        *curlist  = newvar ;
-     }
-     else
-     {
-        tmpvar = *curlist;
-        while (tmpvar->suiv)
-          tmpvar=tmpvar->suiv;
-        tmpvar->suiv = newvar;
-     }
+        found_var = get_variable_in_list_from_name(List_Common_Var, tmpvar1->n_name);
+        if ( ! found_var )  found_var = get_variable_in_list_from_name(List_Global_Var,tmpvar1->n_name);
+        if ( ! found_var )  found_var = get_variable_in_list_from_name(List_SubroutineDeclaration_Var,tmpvar1->n_name);
+        
+        if ( found_var && found_var->v_nbdim > 0 )
+        {
+            printf("##############################################################################################################\n");
+            printf("## CONV Error : arrays in data_stmt_object lists not yet supported. Please complain to the proper authorities.\n");
+            printf("##   variable name : %s (in %s:%s:%s)\n", found_var->v_nomvar, found_var->v_modulename,
+                                                              found_var->v_subroutinename, found_var->v_commonname);
+            exit(1);
+        }
+        
+        strcpy(newvar->var->v_nomvar,tmpvar1->n_name);
+        strcpy(newvar->var->v_subroutinename,subroutinename);
+        strcpy(newvar->var->v_modulename,curmodulename);
+        strcpy(newvar->var->v_commoninfile,cur_filename);
+        strcpy(newvar->var->v_initialvalue,tmpvar2->n_name);
+
+        Save_Length(tmpvar2->n_name,14);
+
+        newvar->suiv = NULL;
      
-  tmpvar1 = tmpvar1->suiv;
-  tmpvar2 = tmpvar2->suiv;  
-  }
-  return;
-
-
+        if ( *curlist != NULL )
+        {
+            tmpvar = *curlist;
+            while (tmpvar->suiv)
+                tmpvar = tmpvar->suiv;
+            tmpvar->suiv = newvar;
+        }
+        else
+        {
+            *curlist  = newvar ;
+        }
+     
+        tmpvar1 = tmpvar1->suiv;
+        tmpvar2 = tmpvar2->suiv;  
+    }
 }
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c	(revision 5682)
@@ -38,481 +38,115 @@
 #include "decl.h"
 
-void Save_Length(char *nom, int whichone)
+void Save_Length(const char *nom, int whichone)
 {
-   if ( whichone == 1  && strlen(nom) > length_last )
+    size_t len_nom = strlen(nom);
+    
+   if ( whichone == 1  && len_nom > length_last )
    {
-      length_last               = strlen(nom);
-      if ( length_last > LONG_C )
-      {
-         printf("WARNING 1 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_last+100);
-      }
+      length_last = len_nom;
+      if ( length_last > LONG_M )
+            printf("WARNING 1 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_last+100);
    }
-   if ( whichone == 2  && strlen(nom) > length_first )
+   if ( whichone == 2  && len_nom > length_first )
    {
-      length_first              = strlen(nom);
-      if ( length_first > LONG_C )
-      {
-         printf("WARNING 2 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_first+100);
-      }
+      length_first = len_nom;
+      if ( length_first > LONG_M )
+           printf("WARNING 2 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_first+100);
    }
-   if ( whichone == 3  && strlen(nom) > length_v_typevar )
+   if ( whichone == 8  && len_nom > length_v_vallengspec )
    {
-      length_v_typevar          = strlen(nom);
-      if ( length_v_typevar > LONG_C )
-      {
-         printf("WARNING 3 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_v_typevar+100);
-      }
+      length_v_vallengspec = len_nom;
+      if ( length_v_vallengspec > LONG_M )
+           printf("WARNING 8 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_vallengspec+100);
    }
-   if ( whichone == 4  && strlen(nom) > length_v_nomvar )
+   if ( whichone == 12 && len_nom > length_v_precision )
    {
-      length_v_nomvar           = strlen(nom);
-      if ( length_v_nomvar > LONG_C )
-      {
-         printf("WARNING 4 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_v_nomvar+100);
-      }
+      length_v_precision = len_nom;
+      if ( length_v_precision > LONG_M )
+           printf("WARNING 12 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_precision+100);
    }
-   if ( whichone == 5  && strlen(nom) > length_v_dimchar )
+   if ( whichone == 13 && len_nom > length_v_IntentSpec )
    {
-      length_v_dimchar          = strlen(nom);
-      if ( length_v_dimchar > LONG_C )
-      {
-         printf("WARNING 5 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                          length_v_dimchar+100);
-      }
+      length_v_IntentSpec = len_nom;
+      if ( length_v_IntentSpec > LONG_M )
+           printf("WARNING 13 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_IntentSpec+100);
    }
-   if ( whichone == 6  && strlen(nom) > length_v_modulename )
+   if ( whichone == 14 && len_nom > length_v_initialvalue )
    {
-      length_v_modulename       = strlen(nom);
-      if ( length_v_modulename > LONG_C )
-      {
-         printf("WARNING 6 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_v_modulename+100);
-      }
+      length_v_initialvalue = len_nom;
+      if ( length_v_initialvalue > LONG_M )
+           printf("WARNING 14 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_initialvalue+100);
    }
-   if ( whichone == 7  && strlen(nom) > length_v_commonname )
+   if ( whichone == 15 && len_nom > length_v_readedlistdimension )
    {
-      length_v_commonname       = strlen(nom);
-      if ( length_v_commonname > LONG_C )
-      {
-         printf("WARNING 7 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_v_commonname+100);
-      }
+      length_v_readedlistdimension = len_nom;
+      if ( length_v_readedlistdimension > LONG_M )
+           printf("WARNING 15 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_readedlistdimension+100);
    }
-   if ( whichone == 8  && strlen(nom) > length_v_vallengspec )
+   if ( whichone == 25 && len_nom > length_a_nomvar )
    {
-      length_v_vallengspec      = strlen(nom);
-      if ( length_v_vallengspec > LONG_C )
-      {
-         printf("WARNING 8 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                      length_v_vallengspec+100);
-      }
+      length_a_nomvar = len_nom;
+      if ( length_a_nomvar > LONG_C )
+           printf("WARNING 25 : The value of LONG_C (defined in decl.h) should be upgrated to %lu\n", length_a_nomvar+100);
    }
-   if ( whichone == 9  && strlen(nom) > length_v_nameinttypename )
+   if ( whichone == 39 && len_nom > length_toprintglob )
    {
-      length_v_nameinttypename  = strlen(nom);
-      if ( length_v_nameinttypename > LONG_C )
-      {
-         printf("WARNING 9 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                  length_v_nameinttypename+100);
-      }
+      length_toprintglob = len_nom;
+      if ( length_toprintglob > LONG_M )
+           printf("WARNING 39 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprintglob+100);
    }
-   if ( whichone == 10 && strlen(nom) > length_v_commoninfile )
+   if ( whichone == 40 && len_nom > length_tmpvargridname )
    {
-      length_v_commoninfile     = strlen(nom);
-      if ( length_v_commoninfile > LONG_C )
-      {
-         printf("WARNING 10 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                     length_v_commoninfile+100);
-      }
+      length_tmpvargridname = len_nom;
+      if ( length_tmpvargridname > LONG_M )
+           printf("WARNING 40 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_tmpvargridname+100);
    }
-   if ( whichone == 11 && strlen(nom) > length_v_subroutinename )
+   if ( whichone == 41 && len_nom > length_ligne_Subloop )
    {
-      length_v_subroutinename   = strlen(nom);
-      if ( length_v_subroutinename > LONG_C )
-      {
-         printf("WARNING 11 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                   length_v_subroutinename+100);
-      }
+       length_ligne_Subloop = len_nom;
+      if ( length_ligne_Subloop > LONG_M )
+           printf("WARNING 41 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n",length_ligne_Subloop+100);
    }
-   if ( whichone == 12 && strlen(nom) > length_v_precision )
+   if ( whichone == 43 && len_nom > length_toprint_utilagrif )
    {
-      length_v_precision        = strlen(nom);
-      if ( length_v_precision > LONG_C )
-      {
-         printf("WARNING 12 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_v_precision+100);
-      }
+      length_toprint_utilagrif = len_nom;
+      if ( length_toprint_utilagrif > LONG_M )
+           printf("WARNING 43 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprint_utilagrif+100);
    }
-   if ( whichone == 13 && strlen(nom) > length_v_IntentSpec )
+   if ( whichone == 44 && len_nom > length_toprinttmp_utilchar )
    {
-      length_v_IntentSpec       = strlen(nom);
-      if ( length_v_IntentSpec > LONG_C )
-      {
-         printf("WARNING 13 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_v_IntentSpec+100);
-      }
+      length_toprinttmp_utilchar = len_nom;
+      if ( length_toprinttmp_utilchar > LONG_M)
+           printf("WARNING 44 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprinttmp_utilchar+100);
    }
-   if ( whichone == 14 && strlen(nom) > length_v_initialvalue )
+   if ( whichone == 45 && len_nom > length_ligne_writedecl )
    {
-      length_v_initialvalue     = strlen(nom);
-      if ( length_v_initialvalue > LONG_4C )
-      {
-         printf("WARNING 14 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                     length_v_initialvalue+100);
-      }
+      length_ligne_writedecl = len_nom;
+      if ( length_ligne_writedecl > LONG_M )
+           printf("WARNING 45 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_ligne_writedecl+100);
    }
-   if ( whichone == 15 && strlen(nom) > length_v_readedlistdimension )
+   if ( whichone == 46 && len_nom > length_newname_toamr )
    {
-      length_v_readedlistdimension = strlen(nom);
-      if ( length_v_readedlistdimension > LONG_C )
-      {
-         printf("WARNING 15 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                              length_v_readedlistdimension+100);
-      }
+      length_newname_toamr = len_nom;
+      if ( length_newname_toamr > LONG_C )
+           printf("WARNING 46 : The value of LONG_C (defined in decl.h) should be upgrated to %lu\n", length_newname_toamr+100);
    }
-   if ( whichone == 16 && strlen(nom) > length_u_usemodule )
+   if ( whichone == 47 && len_nom > length_newname_writedecl )
    {
-      length_u_usemodule        = strlen(nom);
-      if ( length_u_usemodule > LONG_C )
-      {
-         printf("WARNING 16 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_u_usemodule+100);
-      }
+      length_newname_writedecl = len_nom;
+      if ( length_newname_writedecl > LONG_M )
+           printf("WARNING 47 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_newname_writedecl +100);
    }
-   if ( whichone == 17 && strlen(nom) > length_u_charusemodule )
+   if ( whichone == 48 && len_nom > length_ligne_toamr )
    {
-      length_u_charusemodule    = strlen(nom);
-      if ( length_u_charusemodule > LONG_C )
-      {
-         printf("WARNING 17 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                    length_u_charusemodule+100);
-      }
+      length_ligne_toamr = len_nom;
+      if ( length_ligne_toamr > LONG_M )
+           printf("WARNING 48 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_ligne_toamr +100);
    }
-   if ( whichone == 18 && strlen(nom) > length_u_cursubroutine )
+   if ( whichone == 49 && len_nom > length_tmpligne_writedecl )
    {
-      length_u_cursubroutine    = strlen(nom);
-      if ( length_u_cursubroutine > LONG_C )
-      {
-         printf("WARNING 18 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                    length_u_cursubroutine+100);
-      }
-   }
-   if ( whichone == 19 && strlen(nom) > length_u_modulename )
-   {
-      length_u_modulename       = strlen(nom);
-      if ( length_u_modulename > LONG_C )
-      {
-         printf("WARNING 19 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_u_modulename+100);
-      }
-   }
-   if ( whichone == 20 && strlen(nom) > length_n_name )
-   {
-      length_n_name             = strlen(nom);
-      if ( length_n_name > LONG_C )
-      {
-         printf("WARNING 20 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_n_name+100);
-      }
-   }
-   if ( whichone == 21 && strlen(nom) > length_c_namevar )
-   {
-      length_c_namevar          = strlen(nom);
-      if ( length_c_namevar > LONG_C )
-      {
-         printf("WARNING 21 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_c_namevar+100);
-      }
-   }
-   if ( whichone == 22 && strlen(nom) > length_c_namepointedvar )
-   {
-      length_c_namepointedvar   = strlen(nom);
-      if ( length_c_namepointedvar > LONG_C )
-      {
-         printf("WARNING 22 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                   length_c_namepointedvar+100);
-      }
-   }
-   if ( whichone == 23 && strlen(nom) > length_o_nom )
-   {
-      length_o_nom              = strlen(nom);
-      if ( length_o_nom > LONG_C )
-      {
-         printf("WARNING 23 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_o_nom+100);
-      }
-   }
-   if ( whichone == 24 && strlen(nom) > length_o_module )
-   {
-      length_o_module           = strlen(nom);
-      if ( length_o_module > LONG_C )
-      {
-         printf("WARNING 24 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_o_module+100);
-      }
-   }
-   if ( whichone == 25 && strlen(nom) > length_a_nomvar )
-   {
-      length_a_nomvar           = strlen(nom);
-      if ( length_a_nomvar > LONG_C )
-      {
-         printf("WARNING 25 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_a_nomvar+100);
-      }
-   }
-   if ( whichone == 26 && strlen(nom) > length_a_subroutine )
-   {
-      length_a_subroutine       = strlen(nom);
-      if ( length_a_subroutine > LONG_C )
-      {
-         printf("WARNING 26 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_a_subroutine+100);
-      }
-   }
-   if ( whichone == 27 && strlen(nom) > length_a_module )
-   {
-      length_a_module           = strlen(nom);
-      if ( length_a_module > LONG_C )
-      {
-         printf("WARNING 27 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_a_module+100);
-      }
-   }
-   if ( whichone == 28 && strlen(nom) > length_t_usemodule )
-   {
-      length_t_usemodule        = strlen(nom);
-      if ( length_t_usemodule > LONG_C )
-      {
-         printf("WARNING 28 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_t_usemodule+100);
-      }
-   }
-   if ( whichone == 29 && strlen(nom) > length_t_cursubroutine )
-   {
-      length_t_cursubroutine    = strlen(nom);
-      if ( length_t_cursubroutine > LONG_C )
-      {
-         printf("WARNING 29 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                    length_t_cursubroutine+100);
-      }
-   }
-   if ( whichone == 30 && strlen(nom) > length_curfilename )
-   {
-      length_curfilename        = strlen(nom);
-      if (length_curfilename  > LONG_C )
-      {
-         printf("WARNING 30 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_curfilename+100);
-      }
-   }
-   if ( whichone == 31 && strlen(nom) > length_nomfileoutput )
-   {
-      length_nomfileoutput      = strlen(nom);
-      if ( length_nomfileoutput > LONG_C )
-      {
-         printf("WARNING 31 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                      length_nomfileoutput+100);
-      }
-   }
-   if ( whichone == 32 && strlen(nom) > length_motparse )
-   {
-      length_motparse           = strlen(nom);
-      if ( length_motparse > LONG_4C )
-      {
-         printf("WARNING 32 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_motparse+100);
-      }
-   }
-   if ( whichone == 33 && strlen(nom) > length_mainfile )
-   {
-      length_mainfile           = strlen(nom);
-      if ( length_mainfile > LONG_C )
-      {
-         printf("WARNING 33 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_mainfile+100);
-      }
-   }
-   if ( whichone == 34 && strlen(nom) > length_nomdir )
-   {
-      length_nomdir             = strlen(nom);
-      if ( length_nomdir > LONG_C )
-      {
-         printf("WARNING 34 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_nomdir+100);
-      }
-   }
-   if ( whichone == 35 && strlen(nom) > length_commondirout )
-   {
-      length_commondirout       = strlen(nom);
-      if ( length_commondirout > LONG_C )
-      {
-         printf("WARNING 35 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_commondirout+100);
-      }
-   }
-   if ( whichone == 36 && strlen(nom) > length_commondirin )
-   {
-      length_commondirin        = strlen(nom);
-      if ( length_commondirin > LONG_C )
-      {
-         printf("WARNING 36 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_commondirin+100);
-      }
-   }
-   if ( whichone == 37 && strlen(nom) > length_filetoparse )
-   {
-      length_filetoparse        = strlen(nom);
-      if ( length_filetoparse > LONG_C )
-      {
-         printf("WARNING 37 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_filetoparse+100);
-      }
-   }
-   if ( whichone == 38 && strlen(nom) > length_curbuf )
-   {
-      length_curbuf             = strlen(nom);
-      if ( length_curbuf > LONG_40M )
-      {
-         printf("WARNING 38 : The value of LONG_40M - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",length_curbuf+100);
-      }
-   }
-   if ( whichone == 39 && strlen(nom) > length_toprintglob )
-   {
-      length_toprintglob        = strlen(nom);
-      if ( length_toprintglob > LONG_4C )
-      {
-         printf("WARNING 39 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                        length_toprintglob+100);
-      }
-   }
-   if ( whichone == 40 && strlen(nom) > length_tmpvargridname )
-   {
-      length_tmpvargridname     = strlen(nom);
-      if ( length_tmpvargridname > LONG_4C )
-      {
-         printf("WARNING 40 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                     length_tmpvargridname+100);
-      }
-   }
-   if ( whichone == 41 && strlen(nom) > length_ligne_Subloop )
-   {
-       length_ligne_Subloop    = strlen(nom);
-      if ( length_ligne_Subloop > LONG_40M )
-      {
-         printf("WARNING 41 : The value of LONG_40M - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                      length_ligne_Subloop+100);
-      }
-   }
-   if ( whichone == 42 && strlen(nom) > length_lvargridname_toamr )
-   {
-      length_lvargridname_toamr     = strlen(nom);
-      if ( length_lvargridname_toamr > LONG_4C )
-      {
-         printf("WARNING 42 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                 length_lvargridname_toamr+100);
-      }
-   }
-   if ( whichone == 43 && strlen(nom) > length_toprint_utilagrif )
-   {
-      length_toprint_utilagrif     = strlen(nom);
-      if ( length_toprint_utilagrif > LONG_C )
-      {
-         printf("WARNING 43 : The value of LONG_C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                  length_toprint_utilagrif+100);
-      }
-   }
-   if ( whichone == 44 && strlen(nom) > length_toprinttmp_utilchar )
-   {
-      length_toprinttmp_utilchar     = strlen(nom);
-      if ( length_toprinttmp_utilchar > LONG_4C)
-      {
-         printf("WARNING 44 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                length_toprinttmp_utilchar+100);
-      }
-   }
-   if ( whichone == 45 && strlen(nom) > length_ligne_writedecl )
-   {
-      length_ligne_writedecl     = strlen(nom);
-      if ( length_ligne_writedecl > LONG_4C )
-      {
-         printf("WARNING 45 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                    length_ligne_writedecl+100);
-      }
-   }
-   if ( whichone == 46 && strlen(nom) > length_newname_toamr )
-   {
-      length_newname_toamr    = strlen(nom);
-      if ( length_newname_toamr > LONG_4C )
-      {
-         printf("WARNING 46 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                      length_newname_toamr+100);
-      }
-   }
-   if ( whichone == 47 && strlen(nom) > length_newname_writedecl )
-   {
-      length_newname_writedecl    = strlen(nom);
-      if ( length_newname_writedecl > LONG_4C )
-      {
-         printf("WARNING 47 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                 length_newname_writedecl +100);
-      }
-   }
-   if ( whichone == 48 && strlen(nom) > length_ligne_toamr )
-   {
-      length_ligne_toamr    = strlen(nom);
-      if ( length_ligne_toamr > LONGNOM )
-      {
-         printf("WARNING 48 : The value of LONGNOM - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                       length_ligne_toamr +100);
-      }
-   }
-   if ( whichone == 49 && strlen(nom) > length_tmpligne_writedecl )
-   {
-      length_tmpligne_writedecl     = strlen(nom);
-      if ( length_tmpligne_writedecl > LONG_4C )
-      {
-         printf("WARNING 49 : The value of LONG_4C - define in decl.h -\n");
-         printf("             should be upgrated to %d\n",
-                                                 length_tmpligne_writedecl+100);
-      }
+      length_tmpligne_writedecl = len_nom;
+      if ( length_tmpligne_writedecl > LONG_M )
+           printf("WARNING 49 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_tmpligne_writedecl+100);
    }
 }
@@ -520,11 +154,7 @@
 void Save_Length_int(int val, int whichone)
 {
-   if ( whichone == 1 && val > value_char_size )
-                               value_char_size                            = val;
-   if ( whichone == 2 && val > value_char_size1 )
-                               value_char_size1                           = val;
-   if ( whichone == 3 && val > value_char_size2 )
-                               value_char_size2                           = val;
-   if ( whichone == 4 && val > value_char_size3 )
-                               value_char_size3                           = val;
+   if ( whichone == 1 && val > value_char_size )    value_char_size  = val;
+   if ( whichone == 2 && val > value_char_size1 )   value_char_size1 = val;
+   if ( whichone == 3 && val > value_char_size2 )   value_char_size2 = val;
+   if ( whichone == 4 && val > value_char_size3 )   value_char_size3 = val;
 }
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c	(revision 5682)
@@ -40,5 +40,5 @@
 
 /******************************************************************************/
-/*                          varisallocatable_0                                */
+/*                          variscoupled_0                                    */
 /******************************************************************************/
 /* Firstpass 0                                                                */
@@ -46,66 +46,60 @@
 /*                                                                            */
 /******************************************************************************/
-int variscoupled_0(char *ident)
+int variscoupled_0(const char *ident)
 {
-   listallocate *newvaralloc;
-  listvarpointtovar *pointtmplist; 
-  listcouple *coupletmp;   
-  int out;
-
-   out =0;
-   if (firstpass == 0 )
-   {
-  pointtmplist = List_CouplePointed_Var;
-  while ( pointtmplist && out == 0)
-  {
-      coupletmp = pointtmplist->t_couple;
-      while ( coupletmp && out == 0)
-      {
-           /* we should find the same variable name in the same subroutine    */
-           if ( !strcasecmp(ident,coupletmp->c_namevar) &&
-                !strcasecmp(subroutinename,
-                                       pointtmplist->t_cursubroutine) &&
-                 strcasecmp(coupletmp->c_namepointedvar,"")
-              )
-           {
-              out = 1;
-           }
-         coupletmp = coupletmp->suiv;
-     }
-     pointtmplist = pointtmplist->suiv;
-   }
-   }
-   return out;
+    listvarpointtovar *pointtmplist; 
+    listcouple *coupletmp;   
+    int out = 0;
+    
+    if (firstpass == 0 )
+    {
+        pointtmplist = List_CouplePointed_Var;
+        while ( pointtmplist && out == 0)
+        {
+            coupletmp = pointtmplist->t_couple;
+            while ( coupletmp && out == 0)
+            {
+                /* we should find the same variable name in the same subroutine    */
+                if ( !strcasecmp(ident, coupletmp->c_namevar) &&
+                     !strcasecmp(subroutinename, pointtmplist->t_cursubroutine) &&
+                      strcasecmp(coupletmp->c_namepointedvar, "") )
+                {
+                    out = 1;
+                }
+                coupletmp = coupletmp->suiv;
+            }
+            pointtmplist = pointtmplist->suiv;
+        }
+    }
+    return out;
 }
 
-char * getcoupledname_0(char *ident)
+const char * getcoupledname_0(const char *ident)
 {
-   listallocate *newvaralloc;
-  listvarpointtovar *pointtmplist; 
-  listcouple *coupletmp;   
-  int out;
-
-   out =0;
-   if (firstpass == 0 )
-   {
-  pointtmplist = List_CouplePointed_Var;
-  while ( pointtmplist && out == 0)
-  {
-      coupletmp = pointtmplist->t_couple;
-      while ( coupletmp && out == 0)
-      {
-           /* we should find the same variable name in the same subroutine    */
-           if ( !strcasecmp(ident,coupletmp->c_namevar) &&
-                !strcasecmp(subroutinename,
-                                       pointtmplist->t_cursubroutine) &&
-                 strcasecmp(coupletmp->c_namepointedvar,"")
-              )
-           {
-              return(coupletmp->c_namepointedvar);
-           }
-         coupletmp = coupletmp->suiv;
-     }
-     pointtmplist = pointtmplist->suiv;
-   }
-   }
+    listvarpointtovar *pointtmplist; 
+    listcouple *coupletmp;   
+    int out = 0;
+    
+    if (firstpass == 0 )
+    {
+        pointtmplist = List_CouplePointed_Var;
+        while ( pointtmplist && out == 0)
+        {
+            coupletmp = pointtmplist->t_couple;
+            while ( coupletmp && out == 0)
+            {
+                /* we should find the same variable name in the same subroutine    */
+                if ( !strcasecmp(coupletmp->c_namevar,ident) &&
+                     !strcasecmp(pointtmplist->t_cursubroutine,subroutinename) &&
+                      strcasecmp(coupletmp->c_namepointedvar,"") )
+                {
+                    return coupletmp->c_namepointedvar;
+                }
+                coupletmp = coupletmp->suiv;
+            }
+            pointtmplist = pointtmplist->suiv;
+        }
+    }
+    printf("end of getcoupledname_0 -- you should not be there !!! \n");
+    return NULL;
 }
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c	(revision 5682)
@@ -61,5 +61,4 @@
            List_ModuleUsed_Var = Readthedependfile
                                (tmplistmodule->u_usemodule,List_ModuleUsed_Var);
-         printf("PPPPPPPPPPPPPP\n");
            List_GlobParamModuleUsed_Var = ReaddependParameterList
                       (tmplistmodule->u_usemodule,List_GlobParamModuleUsed_Var);
@@ -76,55 +75,50 @@
 /******************************************************************************/
 /******************************************************************************/
-void  RecordUseModulesUseModulesVariables()
-{
-  listusemodule *tmplistmodule;
-  listusemodule *tmplistmodule1;
-
-  /* we should record all variables defined in modules used in this file      */
-  if ( List_NameOfModuleUsed )
-  {
-     /* and we should read the .depend of the module used by the module used  */
-     tmplistmodule = List_NameOfModuleUsed;
-     while ( tmplistmodule )
-     {
+void RecordUseModulesUseModulesVariables()
+{
+    listusemodule *tmplistmodule;
+    listusemodule *save_list;
+
+    if ( ! List_NameOfModuleUsed )  return;
+
+    /* we should record all variables defined in modules used in this file      */
+    /* and we should read the .depend of the module used by the module used  */
+    tmplistmodule = List_NameOfModuleUsed;
+    while ( tmplistmodule )
+    {
         Readthedependlistofmoduleused(tmplistmodule->u_usemodule);
         while( tmpuselocallist )
         {
-           Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
-           tmplistmodule1 = tmpuselocallist->suiv;
-           free(tmpuselocallist);
-           tmpuselocallist = tmplistmodule1;
+            Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
+            save_list = tmpuselocallist->suiv;
+            free(tmpuselocallist);
+            tmpuselocallist = save_list;
         }
         tmplistmodule = tmplistmodule->suiv;
-     }
-
-     tmplistmodule = listofmoduletmp;
-     while ( tmplistmodule )
-     {
+    }
+    tmplistmodule = listofmoduletmp;
+    while ( tmplistmodule )
+    {
         Readthedependlistofmoduleused(tmplistmodule->u_usemodule);
         while( tmpuselocallist )
         {
-           Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
-           tmplistmodule1 = tmpuselocallist->suiv;
-           free(tmpuselocallist);
-           tmpuselocallist = tmplistmodule1;
+            Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
+            save_list = tmpuselocallist->suiv;
+            free(tmpuselocallist);
+            tmpuselocallist = save_list;
         }
         tmplistmodule = tmplistmodule->suiv;
-     }
-
-
-
-     tmplistmodule = listofmoduletmp;
-     while ( tmplistmodule )
-     {
-        /* check if the file .depend<u_usemodule> exist                       */
-        List_ModuleUsedInModuleUsed_Var = Readthedependfile
-                   (tmplistmodule->u_usemodule,List_ModuleUsedInModuleUsed_Var);
-
-        List_GlobParamModuleUsedInModuleUsed_Var = ReaddependParameterList
-          (tmplistmodule->u_usemodule,List_GlobParamModuleUsedInModuleUsed_Var);
+    }
+    tmplistmodule = listofmoduletmp;
+    while ( tmplistmodule )
+    {
+        // check if the file .depend<u_usemodule> exists
+        List_ModuleUsedInModuleUsed_Var =
+            Readthedependfile(tmplistmodule->u_usemodule,List_ModuleUsedInModuleUsed_Var);
+
+        List_GlobParamModuleUsedInModuleUsed_Var =
+            ReaddependParameterList(tmplistmodule->u_usemodule,List_GlobParamModuleUsedInModuleUsed_Var);
         tmplistmodule = tmplistmodule->suiv;
-     }
-  }
+    }
 }
 
@@ -147,60 +141,52 @@
 void Add_NameOfModuleUsed_1(char *name)
 {
-  listusemodule *newmodule;
-  listusemodule *parcours;
-  int out;
-
-  if ( firstpass == 1 )
-  {
-     newmodule =(listusemodule *)malloc(sizeof(listusemodule));
-     strcpy(newmodule->u_usemodule,name);
-     Save_Length(name,16);
-     strcpy(newmodule->u_charusemodule,charusemodule);
-     Save_Length(charusemodule,17);
-     strcpy(newmodule->u_modulename,curmodulename);
-     Save_Length(curmodulename,19);
-     strcpy(newmodule->u_cursubroutine,subroutinename);
-     Save_Length(subroutinename,18);
-     newmodule->u_firstuse = 1 ;
-     newmodule->suiv = NULL;
-
-     if ( !List_NameOfModuleUsed)
-     {
-         List_NameOfModuleUsed = newmodule ;
-     }
-     else
-     {
-    parcours = List_NameOfModuleUsed;
-    while ( parcours && newmodule->u_firstuse == 1 )
-    {
-       if ( !strcasecmp(name,parcours->u_usemodule) )
-       {
-          newmodule->u_firstuse = 0 ;
-       }
-       parcours=parcours->suiv;
-    }
-    /* we can not add the same module twice for the same subroutine           */
-    parcours = List_NameOfModuleUsed;
-    out = 0 ;
-    while ( parcours && out == 0 )
-    {
-       if ( !strcasecmp(name,parcours->u_usemodule) &&
-            !strcasecmp(subroutinename,parcours->u_cursubroutine)
-           )
-       {
-          out = 1 ;
-          free(newmodule);
-       }
-       else parcours=parcours->suiv;
-    }
-    if ( out == 0 )
-    {
-       newmodule->suiv = List_NameOfModuleUsed;
-       List_NameOfModuleUsed = newmodule;
-    }
-  }
-  }
-}
-
+    listusemodule *newmodule;
+    listusemodule *parcours;
+    int out;
+
+    newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
+    strcpy(newmodule->u_usemodule, name);
+    strcpy(newmodule->u_charusemodule, charusemodule);
+    strcpy(newmodule->u_modulename, curmodulename);
+    strcpy(newmodule->u_cursubroutine, subroutinename);
+    newmodule->u_firstuse = 1 ;
+    newmodule->suiv = NULL;
+
+    if ( List_NameOfModuleUsed == NULL )
+    {
+        List_NameOfModuleUsed = newmodule ;
+    }
+    else
+    {
+        parcours = List_NameOfModuleUsed;
+        while ( parcours && newmodule->u_firstuse )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) )
+            {
+                newmodule->u_firstuse = 0 ;
+            }
+            parcours = parcours->suiv;
+        }
+        /* we can not add the same module twice for the same subroutine           */
+        parcours = List_NameOfModuleUsed;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) &&
+                 !strcasecmp(subroutinename,parcours->u_cursubroutine) )
+            {
+                out = 1 ;
+                free(newmodule);
+            }
+            else
+                parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newmodule->suiv = List_NameOfModuleUsed;
+            List_NameOfModuleUsed = newmodule;
+        }
+    }
+}
 
 /******************************************************************************/
@@ -220,55 +206,52 @@
 /*                                                                            */
 /******************************************************************************/
-void Addmoduletothelist(char *name)
-{
-  listusemodule *newmodule;
-  listusemodule *parcours;
-  int out;
-
-     newmodule =(listusemodule *)malloc(sizeof(listusemodule));
-     strcpy(newmodule->u_usemodule,name);
-     Save_Length(name,16);
-     strcpy(newmodule->u_charusemodule,charusemodule);
-     Save_Length(charusemodule,17);
-     strcpy(newmodule->u_cursubroutine,subroutinename);
-     Save_Length(subroutinename,18);
-     newmodule->u_firstuse = 1 ;
-     newmodule->suiv = NULL;
-
-     if ( !List_NameOfModuleUsed)
-     {
-         List_NameOfModuleUsed = newmodule ;
-     }
-     else
-     {
-    parcours = List_NameOfModuleUsed;
-    while ( parcours && newmodule->u_firstuse == 1 )
-    {
-       if ( !strcasecmp(name,parcours->u_usemodule) )
-       {
-          newmodule->u_firstuse = 0 ;
-       }
-       parcours=parcours->suiv;
-    }
-    /* we can not add the same module twice for the same subroutine           */
-    parcours = List_NameOfModuleUsed;
-    out = 0 ;
-    while ( parcours && out == 0 )
-    {
-       if ( !strcasecmp(name,parcours->u_usemodule) &&
-            !strcasecmp(subroutinename,parcours->u_cursubroutine)
-           )
-       {
-          out = 1 ;
-          free(newmodule);
-       }
-       else parcours=parcours->suiv;
-    }
-    if ( out == 0 )
-    {
-       newmodule->suiv = List_NameOfModuleUsed;
-       List_NameOfModuleUsed = newmodule;
-    }
-  }
+void Addmoduletothelist(const char *name)
+{
+    listusemodule *newmodule;
+    listusemodule *parcours;
+    int out;
+
+    newmodule = (listusemodule*) calloc(1,sizeof(listusemodule));
+    strcpy(newmodule->u_usemodule, name);
+    strcpy(newmodule->u_charusemodule, charusemodule);
+    strcpy(newmodule->u_cursubroutine, subroutinename);
+    newmodule->u_firstuse = 1 ;
+    newmodule->suiv = NULL;
+
+    if ( !List_NameOfModuleUsed )
+    {
+        List_NameOfModuleUsed = newmodule ;
+    }
+    else
+    {
+        parcours = List_NameOfModuleUsed;
+        while ( parcours && newmodule->u_firstuse == 1 )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) )
+            {
+                newmodule->u_firstuse = 0 ;
+            }
+            parcours=parcours->suiv;
+        }
+        /* we can not add the same module twice for the same subroutine           */
+        parcours = List_NameOfModuleUsed;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) &&
+                 !strcasecmp(subroutinename,parcours->u_cursubroutine) )
+            {
+                out = 1 ;
+                free(newmodule);
+            }
+            else
+                parcours=parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newmodule->suiv = List_NameOfModuleUsed;
+            List_NameOfModuleUsed = newmodule;
+        }
+    }
 }
 
@@ -281,23 +264,40 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteUsemoduleDeclaration(char *cursubroutinename)
-{
-  listusemodule *newmodule;
-  
-
-  newmodule = List_NameOfModuleUsed;
-  fprintf(fortranout,"\n");
-
-  while ( newmodule )
-  {
-     if ( !strcasecmp(newmodule->u_cursubroutine,cursubroutinename) )
-     {
-     if (strcmp(newmodule->u_charusemodule,""))
-     {
-             fprintf(fortranout,"      USE %s \n"
-                                                   ,newmodule->u_charusemodule);
-     }
-     }
+void WriteUsemoduleDeclaration(const char *cursubroutinename)
+{
+    listusemodule     *newmodule;
+    listvarpointtovar *pointtmp;
+    long int          fictifpos;
+    int               findcoupled;
+
+    fprintf(fortran_out,"\n");
+    newmodule = List_NameOfModuleUsed;
+
+    while ( newmodule )
+    {
+        if ( !strcasecmp(newmodule->u_cursubroutine, cursubroutinename) )
+        {
+            if (strcmp(newmodule->u_charusemodule,""))
+            {
+/*
+                findcoupled = 0;
+                pointtmp = List_CouplePointed_Var;
+                while(pointtmp)
+                {
+                    if ((!strcasecmp(pointtmp->t_usemodule, newmodule->u_charusemodule)) && \
+                        (!strcasecmp(pointtmp->t_cursubroutine, cursubroutinename)))
+                    {
+                        fictifpos = setposcur();
+                        variableisglobalinmodule(pointtmp->t_couple,newmodule->u_charusemodule,fortran_out,fictifpos);
+                        findcoupled = 1;
+                    }
+                    pointtmp=pointtmp->suiv;
+                }
+                if (findcoupled == 0)   fprintf(fortran_out,"      use %s\n",newmodule->u_charusemodule);
+*/
+                fprintf(fortran_out,"      use %s\n", newmodule->u_charusemodule);
+            }
+        }
         newmodule = newmodule ->suiv;
-  }
-}
+    }
+}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c	(revision 5682)
@@ -34,6 +34,6 @@
 /******************************************************************************/
 #include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
+//#include <stdlib.h>
+//#include <string.h>
 
 #include "decl.h"
@@ -47,5 +47,5 @@
 /*                                                                            */
 /******************************************************************************/
-void Add_UsedInSubroutine_Var_1 (char *ident)
+void Add_UsedInSubroutine_Var_1 (const char *ident)
 {
   listvar *newvar;
@@ -59,6 +59,6 @@
   if ( !List_UsedInSubroutine_Var )
   {
-      newvar=(listvar *)malloc(sizeof(listvar));
-      newvar->var=(variable *)malloc(sizeof(variable));
+      newvar=(listvar *)calloc(1,sizeof(listvar));
+      newvar->var=(variable *)calloc(1,sizeof(variable));
       /*                                                                      */
       Init_Variable(newvar->var);
@@ -66,17 +66,9 @@
       newvar->suiv = NULL;
       strcpy(newvar->var->v_nomvar,ident);
-
-      Save_Length(ident,4);
       strcpy(newvar->var->v_modulename,curmodulename);
-      Save_Length(curmodulename,6);
-     printf("ICI %d\n",newvar->var->v_module);
-
-      strcpy(newvar->var->v_commoninfile,mainfile);
-      Save_Length(mainfile,10);
+      strcpy(newvar->var->v_commoninfile,cur_filename);
       strcpy(newvar->var->v_subroutinename,subroutinename);
-      Save_Length(subroutinename,11);
       newvar->var->v_pointedvar=pointedvar;
       List_UsedInSubroutine_Var = newvar ;
-       printf("jaoute %s\n",newvar->var->v_nomvar);
   }
   else
@@ -94,23 +86,16 @@
       if ( out == 0 )
       {
-         newvar=(listvar *)malloc(sizeof(listvar));
-         newvar->var=(variable *)malloc(sizeof(variable));
+         newvar=(listvar *)calloc(1,sizeof(listvar));
+         newvar->var=(variable *)calloc(1,sizeof(variable));
          /*                                                                   */
          Init_Variable(newvar->var);
          /*                                                                   */
          strcpy(newvar->var->v_nomvar,ident);
-
-         Save_Length(ident,4);
-         strcpy(newvar->var->v_commoninfile,mainfile);
-         Save_Length(mainfile,10);
+         strcpy(newvar->var->v_commoninfile,cur_filename);
          strcpy(newvar->var->v_modulename,curmodulename);
-         Save_Length(curmodulename,6);
-       printf("ICI %d\n",newvar->var->v_module);
          strcpy(newvar->var->v_subroutinename,subroutinename);
-         Save_Length(subroutinename,11);
          newvar->var->v_pointedvar=pointedvar;
          newvar->suiv = List_UsedInSubroutine_Var;
-         printf("jaoute %s\n",newvar->var->v_nomvar);
-         List_UsedInSubroutine_Var = newvar;        
+         List_UsedInSubroutine_Var = newvar;
       }
   }
@@ -134,6 +119,6 @@
   if ( !List_UsedInSubroutine_Var )
   {
-      newvar=(listvar *)malloc(sizeof(listvar));
-      newvar->var=(variable *)malloc(sizeof(variable));
+      newvar=(listvar *)calloc(1,sizeof(listvar));
+      newvar->var=(variable *)calloc(1,sizeof(variable));
       /*                                                                      */
       Init_Variable(newvar->var);
@@ -141,12 +126,7 @@
       newvar->suiv = NULL;
       strcpy(newvar->var->v_nomvar,name);
-
-      Save_Length(name,4);
       strcpy(newvar->var->v_modulename,curmodulename);
-      Save_Length(curmodulename,6);
-      strcpy(newvar->var->v_commoninfile,mainfile);
-      Save_Length(mainfile,10);
+      strcpy(newvar->var->v_commoninfile,cur_filename);
       strcpy(newvar->var->v_subroutinename,subroutinename);
-      Save_Length(subroutinename,11);
       newvar->var->v_pointedvar=pointedvar;
       List_UsedInSubroutine_Var = newvar ;
@@ -183,18 +163,13 @@
       if ( out == 2 || out == 0 )
       {
-         newvar=(listvar *)malloc(sizeof(listvar));
-         newvar->var=(variable *)malloc(sizeof(variable));
+         newvar=(listvar *)calloc(1,sizeof(listvar));
+         newvar->var=(variable *)calloc(1,sizeof(variable));
          /*                                                                   */
          Init_Variable(newvar->var);
          /*                                                                   */
          strcpy(newvar->var->v_nomvar,name);
-
-         Save_Length(name,4);
          strcpy(newvar->var->v_modulename,curmodulename);
-         Save_Length(curmodulename,6);
-         strcpy(newvar->var->v_commoninfile,mainfile);
-         Save_Length(mainfile,10);
+         strcpy(newvar->var->v_commoninfile,cur_filename);
          strcpy(newvar->var->v_subroutinename,subroutinename);
-         Save_Length(subroutinename,11);
          newvar->var->v_pointedvar=pointedvar;
 
@@ -254,163 +229,172 @@
 void  CompleteThelistvarindoloop()
 {
-  listvar *newvar;
-  listvarpointtovar *pointtmplist;
-  listcouple *coupletmp;
-  int outvar;
-
-  pointtmplist = List_CouplePointed_Var;
-  while ( pointtmplist )
-  {
-      coupletmp = pointtmplist->t_couple;
-      while ( coupletmp )
-      {
-         newvar = List_UsedInSubroutine_Var;
-         outvar = 0 ;
-         while ( newvar && outvar == 0)
-         {
-           /* we should find the same variable name in the same subroutine    */
-           if ( !strcasecmp(newvar->var->v_nomvar,coupletmp->c_namevar) &&
-                !strcasecmp(newvar->var->v_subroutinename,
-                                       pointtmplist->t_cursubroutine) &&
-                 strcasecmp(coupletmp->c_namepointedvar,"")
-              )
-           {
-              outvar = 1;
-              strcpy(newvar->var->v_oldname,newvar->var->v_nomvar);
-              strcpy(newvar->var->v_nomvar,coupletmp->c_namepointedvar);
-           }
-           else
-           {
-              newvar = newvar->suiv;
-           }
-         }
-         coupletmp = coupletmp->suiv;
-     }
-     pointtmplist = pointtmplist->suiv;
-  }
-}
-
-/******************************************************************************/
-/*                             CopyRecord                                     */
+    listvar *newvar;
+    listvarpointtovar *pointtmplist;
+    listcouple *coupletmp;
+    int outvar;
+
+    pointtmplist = List_CouplePointed_Var;
+    while ( pointtmplist )
+    {
+        coupletmp = pointtmplist->t_couple;
+        while ( coupletmp )
+        {
+            newvar = List_UsedInSubroutine_Var;
+            outvar = 0 ;
+            while ( newvar && outvar == 0)
+            {
+                /* we should find the same variable name in the same subroutine    */
+                if ( !strcasecmp(newvar->var->v_nomvar, coupletmp->c_namevar) &&
+                     !strcasecmp(newvar->var->v_subroutinename, pointtmplist->t_cursubroutine) &&
+                      strcasecmp(coupletmp->c_namepointedvar, "") )
+                {
+                    outvar = 1;
+                    strcpy(newvar->var->v_oldname, newvar->var->v_nomvar);
+                    strcpy(newvar->var->v_nomvar, coupletmp->c_namepointedvar);
+                }
+                else
+                {
+                    newvar = newvar->suiv;
+                }
+            }
+            coupletmp = coupletmp->suiv;
+        }
+        pointtmplist = pointtmplist->suiv;
+    }
+}
+
+/******************************************************************************/
+/*                             Merge_Variables                                */
 /******************************************************************************/
 /*                                                                            */
 /******************************************************************************/
-void CopyRecord(variable *var1,variable *var2)
-{
-   if ( !strcasecmp(var1->v_typevar,"") )
-                                        strcpy(var1->v_typevar,var2->v_typevar);
-   else strcpy(var2->v_typevar,var1->v_typevar);
-
-   if ( !strcasecmp(var1->v_oldname,"") )
-                                        strcpy(var1->v_oldname,var2->v_oldname);
-   else strcpy(var2->v_oldname,var1->v_oldname);
-
-   if ( !strcasecmp(var1->v_dimchar,"") )
-                                        strcpy(var1->v_dimchar,var2->v_dimchar);
-   else strcpy(var2->v_dimchar,var1->v_dimchar);
-
-   if ( !strcasecmp(var1->v_commonname,"") )
-                                  strcpy(var1->v_commonname,var2->v_commonname);
-   else strcpy(var2->v_commonname,var1->v_commonname);
-   
-   printf("modulenameII = %s %s %d %s\n",var1->v_modulename,var2->v_modulename,var1->v_module,var1->v_nomvar);
-
-   if ( !strcasecmp(var1->v_modulename,"") || (var1->v_module ==0))
-                                  strcpy(var1->v_modulename,var2->v_modulename);
-   else strcpy(var2->v_modulename,var1->v_modulename);
-
-   if ( !strcasecmp(var1->v_vallengspec,"") )
-                                strcpy(var1->v_vallengspec,var2->v_vallengspec);
-   else strcpy(var2->v_vallengspec,var1->v_vallengspec);
-
-   if ( !strcasecmp(var1->v_nameinttypename,"") )
-                        strcpy(var1->v_nameinttypename,var2->v_nameinttypename);
-   else strcpy(var2->v_nameinttypename,var1->v_nameinttypename);
-          
-   if ( !strcasecmp(var1->v_commoninfile,"") )
-                              strcpy(var1->v_commoninfile,var2->v_commoninfile);
-   else strcpy(var2->v_commoninfile,var1->v_commoninfile);
-
-   if ( !strcasecmp(var1->v_precision,"") )
-                                    strcpy(var1->v_precision,var2->v_precision);
-   else strcpy(var2->v_precision,var1->v_precision);
-
-   if ( !strcasecmp(var1->v_initialvalue,"") )
-                              strcpy(var1->v_initialvalue,var2->v_initialvalue);
-   else strcpy(var2->v_initialvalue,var1->v_initialvalue);
-
-   if ( !strcasecmp(var1->v_IntentSpec,"") )
-                                  strcpy(var1->v_IntentSpec,var2->v_IntentSpec);
-   else strcpy(var2->v_IntentSpec,var1->v_IntentSpec);
-
-   if ( !strcasecmp(var1->v_readedlistdimension,"") )
-                strcpy(var1->v_readedlistdimension,var2->v_readedlistdimension);
-   else strcpy(var2->v_readedlistdimension,var1->v_readedlistdimension);
-
-   if ( var1->v_dimension ) var2->v_dimension = var1->v_dimension ;
-   else var1->v_dimension = var2->v_dimension ;
-
-   if ( var1->v_nbdim == 0 ) var1->v_nbdim = var2->v_nbdim ;
-   else var2->v_nbdim = var1->v_nbdim ;
-
-   if ( var1->v_common == 0 ) var1->v_common = var2->v_common ;
-   else var2->v_common = var1->v_common ;
-
-   if ( var1->v_positioninblock == 0 ) var1->v_positioninblock =
-                                                       var2->v_positioninblock ;
-   else var2->v_positioninblock = var1->v_positioninblock ;
-
-   if ( var1->v_module == 0 ) var1->v_module = var2->v_module ;
-   else var2->v_module = var1->v_module ;
-
-   if ( var1->v_save == 0 ) var1->v_save = var2->v_save ;
-   else var2->v_save = var1->v_save ;
-   
-   if ( var1->v_VariableIsParameter == 0 )
-                     var1->v_VariableIsParameter = var2->v_VariableIsParameter ;
-                    
-   else var2->v_VariableIsParameter = var1->v_VariableIsParameter ;
-   if ( var1->v_indicetabvars == 0 )
-   {
-   
-                                 var1->v_indicetabvars = var2->v_indicetabvars ;
-       printf("HERHEHR %s mm %s mm %d\n",var1->v_nomvar,var2->v_modulename,var2->v_indicetabvars);
-                                 }
-   else var2->v_indicetabvars = var1->v_indicetabvars ;
-
-   if ( var1->v_ExternalDeclare == 0 )
-                             var1->v_ExternalDeclare = var2->v_ExternalDeclare ;
-   else var2->v_ExternalDeclare = var1->v_ExternalDeclare ;
-
-   if ( var1->v_pointedvar == 0 ) var1->v_pointedvar = var2->v_pointedvar ;
-   else var2->v_pointedvar = var1->v_pointedvar ;
-
-   if ( var1->v_dimensiongiven == 0 )
-                                var1->v_dimensiongiven = var2->v_dimensiongiven;
-   else var2->v_dimensiongiven = var1->v_dimensiongiven ;
-
-   if ( var1->v_c_star == 0 ) var1->v_c_star = var2->v_c_star;
-   else var2->v_c_star = var1->v_c_star ;
-
-   if ( var1->v_pointerdeclare == 0 )
-                               var1->v_pointerdeclare = var2->v_pointerdeclare ;
-   else var2->v_pointerdeclare = var1->v_pointerdeclare ;
-
-
-   if ( var1->v_notgrid == 0 ) var1->v_notgrid = var2->v_notgrid ;
-   else var2->v_notgrid = var1->v_notgrid;
-
-   if ( var1->v_optionaldeclare == 0 )
-                              var1->v_optionaldeclare = var2->v_optionaldeclare;
-   else var2->v_optionaldeclare = var1->v_optionaldeclare ;
-
-   if ( var1->v_allocatable == 0 ) var1->v_allocatable = var2->v_allocatable ;
-   else var2->v_allocatable = var1->v_allocatable ;
-   
-   if ( var1->v_target == 0 ) var1->v_target = var2->v_target ;
-   else var2->v_target = var1->v_target ;
-
-   if ( var1->v_dimsempty == 0 ) var1->v_dimsempty = var2->v_dimsempty ;
-   else var2->v_dimsempty = var1->v_dimsempty ;
+void Merge_Variables(variable *var1, variable *var2)
+{
+    if ( !strcasecmp(var1->v_typevar,"") )
+            strcpy(var1->v_typevar,var2->v_typevar);
+    else
+      {
+      strcpy(var2->v_typevar,var1->v_typevar);
+      }
+
+    if ( !strcasecmp(var1->v_oldname,"") )
+            strcpy(var1->v_oldname,var2->v_oldname);
+    else    strcpy(var2->v_oldname,var1->v_oldname);
+
+    if ( !strcasecmp(var1->v_dimchar,"") )
+            strcpy(var1->v_dimchar,var2->v_dimchar);
+    else    strcpy(var2->v_dimchar,var1->v_dimchar);
+
+    if ( !strcasecmp(var1->v_commonname,"") )
+            strcpy(var1->v_commonname,var2->v_commonname);
+    else    strcpy(var2->v_commonname,var1->v_commonname);
+
+    if ( !strcasecmp(var1->v_modulename,"") || (var1->v_module ==0))
+            strcpy(var1->v_modulename,var2->v_modulename);
+    else    strcpy(var2->v_modulename,var1->v_modulename);
+
+    if ( !strcasecmp(var1->v_vallengspec,"") )
+            strcpy(var1->v_vallengspec,var2->v_vallengspec);
+    else    strcpy(var2->v_vallengspec,var1->v_vallengspec);
+
+    if ( !strcasecmp(var1->v_nameinttypename,"") )
+            strcpy(var1->v_nameinttypename,var2->v_nameinttypename);
+    else    strcpy(var2->v_nameinttypename,var1->v_nameinttypename);
+
+    if ( !strcasecmp(var1->v_commoninfile,"") )
+            strcpy(var1->v_commoninfile,var2->v_commoninfile);
+    else    strcpy(var2->v_commoninfile,var1->v_commoninfile);
+
+    if ( !strcasecmp(var1->v_precision,"") )
+            strcpy(var1->v_precision,var2->v_precision);
+    else    strcpy(var2->v_precision,var1->v_precision);
+
+    if ( !strcasecmp(var1->v_initialvalue,"") )
+            strcpy(var1->v_initialvalue,var2->v_initialvalue);
+    else    strcpy(var2->v_initialvalue,var1->v_initialvalue);
+
+    if ( !strcasecmp(var1->v_IntentSpec,"") )
+            strcpy(var1->v_IntentSpec,var2->v_IntentSpec);
+    else    strcpy(var2->v_IntentSpec,var1->v_IntentSpec);
+
+    if ( !strcasecmp(var1->v_readedlistdimension,"") )
+            strcpy(var1->v_readedlistdimension,var2->v_readedlistdimension);
+    else    strcpy(var2->v_readedlistdimension,var1->v_readedlistdimension);
+
+    if ( var1->v_dimension )
+            var2->v_dimension = var1->v_dimension ;
+    else    var1->v_dimension = var2->v_dimension ;
+
+    if ( var1->v_nbdim == 0 )
+            var1->v_nbdim = var2->v_nbdim ;
+    else    var2->v_nbdim = var1->v_nbdim ;
+
+    if ( var1->v_common == 0 )
+            var1->v_common = var2->v_common ;
+    else    var2->v_common = var1->v_common ;
+
+    if ( var1->v_positioninblock == 0 )
+            var1->v_positioninblock = var2->v_positioninblock ;
+    else    var2->v_positioninblock = var1->v_positioninblock ;
+
+    if ( var1->v_module == 0 )
+            var1->v_module = var2->v_module ;
+    else    var2->v_module = var1->v_module ;
+
+    if ( var1->v_save == 0 )
+            var1->v_save = var2->v_save ;
+    else    var2->v_save = var1->v_save ;
+
+    if ( var1->v_VariableIsParameter == 0 )
+            var1->v_VariableIsParameter = var2->v_VariableIsParameter ;
+    else    var2->v_VariableIsParameter = var1->v_VariableIsParameter ;
+
+    if ( var1->v_indicetabvars == 0 )
+            var1->v_indicetabvars = var2->v_indicetabvars ;
+    else    var2->v_indicetabvars = var1->v_indicetabvars ;
+
+    if ( var1->v_ExternalDeclare == 0 )
+            var1->v_ExternalDeclare = var2->v_ExternalDeclare ;
+    else    var2->v_ExternalDeclare = var1->v_ExternalDeclare ;
+
+    if ( var1->v_pointedvar == 0 )
+            var1->v_pointedvar = var2->v_pointedvar ;
+    else    var2->v_pointedvar = var1->v_pointedvar ;
+
+    if ( var1->v_dimensiongiven == 0 )
+            var1->v_dimensiongiven = var2->v_dimensiongiven;
+    else    var2->v_dimensiongiven = var1->v_dimensiongiven ;
+
+    if ( var1->v_c_star == 0 )
+            var1->v_c_star = var2->v_c_star;
+    else    var2->v_c_star = var1->v_c_star ;
+
+    if ( var1->v_catvar == 0 )
+            var1->v_catvar = var2->v_catvar;
+    else    var2->v_catvar = var1->v_catvar ;
+
+    if ( var1->v_pointerdeclare == 0 )
+            var1->v_pointerdeclare = var2->v_pointerdeclare ;
+    else    var2->v_pointerdeclare = var1->v_pointerdeclare ;
+
+    if ( var1->v_notgrid == 0 )
+            var1->v_notgrid = var2->v_notgrid ;
+    else    var2->v_notgrid = var1->v_notgrid;
+
+    if ( var1->v_optionaldeclare == 0 )
+            var1->v_optionaldeclare = var2->v_optionaldeclare;
+    else    var2->v_optionaldeclare = var1->v_optionaldeclare ;
+
+    if ( var1->v_allocatable == 0 )
+            var1->v_allocatable = var2->v_allocatable ;
+    else    var2->v_allocatable = var1->v_allocatable ;
+
+    if ( var1->v_target == 0 )
+            var1->v_target = var2->v_target ;
+    else    var2->v_target = var1->v_target ;
+
+    if ( var1->v_dimsempty == 0 )
+            var1->v_dimsempty = var2->v_dimsempty ;
+    else    var2->v_dimsempty = var1->v_dimsempty ;
 }
 
@@ -437,10 +421,7 @@
       while ( parcours1 && out == 0 )
       {
-         if ( !strcasecmp(parcours->var->v_nomvar,
-                          parcours1->var->v_nomvar)         &&
-              !strcasecmp(parcours->var->v_subroutinename,
-                          parcours1->var->v_subroutinename) &&
-              !strcasecmp(parcours->var->v_modulename,
-                          parcours1->var->v_modulename)
+         if ( !strcasecmp(parcours->var->v_nomvar,         parcours1->var->v_nomvar)         &&
+              !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+              !strcasecmp(parcours->var->v_modulename,     parcours1->var->v_modulename)
             ) out = 1;
          else parcours1 = parcours1->suiv;
@@ -448,6 +429,6 @@
       /* if variable has been found                                           */
 
-      if ( out == 1 ) CopyRecord(parcours->var,parcours1->var);
-      
+      if ( out == 1 ) Merge_Variables(parcours->var,parcours1->var);
+
       /* looking in List_Dimension_Var                                        */
       if (out == 0 )
@@ -471,8 +452,8 @@
         }
         /* if variable has been found                                         */
-        
+
         if ( out == 1 )
         {
-           CopyRecord(parcours->var,parcours1->var);
+           Merge_Variables(parcours->var,parcours1->var);
            /* we should remove this record from the List_Dimension_Var        */
            if ( parcours1 == List_Dimension_Var )
@@ -495,5 +476,5 @@
    listvar *parcours;
    listvar *newvar;
-   char ligne[LONG_C];
+   char tmpname[LONG_VNAME];
 
    parcours = List_Save_Var;
@@ -503,18 +484,17 @@
       /* Save in subroutine which is not defined in a module                  */
       {
-         newvar = (listvar *)malloc(sizeof(listvar));
-         newvar->var = (variable *)malloc(sizeof(variable));
+         newvar = (listvar *)calloc(1,sizeof(listvar));
+         newvar->var = (variable *)calloc(1,sizeof(variable));
          /*                                                                   */
          Init_Variable(newvar->var);
          /*                                                                   */
          newvar->suiv = NULL;
-         CopyRecord(parcours->var,newvar->var);
+         Merge_Variables(parcours->var,newvar->var);
          strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename);
          strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
-
-         sprintf(ligne,"save_%s",parcours->var->v_subroutinename);
-         Add_NameOfCommon_1(ligne,parcours->var->v_subroutinename);
-         strcpy(newvar->var->v_commonname,ligne);
-         Save_Length(ligne,7);
+         newvar->var->v_catvar=parcours->var->v_catvar;
+         sprintf(tmpname,"save_%s",parcours->var->v_subroutinename);
+         Add_NameOfCommon_1(tmpname,parcours->var->v_subroutinename);
+         strcpy(newvar->var->v_commonname,tmpname);
          List_Common_Var = AddListvarToListvar(newvar,List_Common_Var,1);
       }
@@ -522,6 +502,6 @@
       /* Save in subroutine which is defined in a module                      */
       {
-         newvar = (listvar *)malloc(sizeof(listvar));
-         newvar->var = (variable *)malloc(sizeof(variable));
+         newvar = (listvar *)calloc(1,sizeof(listvar));
+         newvar->var = (variable *)calloc(1,sizeof(variable));
          /*                                                                   */
          Init_Variable(newvar->var);
@@ -529,9 +509,10 @@
          newvar->suiv = NULL;
 
-         CopyRecord(parcours->var,newvar->var);
+         Merge_Variables(parcours->var,newvar->var);
          strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename);
 
          strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
 
+         newvar->var->v_catvar=parcours->var->v_catvar;
          strcpy(newvar->var->v_modulename,parcours->var->v_modulename);
          List_Global_Var = AddListvarToListvar(newvar,List_Global_Var,1);
@@ -560,11 +541,9 @@
       {
 
-         if ( !strcasecmp(parcours->var->v_nomvar,
-                          parcours1->var->v_nomvar)         &&
-              !strcasecmp(parcours->var->v_subroutinename,
-                          parcours1->var->v_subroutinename)
-            ) {
-            out = 1;     
-            }
+         if ( !strcasecmp(parcours->var->v_nomvar,         parcours1->var->v_nomvar) &&
+              !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) )
+         {
+            out = 1;
+         }
          else parcours1 = parcours1->suiv;
       }
@@ -573,6 +552,6 @@
       {
          strcpy(parcours->var->v_commoninfile,parcours1->var->v_commoninfile);
-             
-         CopyRecord(parcours->var,parcours1->var);
+
+         Merge_Variables(parcours->var,parcours1->var);
       }
       parcours = parcours->suiv;
@@ -587,103 +566,77 @@
 void Update_List_Var(listvar *list_to_modify)
 {
-   listvar *parcours;
-   listvar *parcours1;
-   int out;
-   int out2;
-   
-   parcours = list_to_modify;
-
-   while( parcours )
-   {
-     printf("LE NOM EST %s\n",parcours->var->v_nomvar);
-      /* looking in List_Global_Var                                           */
-      
-      out = 0;
-      
-//       if (list_to_modify != List_SubroutineDeclaration_Var && list_to_modify != List_UsedInSubroutine_Var) {
-//       parcours1 = List_Global_Var;
-//       while ( parcours1 && out == 0 )
-//       {
-//          if ( !strcasecmp(parcours->var->v_nomvar,
-//                           parcours1->var->v_nomvar)         &&
-//               !strcasecmp(parcours->var->v_modulename,
-//                           parcours1->var->v_modulename)
-//             ) out = 1;
-//          else parcours1 = parcours1->suiv;
-//       }
-//       }
-      
-  //    if (list_to_modify == List_UsedInSubroutine_Var) {
-      parcours1 = List_Global_Var;
-      while ( parcours1 && out == 0 )
-      {
-      printf("lenombis est %s\n",parcours1->var->v_nomvar);
-         if ( !strcasecmp(parcours->var->v_nomvar,
-                          parcours1->var->v_nomvar)         &&
-                 !strcasecmp(parcours->var->v_subroutinename,
-                             parcours1->var->v_subroutinename) &&
-              !strcasecmp(parcours->var->v_modulename,
-                          parcours1->var->v_modulename)
-            ) {
-            out = 1;
+    listvar *parcours;
+    listvar *parcours1;
+    int out;
+
+    parcours = list_to_modify;
+
+    while( parcours )
+    {
+        /*printf("LE NOM EST %s\n",parcours->var->v_nomvar);*/
+        /* looking in List_Global_Var                                           */
+        out = 0;
+        parcours1 = List_Global_Var;
+
+        while ( parcours1 && out == 0 )
+        {
+            if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)         &&
+                 !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+                 !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
+            {
+                out = 1;
             }
-         else parcours1 = parcours1->suiv;
-      }
-//      }      
-
-      /* if variable has been found                                           */
-      if ( out == 1 ) {
-      CopyRecord(parcours->var,parcours1->var);
-      }
-      /* looking in List_SubroutineDeclaration_Var                            */
-      else
-      {
-         parcours1 = List_SubroutineDeclaration_Var ;
-         out = 0;
-         while ( parcours1)
-         {
-            if ( !strcasecmp(parcours->var->v_nomvar,
-                             parcours1->var->v_nomvar)         &&
-                 !strcasecmp(parcours->var->v_subroutinename,
-                             parcours1->var->v_subroutinename) &&
-                 !strcasecmp(parcours->var->v_modulename,
-                             parcours1->var->v_modulename)
-               ) {
-
-               out = 1;
-               break;
-               }
             else parcours1 = parcours1->suiv;
-         }
-             
-         /* if variable has been found                                        */
-         if ( out == 1 ) {
-         CopyRecord(parcours->var,parcours1->var);
-        
-         }
-         else
-         {
-            parcours1 = List_Common_Var ;
+        }
+
+        /* if variable has been found                                           */
+        if ( out == 1 )
+        {
+            Merge_Variables(parcours->var,parcours1->var);
+        }
+        /* looking in List_SubroutineDeclaration_Var                            */
+        else
+        {
+            parcours1 = List_SubroutineDeclaration_Var ;
             out = 0;
-            while ( parcours1 && out == 0 )
+            while ( parcours1 )
             {
-               if ( !strcasecmp(parcours->var->v_nomvar,
-                                parcours1->var->v_nomvar)         &&
-                    !strcasecmp(parcours->var->v_subroutinename,
-                                parcours1->var->v_subroutinename) &&
-                    !strcasecmp(parcours->var->v_modulename,
-                                parcours1->var->v_modulename)
-                  ) out = 1;
-               else parcours1 = parcours1->suiv;
+                if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)                 &&
+                     !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+                     !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
+                {
+                    out = 1;
+                    break;
+                }
+                else parcours1 = parcours1->suiv;
             }
-            /* if variable has been found                                     */
-            if ( out == 1 ) {
-            CopyRecord(parcours->var,parcours1->var);       
-         }
-      }
-      }
-      parcours = parcours->suiv;
-   }
-   
+            /* if variable has been found                                        */
+            if ( out == 1 )
+            {
+                Merge_Variables(parcours->var,parcours1->var);
+            }
+            else
+            {
+                parcours1 = List_Common_Var ;
+                out = 0;
+                while ( parcours1 && out == 0 )
+                {
+                    if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)                 &&
+                         !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+                         !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
+                    {
+                        out = 1;
+                    }
+                    else parcours1 = parcours1->suiv;
+                }
+                /* if variable has been found                                     */
+                if ( out == 1 )
+                {
+                    Merge_Variables(parcours->var,parcours1->var);
+                }
+            }
+        }
+        parcours = parcours->suiv;
+    }
 }
 
@@ -696,20 +649,16 @@
    int out;
 
-   
+
    parcours = List_UsedInSubroutine_Var;
    while( parcours )
    {
       out = 0 ;
-      printf("OIEROZEIR %s %s\n",parcours->var->v_nomvar,parcours->var->v_modulename);
       if ( parcours->var->v_indicetabvars == 0 )
       {
-       printf("OIEROZEIR %s\n",parcours->var->v_nomvar);
          parcours2 = List_NameOfModuleUsed;
          while( parcours2 )
          {
-            if ( !strcasecmp(parcours2->u_cursubroutine,"") &&
-                 !strcasecmp(parcours2->u_modulename,
-                             parcours->var->v_modulename)
-               )
+            if ( !strcasecmp(parcours2->u_cursubroutine, "") &&
+                 !strcasecmp(parcours2->u_modulename, parcours->var->v_modulename) )
             {
                parcours3 = List_Global_Var;
@@ -722,11 +671,8 @@
                   else parcours3 = parcours3->suiv;
                }
-               if ( out == 1 ) CopyRecord(parcours->var,parcours3->var);
+               if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
             }
-            else if ( !strcasecmp(parcours2->u_cursubroutine,
-                             parcours->var->v_subroutinename) &&
-                 !strcasecmp(parcours2->u_modulename,
-                             parcours->var->v_modulename)
-               )
+            else if ( !strcasecmp(parcours2->u_cursubroutine, parcours->var->v_subroutinename) &&
+                      !strcasecmp(parcours2->u_modulename,    parcours->var->v_modulename) )
             {
                parcours3 = List_Global_Var;
@@ -739,5 +685,5 @@
                   else parcours3 = parcours3->suiv;
                }
-               if ( out == 1 ) CopyRecord(parcours->var,parcours3->var);
+               if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
             }
             parcours2 = parcours2->suiv;
@@ -755,5 +701,5 @@
                else parcours3 = parcours3->suiv;
             }
-            if ( out == 1 ) CopyRecord(parcours->var,parcours3->var);
+            if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
          }
          /*                                                                   */
@@ -792,5 +738,5 @@
       if ( out == 1 )
       {
-         CopyRecord(parcours->var,parcours1->var);
+         Merge_Variables(parcours->var,parcours1->var);
          strcpy(parcours->var->v_subroutinename,
                 parcours1->var->v_subroutinename);
@@ -841,5 +787,5 @@
 }
 
-int LookingForVariableInListName(listvar *listin,char *name)
+int LookingForVariableInListName(listvar *listin,const char *name)
 {
    listvar *parcours1;
@@ -860,4 +806,22 @@
 }
 
+variable *get_variable_in_list_from_name( listvar *listin, const char *name )
+{
+    listvar *parcours = listin;
+    variable *var = NULL;
+
+    while ( parcours && (!var) )
+    {
+        if ( !strcasecmp(name,parcours->var->v_nomvar) &&
+           ( !strcasecmp(subroutinename,parcours->var->v_subroutinename) ||
+             !strcasecmp(subroutinename,"") ) )
+        {
+            var = parcours->var;
+        }
+        else parcours = parcours -> suiv;
+   }
+   return var;
+}
+
 int LookingForVariableInListGlob(listvar *listin,variable *var)
 {
@@ -897,6 +861,5 @@
 void UpdateListDeclarationWithDimensionList()
 {
-   List_SubroutineDeclaration_Var = AddListvarToListvar(List_Dimension_Var,
-                                              List_SubroutineDeclaration_Var,1);
+   List_SubroutineDeclaration_Var = AddListvarToListvar(List_Dimension_Var, List_SubroutineDeclaration_Var,1);
 }
 
@@ -915,32 +878,20 @@
    listvar *parcoursprec;
    int remove;
-    
-        
+
    parcoursprec = (listvar *)NULL;
    parcours = List_UsedInSubroutine_Var;
    while ( parcours )
    {
-      /*                                                                      */
-      remove = LookingForVariableInListGlobal(List_SubroutineArgument_Var,
-                                                                 parcours->var);
+      remove = LookingForVariableInListGlobal(List_SubroutineArgument_Var,   parcours->var);
       if ( remove == 0 )
-           remove = LookingForVariableInList(List_SubroutineDeclaration_Var,
-                                                                 parcours->var);
-
+           remove = LookingForVariableInList(List_SubroutineDeclaration_Var, parcours->var);
       if ( remove == 0 )
-           remove = LookingForVariableInList(List_Parameter_Var,
-                                                                 parcours->var);
+           remove = LookingForVariableInList(List_Parameter_Var, parcours->var);
       if ( remove == 0 )
-           remove = LookingForVariableInList(List_FunctionType_Var,
-                                                                 parcours->var);
+           remove = LookingForVariableInList(List_FunctionType_Var, parcours->var);
       if ( remove == 0 )
-           remove = LookingForVariableInListGlob(List_GlobalParameter_Var,
-                                                                 parcours->var);
-      
+           remove = LookingForVariableInListGlob(List_GlobalParameter_Var, parcours->var);
       if ( remove == 0 )
-           remove = LookingForVariableInListParamGlob(
-                                    List_GlobParamModuleUsed_Var,parcours->var);
-
-  
+           remove = LookingForVariableInListParamGlob(List_GlobParamModuleUsed_Var, parcours->var);
       if ( remove == 0 )
       {
@@ -976,6 +927,4 @@
       }
    }
-   
-
 }
 
@@ -1023,5 +972,4 @@
       }
    }
-
 }
 
@@ -1032,5 +980,5 @@
    listvar *parcoursprec;
    int out ;
-           
+
    parcoursprec = (listvar *)NULL;
    parcours = List_SubroutineDeclaration_Var;
@@ -1041,8 +989,6 @@
       while ( parcours1 && out == 0 )
       {
-         if ( !strcasecmp(parcours->var->v_subroutinename,
-                          parcours1->var->v_subroutinename) &&
-              !strcasecmp(parcours->var->v_nomvar,
-                          parcours1->var->v_nomvar)
+         if ( !strcasecmp(parcours->var->v_subroutinename,parcours1->var->v_subroutinename) &&
+              !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
             ) out = 1;
          else parcours1 = parcours1->suiv;
@@ -1054,8 +1000,6 @@
          while ( parcours1 && out == 0 )
          {
-            if ( !strcasecmp(parcours->var->v_subroutinename,
-                             parcours1->var->v_subroutinename) &&
-                 !strcasecmp(parcours->var->v_nomvar,
-                             parcours1->var->v_nomvar)
+            if ( !strcasecmp(parcours->var->v_subroutinename,parcours1->var->v_subroutinename) &&
+                 !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
                ) out = 1;
             else parcours1 = parcours1->suiv;
@@ -1083,5 +1027,4 @@
       }
    }
-       
 }
 
@@ -1133,5 +1076,5 @@
                          parcours2->var->v_modulename) )
          {
-            CopyRecord(parcours->var,parcours2->var);
+            Merge_Variables(parcours->var,parcours2->var);
             /* remove var from the parcours2                                  */
             parcours2prec ->suiv = parcours2->suiv;
@@ -1160,5 +1103,5 @@
    Clean_List_UsedInSubroutine_Var();
    Clean_List_SubroutineDeclaration_Var();
-   
+
    newvar = (listvar *)NULL;
 /*   newvar = List_Common_Var;*/
@@ -1184,39 +1127,35 @@
 void ListUpdate()
 {
-   listvar *newvar;
-        
-   Update_List_Subroutine_Var(List_SubroutineArgument_Var);
-
-
-       
-   Update_List_Subroutine_Var(List_FunctionType_Var);
-   Update_List_Var(List_Parameter_Var);
-   Update_List_Var(List_Dimension_Var);
-   Update_List_Var(List_Data_Var);
-   Update_List_Var(List_Save_Var);
-   Update_List_Var(List_GlobalParameter_Var);
-   Update_List_Var(List_Common_Var);
-   Update_List_Var(List_SubroutineDeclaration_Var);
-   Update_List_Var(List_UsedInSubroutine_Var);
-   Update_List_From_Common_Var(List_UsedInSubroutine_Var);
-   Update_List_From_Common_Var(List_SubroutineDeclaration_Var);
-   Update_NotGridDepend_Var(List_NotGridDepend_Var);
-    
-   newvar =(listvar * )NULL;
-/*   newvar = List_Common_Var;*/
-/*   newvar = List_UsedInSubroutine_Var;*/
-/*   newvar = List_Data_Var;*/
-   while ( newvar )
-   {
-      printf("++++ %s - %d - %s - %s - %s - %s\n",
-      newvar->var->v_nomvar,
-      newvar->var->v_VariableIsParameter,
-      newvar->var->v_subroutinename,
-      newvar->var->v_modulename,
-      newvar->var->v_typevar,
-      newvar->var->v_initialvalue      
-            );
-      newvar = newvar->suiv;
-   }
+    listvar *newvar;
+
+    Update_List_Subroutine_Var(List_SubroutineArgument_Var);
+    Update_List_Subroutine_Var(List_FunctionType_Var);
+    Update_List_Var(List_Parameter_Var);
+    Update_List_Var(List_Dimension_Var);
+    Update_List_Var(List_Data_Var);
+    Update_List_Var(List_Save_Var);
+    Update_List_Var(List_GlobalParameter_Var);
+    Update_List_Var(List_Common_Var);
+    Update_List_Var(List_SubroutineDeclaration_Var);
+    Update_List_Var(List_UsedInSubroutine_Var);
+    Update_List_From_Common_Var(List_UsedInSubroutine_Var);
+    Update_List_From_Common_Var(List_SubroutineDeclaration_Var);
+    Update_NotGridDepend_Var(List_NotGridDepend_Var);
+
+    newvar = (listvar * ) NULL;
+//   newvar = List_Common_Var;
+//   newvar = List_UsedInSubroutine_Var;
+//   newvar = List_Data_Var;
+    while ( newvar )
+    {
+        printf("++++ %s - %s - %s - %d - %s - %s\n",
+                newvar->var->v_modulename,
+                newvar->var->v_subroutinename,
+                newvar->var->v_nomvar,
+                newvar->var->v_VariableIsParameter,
+                newvar->var->v_typevar,
+                newvar->var->v_initialvalue );
+        newvar = newvar->suiv;
+    }
 }
 
@@ -1273,5 +1212,5 @@
       parcours = parcours -> suiv ;
    }
-       
+
 }
 
@@ -1284,5 +1223,5 @@
    int position;
    int out;
-   char name_sub[LONG_C];
+   char name_sub[LONG_M];
 
    parcours = List_SubroutineArgument_Var;
@@ -1343,5 +1282,5 @@
       parcours = parcours->suiv;
    }
-       
+
 }
 
@@ -1364,5 +1303,5 @@
    parcoursprec = (listvar *)NULL;
 
-   if ( mark == 1 ) printf("MODULE Treated %s \n",nom);
+   if ( todebug == 1 ) printf("MODULE Treated %s \n",nom);
 
    List_ModuleUsed_Var = (listvar *)NULL;
@@ -1389,5 +1328,5 @@
          if ( out == 1 )
          {
-            CopyRecord(parcours->var,parcours1->var);
+            Merge_Variables(parcours->var,parcours1->var);
             /* Remove this variable from the List_ModuleUsed_Var              */
             if ( parcours1 == List_ModuleUsed_Var )
@@ -1405,18 +1344,20 @@
          /* if we do not found the var Module name in the old list            */
          {
-            if ( Listofavailableindices )
-            {
-               parcours->var->v_indicetabvars = Listofavailableindices ->
-                                                                       i_indice;
-               if ( Listofavailableindices->suiv )
-                          Listofavailableindices = Listofavailableindices->suiv;
-               else
-                          Listofavailableindices = (listindice *)NULL;
-            }
-            else
-            {
-               indicemaxtabvars = indicemaxtabvars + 1 ;
-               parcours->var->v_indicetabvars = indicemaxtabvars;
-            }
+  //       update_indicemaxtabvars(parcours->var,Listofavailableindices);
+         update_indicemaxtabvars(parcours->var,Listofavailableindices_glob);
+  //          if ( Listofavailableindices )
+  //          {
+  //             parcours->var->v_indicetabvars = Listofavailableindices ->
+  //                                                                     i_indice;
+  //             if ( Listofavailableindices->suiv )
+  //                        Listofavailableindices = Listofavailableindices->suiv;
+  //             else
+  //                        Listofavailableindices = (listindice *)NULL;
+  //          }
+  //          else
+  //          {
+  //             indicemaxtabvars = indicemaxtabvars + 1 ;
+  //             parcours->var->v_indicetabvars = indicemaxtabvars;
+  //          }
          }
       }
@@ -1428,8 +1369,8 @@
   while ( parcours1 )
   {
-     newindice=(listindice *) malloc (sizeof (listindice));
+     newindice=(listindice *) calloc(1,sizeof(listindice));
      newindice -> i_indice = parcours1 -> var -> v_indicetabvars;
-     newindice -> suiv = Listofavailableindices;
-     Listofavailableindices = newindice;
+     newindice -> suiv = Listofavailableindices_glob[parcours1 -> var -> v_catvar];
+     Listofavailableindices_glob[parcours1 -> var -> v_catvar] = newindice;
      parcours1 = parcours1->suiv;
   }
@@ -1444,5 +1385,5 @@
    listvar *parcours;
 
-   if ( mark == 1 ) printf("MODULE No Treated %s \n",nom);
+   if ( todebug == 1 ) printf("MODULE No Treated %s \n",nom);
 
    parcours = List_Global_Var;
@@ -1454,6 +1395,6 @@
           )
       {
-         indicemaxtabvars = indicemaxtabvars + 1 ;
-         parcours->var->v_indicetabvars = indicemaxtabvars;
+         indicemaxtabvars[parcours->var->v_catvar] = indicemaxtabvars[parcours->var->v_catvar] + 1 ;
+         parcours->var->v_indicetabvars = indicemaxtabvars[parcours->var->v_catvar];
       }
       parcours = parcours->suiv;
@@ -1474,5 +1415,5 @@
       {
          strcpy(parcours->var->v_commoninfile,record->var->v_commoninfile);
-         CopyRecord(parcours->var,record->var);
+         Merge_Variables(parcours->var,record->var);
       }
       parcours = parcours -> suiv;
@@ -1490,5 +1431,4 @@
 {
    listvar *parcours;
-   listvar *parcoursprec;
    listvar *parcours1;
    listvar *List_CommonUsed_Var;
@@ -1496,7 +1436,5 @@
    int out;
 
-   parcoursprec = (listvar *)NULL;
-
-   if ( mark == 1 ) printf("COMMON Treated %s \n",nom);
+   if ( todebug == 1 ) printf("COMMON Treated %s \n",nom);
 
    List_CommonUsed_Var = (listvar *)NULL;
@@ -1518,5 +1456,4 @@
             else
             {
-               parcoursprec = parcours1 ;
                parcours1 = parcours1->suiv;
             }
@@ -1527,23 +1464,25 @@
             strcpy(parcours->var->v_commoninfile,
                    parcours1->var->v_commoninfile);
-            CopyRecord(parcours->var,parcours1->var);
+            Merge_Variables(parcours->var,parcours1->var);
          }
          else
          /* if we do not found the var common name in the old list            */
          {
-            if ( Listofavailableindices )
-            {
-               parcours->var->v_indicetabvars = Listofavailableindices ->
-                                                                       i_indice;
-               if ( Listofavailableindices->suiv )
-                          Listofavailableindices = Listofavailableindices->suiv;
-               else
-                          Listofavailableindices = (listindice *)NULL;
-            }
-            else
-            {
-               indicemaxtabvars = indicemaxtabvars + 1 ;
-               parcours->var->v_indicetabvars = indicemaxtabvars;
-            }
+    //     update_indicemaxtabvars(parcours->var,Listofavailableindices);
+         update_indicemaxtabvars(parcours->var,Listofavailableindices_glob);
+    //        if ( Listofavailableindices )
+    //        {
+    //           parcours->var->v_indicetabvars = Listofavailableindices ->
+    //                                                                   i_indice;
+    //           if ( Listofavailableindices->suiv )
+    //                      Listofavailableindices = Listofavailableindices->suiv;
+    //           else
+    //                      Listofavailableindices = (listindice *)NULL;
+    //        }
+    //        else
+    //        {
+    //           indicemaxtabvars = indicemaxtabvars + 1 ;
+    //           parcours->var->v_indicetabvars = indicemaxtabvars;
+    //        }
          }
          /* Look in the remaining list in the variable is define              */
@@ -1559,12 +1498,33 @@
      if ( parcours1 -> var -> v_indicetabvars == 0 )
      {
-        newindice=(listindice *) malloc (sizeof (listindice));
+        newindice=(listindice *) calloc(1,sizeof(listindice));
         newindice -> i_indice = parcours1 -> var -> v_indicetabvars;
-        newindice -> suiv = Listofavailableindices;
-        Listofavailableindices = newindice;
+        newindice -> suiv = Listofavailableindices_glob[parcours1 -> var -> v_catvar];
+        Listofavailableindices_glob[parcours1 -> var -> v_catvar] = newindice;
      }
      parcours1 = parcours1->suiv;
   }
 }
+
+void update_indicemaxtabvars(variable *var,listindice **Listofindices)
+{
+
+
+            if ( Listofindices[var->v_catvar] )
+            {
+               var->v_indicetabvars = Listofindices[var->v_catvar] -> i_indice;
+               if ( Listofindices[var->v_catvar]->suiv )
+                          Listofindices[var->v_catvar] = Listofindices[var->v_catvar]->suiv;
+               else
+                          Listofindices[var->v_catvar] = (listindice *)NULL;
+            }
+            else
+            {
+               indicemaxtabvars[var->v_catvar] = indicemaxtabvars[var->v_catvar] + 1 ;
+               var->v_indicetabvars = indicemaxtabvars[var->v_catvar];
+            }
+
+}
+
 /******************************************************************************/
 /*                     IndiceTabvars_Common_Var_No_Treated                    */
@@ -1577,5 +1537,5 @@
    listvar *parcours2;
 
-   if ( mark == 1 ) printf("COMMON No Treated %s \n",nom);
+   if ( todebug == 1 ) printf("COMMON No Treated %s \n",nom);
 
    parcours = List_Common_Var;
@@ -1587,6 +1547,6 @@
           )
       {
-         indicemaxtabvars = indicemaxtabvars + 1 ;
-         parcours->var->v_indicetabvars = indicemaxtabvars;
+         indicemaxtabvars[parcours->var->v_catvar] = indicemaxtabvars[parcours->var->v_catvar] + 1 ;
+         parcours->var->v_indicetabvars = indicemaxtabvars[parcours->var->v_catvar];
          parcours2 = parcours;
          while ( parcours2 )
@@ -1619,5 +1579,5 @@
    while ( parcours_nom )
    {
-      if ( Did_module_common_treaded(parcours_nom->o_nom) == 1 )
+      if ( is_dependfile_created(parcours_nom->o_nom) == 1 )
       {
          IndiceTabvars_Global_Var_Treated(parcours_nom->o_nom);
@@ -1633,5 +1593,5 @@
    while ( parcours_nom )
    {
-      if ( Did_module_common_treaded(parcours_nom->o_nom) == 1 )
+      if ( is_dependfile_created(parcours_nom->o_nom) == 1 )
       {
          IndiceTabvars_Common_Var_Treated(parcours_nom->o_nom);
@@ -1663,16 +1623,18 @@
               !strcasecmp(parcours->var->v_subroutinename,"")            &&
               parcours->var->v_VariableIsParameter == 0                  &&
-              (parcours->var->v_allocatable == 0  || !strcasecmp(parcours->var->v_typevar,"type"))      &&
+              ( parcours->var->v_allocatable == 0 || !strcasecmp(parcours->var->v_typevar,"type"))      &&
               parcours->var->v_notgrid == 0                              &&
-              ( parcours->var->v_nbdim != 0 ||
-                strcasecmp(parcours->var->v_initialvalue,"")
-              ) ) out = 1;
+              ( ( parcours->var->v_nbdim != 0 || !strcasecmp(parcours->var->v_typevar,"type") )
+              || strcasecmp(parcours->var->v_initialvalue,"") )
+            )
+         {
+            out = 1;
+         }
          else parcours = parcours -> suiv;
       }
-      if ( out == 1 )
+      if ( out )
       {
          parcours_nom->o_val = 1 ;
       }
-      /*                                                                      */
       parcours_nom = parcours_nom -> suiv;
    }
@@ -1688,5 +1650,4 @@
    while ( parcours_nom )
    {
-      /*                                                                      */
       parcours = List_Common_Var;
       out = 0 ;
@@ -1695,8 +1656,11 @@
          if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom)  &&
               strcasecmp(parcours->var->v_subroutinename,"")                &&
-              !strcasecmp(parcours->var->v_commoninfile,mainfile)           &&
-              ( parcours->var->v_nbdim != 0 ||
-                strcasecmp(parcours->var->v_initialvalue,"")
-              ) ) out = 1;
+              !strcasecmp(parcours->var->v_commoninfile,cur_filename)       &&
+              ( ( parcours->var->v_nbdim != 0 || !strcasecmp(parcours->var->v_typevar,"type") )
+              || strcasecmp(parcours->var->v_initialvalue,"") )
+            )
+         {
+            out = 1;
+         }
          else parcours = parcours -> suiv;
       }
@@ -1705,5 +1669,4 @@
          parcours_nom->o_val = 1 ;
       }
-      /*                                                                      */
       parcours_nom = parcours_nom -> suiv;
    }
@@ -1713,48 +1676,26 @@
 {
    listnom *parcours_nom;
-   char ligne[LONG_C];
-   if ( firstpass == 0 )
-   {
-      parcours_nom = List_NameOfCommon;
-      while ( parcours_nom )
-      {
-         if ( parcours_nom->o_val == 1 )
-         {
-            strcpy(ligne,"");
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "module %s",parcours_nom->o_nom);
-            tofich(fortranout,ligne,1);
-            WriteUsemoduleDeclaration(parcours_nom->o_subroutinename);
-            strcpy(ligne,"implicit none");
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "public Alloc_agrif_%s",parcours_nom->o_nom);
-            tofich(fortranout,ligne,1);
-            strcpy (ligne, "contains");
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "subroutine Alloc_agrif_%s(Agrif_Gr)",
-                                                           parcours_nom->o_nom);
-            tofich(fortranout,ligne,1);
-            strcpy(ligne,"Use Agrif_Util");
-            tofich(fortranout,ligne,1);
-            strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr");
-            tofich(fortranout,ligne,1);
-            strcpy(ligne, "INTEGER :: i");
-            tofich (fortranout, ligne,1);
-            strcpy (ligne, "\n#include \"alloc_agrif_");
-            strcat (ligne, parcours_nom->o_nom);
-            strcat (ligne, ".h\"\n");
-            fprintf(fortranout,ligne);
-            strcpy (ligne, "Return");
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "end subroutine Alloc_agrif_%s",
-                                                           parcours_nom->o_nom);
-            tofich(fortranout,ligne,1);
-            sprintf (ligne, "end module %s",parcours_nom->o_nom);
-            tofich(fortranout,ligne,1);
-            /* List all Call Alloc_agrif                                      */
-            Add_Subroutine_For_Alloc(parcours_nom->o_nom);
-         }
-         parcours_nom = parcours_nom->suiv;
-      }
+
+   parcours_nom = List_NameOfCommon;
+   while ( parcours_nom )
+   {
+      if ( parcours_nom->o_val == 1 )
+      {
+         fprintf(fortran_out, "      module %s\n\n", parcours_nom->o_nom);
+         WriteUsemoduleDeclaration(parcours_nom->o_subroutinename);
+         fprintf(fortran_out, "        implicit none\n");
+         fprintf(fortran_out, "        public :: Alloc_agrif_%s\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "      contains\n");
+         fprintf(fortran_out, "      subroutine Alloc_agrif_%s(Agrif_Gr)\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "        use Agrif_Util\n");
+         fprintf(fortran_out, "        type(Agrif_grid), pointer :: Agrif_Gr\n");
+         fprintf(fortran_out, "        integer :: i\n");
+         fprintf(fortran_out, "#include \"alloc_agrif_%s.h\"\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "      end subroutine Alloc_agrif_%s\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "      end module %s\n", parcours_nom->o_nom);
+         /* List all Call Alloc_agrif                                      */
+         Add_Subroutine_For_Alloc(parcours_nom->o_nom);
+      }
+      parcours_nom = parcours_nom->suiv;
    }
 }
@@ -1768,54 +1709,50 @@
    listvar *parcours4;
    int out;
-   char name_module[LONG_C];
+   char name_module[LONG_M];
 
    /* We should integrate allocate and pointer variables                      */
-   parcours2 = List_Allocate_Var;
-   while ( parcours2 )
-   {
-      parcours4 = List_UsedInSubroutine_Var;
-      out = 0 ;
-      while ( parcours4 && out == 0 )
-      {
-         if ( !strcasecmp(parcours2->a_nomvar,parcours4->var->v_nomvar) )
-         {
-            Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename,
-                                           parcours4->var->v_modulename);
-            out = 1;
-         }
-         else parcours4 = parcours4 -> suiv ;
-      }
-      parcours2 = parcours2->suiv;
-   }
-   /*                                                                         */
-   parcours3 = List_Pointer_Var;
-   while ( parcours3 )
-   {
-      parcours4 = List_UsedInSubroutine_Var;
-      out = 0 ;
-      while ( parcours4 && out == 0 )
-      {
-         if ( !strcasecmp(parcours3->n_name,parcours4->var->v_nomvar) )
-         {
-            Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename,
-                                           parcours4->var->v_modulename);
-            out = 1;
-         }
-         else parcours4 = parcours4 -> suiv ;
-      }
-      parcours3 = parcours3 -> suiv;
-   }
-   /*                                                                         */
-   parcours4 = List_UsedInSubroutine_Var;
-   while ( parcours4 )
-   {
-      if ( parcours4->var->v_allocatable == 1 && strcasecmp(parcours4->var->v_typevar,"type"))
-      {
-         Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename,
-                                        parcours4->var->v_modulename);
-      }
-      parcours4 = parcours4 -> suiv ;
-   }
-   /*                                                                         */
+//    parcours2 = List_Allocate_Var;
+//    while ( parcours2 )
+//    {
+//       parcours4 = List_UsedInSubroutine_Var;
+//       out = 0 ;
+//       while ( parcours4 && out == 0 )
+//       {
+//          if ( !strcasecmp(parcours2->a_nomvar,parcours4->var->v_nomvar) )
+//          {
+//             Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
+//             out = 1;
+//          }
+//          else parcours4 = parcours4 -> suiv ;
+//       }
+//       parcours2 = parcours2->suiv;
+//    }
+//
+//    parcours3 = List_Pointer_Var;
+//    while ( parcours3 )
+//    {
+//       parcours4 = List_UsedInSubroutine_Var;
+//       out = 0 ;
+//       while ( parcours4 && out == 0 )
+//       {
+//          if ( !strcasecmp(parcours3->n_name, parcours4->var->v_nomvar) )
+//          {
+//             Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
+//             out = 1;
+//          }
+//          else parcours4 = parcours4 -> suiv ;
+//       }
+//       parcours3 = parcours3 -> suiv;
+//    }
+//    parcours4 = List_UsedInSubroutine_Var;
+//    while ( parcours4 )
+//    {
+//       if ( parcours4->var->v_allocatable == 1 && strcasecmp(parcours4->var->v_typevar,"type"))
+//       {
+//          Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
+//       }
+//       parcours4 = parcours4 -> suiv ;
+//    }
+
    parcours = List_SubroutineWhereAgrifUsed;
    while ( parcours )
@@ -1833,11 +1770,10 @@
             if ( !strcasecmp(parcours->o_nom,parcours1->u_cursubroutine) )
             {
-               strcpy(name_module,parcours->o_module);
+               strcpy(name_module, parcours->o_module);
             }
             parcours1 = parcours1->suiv;
          }
       }
-      /* if out == 0 we should look in the module declaration                 */
-      if ( out == 0 )
+      if ( out == 0 )   /* we should look in the module declaration */
       {
          parcours1 = List_NameOfModuleUsed;
@@ -1853,5 +1789,5 @@
       }
       if ( out == 0 ) parcours->o_val = 1;
-      /*                                                                      */
+
       parcours = parcours->suiv;
    }
@@ -1876,15 +1812,10 @@
 }
 
-void Affiche()
-{
-   listvar *parcours;
-
-   parcours = (listvar *)NULL;
+void Affiche(listvar *in_parcours)
+{
 /*   parcours = List_Global_Var;                  */
 /*   parcours = List_SubroutineDeclaration_Var;   */
-
 /*   parcours = List_SubroutineArgument_Var;      */
 /*   parcours = List_FunctionType_Var;            */
-
 /*   parcours = List_Data_Var;                    */
 /*   parcours = List_Save_Var;                    */
@@ -1893,34 +1824,33 @@
 /*   parcours = List_GlobalParameter_Var;         */
 /*   parcours = List_NotGridDepend_Var;           */
-
 /*   parcours = List_Common_Var;                  */
+   listvar *parcours = in_parcours;
 
    while( parcours )
    {
-      printf("module- %s \n",parcours->var->v_modulename);
-      printf("subroutine- %s  \n",parcours->var->v_subroutinename);
-      printf("nom- %s  \n",parcours->var->v_nomvar);
-      printf("common- %s  \n",parcours->var->v_commonname);
-      printf("type- %s  \n",parcours->var->v_typevar);
-      printf("indice- %d  \n",parcours->var->v_indicetabvars);
-      printf("variableisparameter- %d \n",parcours->var->v_VariableIsParameter);
-      printf("module1- %d  \n",parcours->var->v_module);
-      printf("save- %d  \n",parcours->var->v_save);
-      printf("notgrid- %d  \n",parcours->var->v_notgrid);
-      printf("nbdim- %d  \n",parcours->var->v_nbdim);
-      printf("common1- %d  \n",parcours->var->v_common);
-      printf("v_dimensiongiven- %d  \n",parcours->var->v_dimensiongiven);
-      printf("v_dimsempty- %d  \n",parcours->var->v_dimsempty);
-      printf("initialvalue- %s\n \n",parcours->var->v_initialvalue);
-      printf("dim- %s\n \n",parcours->var->v_readedlistdimension);
+      printf("modulename     - %s \n", parcours->var->v_modulename);
+      printf("subroutinename - %s \n", parcours->var->v_subroutinename);
+      printf("nomvar         - %s \n", parcours->var->v_nomvar);
+      printf("commonname     - %s \n", parcours->var->v_commonname);
+      printf("commoninfile   - %s \n", parcours->var->v_commoninfile);
+      printf("typevar        - %s \n", parcours->var->v_typevar);
+      printf("catvar         - %d \n", parcours->var->v_catvar);
+      printf("indicetabvars  - %d \n", parcours->var->v_indicetabvars);
+      printf("isparameter    - %d \n", parcours->var->v_VariableIsParameter);
+      printf("module         - %d \n", parcours->var->v_module);
+      printf("save           - %d \n", parcours->var->v_save);
+      printf("notgrid        - %d \n", parcours->var->v_notgrid);
+      printf("nbdim          - %d \n", parcours->var->v_nbdim);
+      printf("common         - %d \n", parcours->var->v_common);
+      printf("dimensiongiven - %d \n", parcours->var->v_dimensiongiven);
+      printf("dimsempty      - %d \n", parcours->var->v_dimsempty);
+      printf("initialvalue   - %s \n", parcours->var->v_initialvalue);
+      printf("readedlistdim  - %s \n", parcours->var->v_readedlistdimension);
+      printf("-------------------------------------\n");
 
       parcours = parcours -> suiv ;
    }
-   if ( mark == 1 ) printf("Indicemaxtabvars = %d \n",indicemaxtabvars);
-   
-}
-
-
-
+   if ( todebug == 1 ) printf("Indicemaxtabvars = %d \n",indicemaxtabvars[0]);
+}
 
 int SubInList_ContainsSubroutine()
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c	(revision 5682)
@@ -41,18 +41,7 @@
 /*                      Add_SubroutineArgument_Var_1                          */
 /******************************************************************************/
-/* Firstpass 1                                                                */
-/* We should complete the                                                     */
-/******************************************************************************/
-/*                                                                            */
-/*                                                                            */
-/******************************************************************************/
 void Add_SubroutineArgument_Var_1(listvar *listtoadd)
 {
-
-   if ( firstpass == 1 )
-   {
-       List_SubroutineArgument_Var = AddListvarToListvar
-                              (listtoadd,List_SubroutineArgument_Var,1);
-   }
+    List_SubroutineArgument_Var = AddListvarToListvar(listtoadd, List_SubroutineArgument_Var, 1);
 }
 
@@ -60,46 +49,30 @@
 /*                             Add_FunctionType_Var_1                         */
 /******************************************************************************/
-/* Firstpass 1                                                                */
-/* We should complete the                                                     */
-/******************************************************************************/
-/*                                                                            */
-/*                                                                            */
-/******************************************************************************/
-void Add_FunctionType_Var_1(char *nom)
+void Add_FunctionType_Var_1(const char *nom)
 {
-   listvar *newvar;
+    listvar *newvar;
 
-   if ( firstpass == 1 )
-   {
-      curvar=createvar(nom,NULL);
-      strcpy(curvar->v_typevar,DeclType);
-      newvar = insertvar(NULL,curvar);
-      List_FunctionType_Var = AddListvarToListvar
-                              (newvar,List_FunctionType_Var,1);
-   }
+    curvar = createvar(nom, NULL);
+    strcpy(curvar->v_typevar, DeclType);
+    newvar = insertvar(NULL, curvar);
+    List_FunctionType_Var = AddListvarToListvar(newvar,List_FunctionType_Var,1);
 }
-
 
 /******************************************************************************/
 /*                      Add_SubroutineDeclaration_Var_1                       */
 /******************************************************************************/
-/* Firstpass 1                                                                */
 /* We should complete the listvarofsubroutine                                 */
 /******************************************************************************/
-/*                                                                            */
-/*                                                                            */
-/******************************************************************************/
-void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd)
-{
-   if ( firstpass == 1 )
-   {
-      if ( VariableIsParameter == 0 &&
-           SaveDeclare         == 0 )
-      {
-         listduplicated = (listvar *)NULL;
-         duplicatelistvar(listtoadd);
-         List_SubroutineDeclaration_Var = AddListvarToListvar
-                              (listduplicated,List_SubroutineDeclaration_Var,1);
-      }
-   }
-}
+// void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd)
+// {
+//    if ( firstpass == 1 )
+//    {
+//       if ( VariableIsParameter == 0 &&
+//            SaveDeclare         == 0 )
+//       {
+//          listduplicated = (listvar *)NULL;
+//          duplicatelistvar(listtoadd);
+//          List_SubroutineDeclaration_Var = AddListvarToListvar(listduplicated,List_SubroutineDeclaration_Var,1);
+//       }
+//    }
+// }
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c	(revision 5682)
@@ -43,60 +43,30 @@
 /* This subroutine is used to write the string s into the fileout             */
 /******************************************************************************/
-void tofich_reste (FILE * filout, char *s,int returnlineornot)
+void tofich_reste (FILE * filout, const char *s, int do_returnline)
 {
-  char temp[61];
-  char *tmp;
-  int size;
-  int val_min;
+    const size_t line_length = 66;
+    char temp[line_length+1];
+    size_t s_length;
 
-  if (strlen (s) <= 60)
+    s_length = strlen(s);
+
+    if ( !strcmp(&s[strlen(s)-1], "\n") )
+        s_length = strlen(s)-1;
+
+    if ( s_length <= line_length )
     {
-      if ( returnlineornot == 0 ) fprintf (filout, "     &%s", s);
-      else if ( returnlineornot == 2 ) fprintf (filout, "&%s", s);
-      else if ( returnlineornot == 3 ) fprintf (filout, "&%s\n", s);
-      else                             fprintf (filout, "     &%s\n", s);
-      if ( returnlineornot == 0 ||
-           returnlineornot == 2 ) colnum=colnum+strlen(s)+6;
-      else colnum=0;
+        if ( do_returnline ) fprintf(filout, "     &%s\n", s);
+        else                 fprintf(filout, "&%s", s);
     }
-  else
+    else
     {
-      val_min = 60;
-      strncpy (temp, s, 60);
-      strcpy (&temp[60], "\0");
+        strncpy(temp, s, line_length);
+        temp[line_length] = '\0';
+        if ( retour77 == 0 && (s_length-strlen(temp) > 0) )
+                fprintf(filout, "     &%s&\n", temp);
+        else    fprintf(filout, "     &%s\n", temp);
 
-      tmp = strrchr(temp, '+');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '-');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '/');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '*');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '%');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, ',');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, ')');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '(');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-
-      size = val_min;
-
-      strcpy (&temp[60-size], "\0");
-
-      if ( retour77 == 0 ) fprintf (filout, "     &%s&\n", temp);
-      else fprintf (filout, "     &%s\n", temp);
-      colnum=0;
-      tofich_reste (filout, (char *) &s[60-size],returnlineornot);
+        if ( s_length-strlen(temp) > 0 )
+            tofich_reste(filout, (char *) &s[line_length], do_returnline);
     }
 }
@@ -107,60 +77,29 @@
 /* This subroutine is used to write the string s into the fileout             */
 /******************************************************************************/
-void tofich (FILE * filout, char *s, int returnlineornot)
+void tofich (FILE * filout, const char *s, int do_returnline)
 {
-  char temp[61];
-  char *tmp;
-  int size;
-  int val_min;
+    const size_t line_length = 66;
+    char temp[line_length+1];
+    size_t s_length;
 
-  if (strlen (s) <= 60)
+    s_length = strlen(s);
+
+    if ( !strcmp(&s[strlen(s)-1], "\n") )
+        s_length = strlen(s)-1;
+
+    if ( s_length <= line_length )
     {
-      if ( returnlineornot == 0 ) fprintf (filout, "      %s", s);
-      else if ( returnlineornot == 2 ) fprintf (filout, "%s", s);
-      else if ( returnlineornot == 3 ) fprintf (filout, "%s\n", s);
-      else                             fprintf (filout, "      %s\n", s);
-      if ( returnlineornot == 0 || returnlineornot == 2 )
-                                                      colnum=colnum+strlen(s)+6;
-      else colnum=0;
+        if ( do_returnline ) fprintf(filout, "      %s\n", s);
+        else                 fprintf(filout, "%s", s);
     }
-  else
+    else
     {
-      val_min = 60;
-      strncpy (temp, s, 60);
-      strcpy (&temp[60], "\0");
+        strncpy(temp, s, line_length);
+        temp[line_length] = '\0';
 
-      tmp = strrchr(temp, '+');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '-');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '/');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '*');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '%');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, ',');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, ')');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
-      tmp = strrchr(temp, '(');
-      if ( tmp )
-      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+        if ( retour77 == 0 )    fprintf(filout, "      %s&\n", temp);
+        else                    fprintf(filout, "      %s\n", temp);
 
-      size = val_min;
-
-      strcpy (&temp[60-size], "\0");
-
-      if ( retour77 == 0 ) fprintf (filout, "      %s&\n", temp);
-      else fprintf (filout, "      %s\n", temp);
-      colnum=0;
-      tofich_reste (filout, (char *) &s[60-size], returnlineornot);
+        tofich_reste(filout, (char *) &s[line_length], do_returnline);
     }
 }
@@ -173,49 +112,21 @@
 void tofich_blanc (FILE * filout, int size)
 {
-  int i;
+    const char* empty_char = " ";
+    int i = 0;
 
-  if (size <= 65) fprintf (filout, "%*s\n",size,EmptyChar);
-  else
-  {
-      i=0;
-      do
-      {
-         fprintf (filout, "%*s\n",65,EmptyChar);
-         i = i+1;
-      } while ( i <= size / 65 );
-         fprintf (filout, "%*s\n",size%65,EmptyChar);
-  }
+    if (size <= 65)
+        fprintf(filout, "%*s\n", size, empty_char);
+    else
+    {
+        do
+        {
+            fprintf(filout, "%*s\n", 65, empty_char);
+            i++;
+        }
+        while ( i <= size / 65 );
 
+        fprintf(filout, "%*s\n", size%65, empty_char);
+    }
 }
-/******************************************************************************/
-/*                       tofich_line                                          */
-/******************************************************************************/
-/* This subroutine is used to write size blank into the fileout               */
-/******************************************************************************/
-void tofich_line (FILE * filout, int size, int long position)
-{
-  int i;
-  int retour;
-
-  if (size <= 65) fprintf (filout, "%*s",size,EmptyChar);
-  else
-  {
-      i=0;
-      do
-      {
-         fprintf (filout, "%*s",65,EmptyChar);
-         i = i+1;
-      } while ( i <= size / 65 );
-         fprintf (filout, "%*s",size%65,EmptyChar);
-  }
-
-   if ( !strstr(motparse1,"\n") ) retour=0;
-   else retour=1;
-
-   fseek(filout,position,SEEK_SET);
-   if (retour == 1 ) fprintf (filout, "\n");
-
-}
-
 
 /******************************************************************************/
@@ -224,14 +135,12 @@
 /* This subroutine is used to remove a sentence in the file filout            */
 /******************************************************************************/
-void RemoveWordSET_0(FILE * filout, long int position, long int sizetoremove)
+void RemoveWordSET_0(FILE * filout, long int position, int sizetoremove)
 {
-   if ( firstpass == 0 && couldaddvariable == 1 )
-   {
-      fseek(filout,position,SEEK_SET);
-      tofich_line(filout,sizetoremove,position);
+    if ( inside_type_declare || firstpass ) return;
 
-   }
+    fseek(filout, position, SEEK_SET);
+    tofich_blanc(filout, sizetoremove);
+    fseek(filout, position, SEEK_SET);
 }
-
 
 /******************************************************************************/
@@ -240,11 +149,11 @@
 /* This subroutine is used to remove a sentence in the file filout            */
 /******************************************************************************/
-void RemoveWordCUR_0(FILE * filout, long int position, long int sizetoremove)
+void RemoveWordCUR_0(FILE * filout, int sizetoremove)
 {
-   if ( firstpass == 0  && couldaddvariable == 1 )
-   {
-      fseek(filout,position,SEEK_CUR);
-      tofich_blanc(filout,sizetoremove);
+    if ( inside_type_declare || firstpass ) return;
 
-   }
+    fseek(filout, (long int)(-sizetoremove), SEEK_CUR);
+    tofich_blanc(filout, sizetoremove);
+    fseek(filout, (long int)(-sizetoremove), SEEK_CUR);
+    if ( strstr(fortran_text, "\n") )   fprintf(filout, "\n");
 }
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c	(revision 5682)
@@ -50,60 +50,59 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteBeginDeclaration(variable *v,char ligne[LONG_4C], int visibility)
-{
-  char tmpligne[LONG_4C];
+void WriteBeginDeclaration(variable *v, char line[LONG_M], int visibility)
+{
+  char tmpligne[LONG_M];
+  int precision_given ;
 
   if ( !strcasecmp(v->v_typevar,"") )
   {
-     printf("WARNING : The type of the variable %s \n",v->v_nomvar);
-     printf("          is unknown. CONV should define a type\n");
-  }
-  
-  sprintf (ligne, "%s", v->v_typevar);
-  if ( v->v_c_star == 1 ) strcat(ligne,"*");
-  
+     printf("# WARNING : The type of the variable %s is unknown.\n", v->v_nomvar);
+     printf("#           CONV should define a type\n");
+  }
+
+  sprintf(line, "%s", v->v_typevar);
+  if ( v->v_c_star == 1 ) strcat(line, "*");
+
   /* We should give the precision of the variable if it has been given        */
+  precision_given = 0;
   if ( strcasecmp(v->v_precision,"") )
   {
-     sprintf(tmpligne,"(%s)",v->v_precision);
-     Save_Length(tmpligne,49);
-     strcat(ligne,tmpligne);
-  }
-  
+     sprintf(tmpligne, "(%s)", v->v_precision);
+     Save_Length(tmpligne, 49);
+     strcat(line, tmpligne);
+     precision_given = 1;
+  }
+
   if (strcasecmp(v->v_dimchar,""))
   {
      sprintf(tmpligne,"(%s)",v->v_dimchar);
-     Save_Length(tmpligne,49);
-     strcat(ligne,tmpligne);
-  }
-  
-  if ( strcasecmp(v->v_nameinttypename,"") )
+     Save_Length(tmpligne, 49);
+     strcat(line,tmpligne);
+  }
+
+  if ((precision_given == 0) && ( strcasecmp(v->v_nameinttypename,"") ))
   {
      sprintf(tmpligne,"*%s",v->v_nameinttypename);
-     Save_Length(tmpligne,49);
-     strcat(ligne,tmpligne);
+     Save_Length(tmpligne, 49);
+     strcat(line,tmpligne);
   }
   if (strcasecmp (v->v_IntentSpec, ""))
   {
-     sprintf(tmpligne,",INTENT(%s) ",v->v_IntentSpec);
-     Save_Length(tmpligne,49);
-     strcat(ligne,tmpligne);
-  }
-  if ( v->v_VariableIsParameter == 1 ) strcat(ligne, ", PARAMETER");
-  if (visibility == 1)
-  {
-  if ( v->v_PublicDeclare       == 1 ) strcat(ligne, ", PUBLIC");
-  if ( v->v_PrivateDeclare      == 1 ) strcat(ligne, ", PRIVATE");
-  }
-  if ( v->v_ExternalDeclare     == 1 ) strcat(ligne, ", EXTERNAL");
-  if ( v->v_allocatable         == 1)
-       {strcat(ligne,", ALLOCATABLE");
-       }
-  if ( v->v_target         == 1)
-       {strcat(ligne,", TARGET");
-       }
-  if ( v->v_optionaldeclare     == 1 ) strcat(ligne,", OPTIONAL");
-  if ( v->v_pointerdeclare      == 1 ) strcat(ligne,", POINTER");
-  Save_Length(ligne,45);
+     sprintf(tmpligne,", intent(%s)", v->v_IntentSpec);
+     Save_Length(tmpligne, 49);
+     strcat(line,tmpligne);
+  }
+  if ( v->v_VariableIsParameter ) strcat(line, ", parameter");
+  if ( visibility )
+  {
+      if ( v->v_PublicDeclare  )  strcat(line, ", public");
+      if ( v->v_PrivateDeclare )  strcat(line, ", private");
+  }
+  if ( v->v_ExternalDeclare ) strcat(line, ", external");
+  if ( v->v_allocatable     ) strcat(line, ", allocatable");
+  if ( v->v_target          ) strcat(line, ", target");
+  if ( v->v_optionaldeclare ) strcat(line, ", optional");
+  if ( v->v_pointerdeclare  ) strcat(line, ", pointer");
+  Save_Length(line, 45);
 }
 
@@ -120,18 +119,17 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteScalarDeclaration(variable *v,char ligne[LONG_4C])
-{
-
-  strcat (ligne, " :: ");
-  strcat (ligne, v->v_nomvar);
-  if ( strcasecmp(v->v_vallengspec,"") ) strcat(ligne,v->v_vallengspec);
-  if ( v->v_VariableIsParameter == 1 )
-  {
-     strcat(ligne," = ");
-     strcat(ligne,v->v_initialvalue);
-  }
-  Save_Length(ligne,45);
-}
-
+void WriteScalarDeclaration( variable *v, char line[LONG_M])
+{
+    strcat(line, " :: ");
+    strcat(line, v->v_nomvar);
+
+    if ( strcasecmp(v->v_vallengspec, "") ) strcat(line,v->v_vallengspec);
+    if ( v->v_VariableIsParameter )
+    {
+        strcat(line," = ");
+        strcat(line, v->v_initialvalue);
+    }
+    Save_Length(line, 45);
+}
 
 /******************************************************************************/
@@ -147,48 +145,39 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteTableDeclaration(variable * v,char ligne[LONG_4C],int tmpok)
-{
-  char newname[LONG_4C];
-
-  strcat (ligne, ", Dimension(");
-
-  if ( v->v_dimensiongiven == 1 && tmpok == 1 )
-  {
-                                         strcat(ligne,v->v_readedlistdimension);
-                                         }
-  if ( v->v_dimensiongiven == 1 && tmpok == 0 )
-  {
-     strcpy(newname,ChangeTheInitalvaluebyTabvarsName
-                                  (v->v_readedlistdimension,List_Global_Var,0));
-
-     if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
-
-        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
-                                 (newname,List_Common_Var,0));
-
-     if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
-     
-        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
-                              (newname,List_ModuleUsed_Var,0));
+void WriteTableDeclaration(variable * v,char ligne[LONG_M],int tmpok)
+{
+    char newname[LONG_M];
+
+    strcat (ligne, ", dimension(");
+
+    if ( v->v_dimensiongiven == 1 && tmpok == 1 )   strcat(ligne,v->v_readedlistdimension);
+    if ( v->v_dimensiongiven == 1 && tmpok == 0 )
+    {
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(v->v_readedlistdimension,List_Global_Var));
         if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
 
-     Save_Length(newname,47);
-     strcat(ligne,newname);
-  }
-  strcat (ligne, ")");
-  strcat (ligne, " :: ");
-  strcat (ligne, v->v_nomvar);
-  if ( strcasecmp(vallengspec,"") ) strcat(ligne,v->v_vallengspec);
-
-  if ( v->v_VariableIsParameter == 1 )
-  {
-     strcat(ligne," = ");
-     strcat(ligne,v->v_initialvalue);
-  }
-  Save_Length(ligne,45);
-}
-
-/******************************************************************************/
-/*                        writevardeclaration                                 */
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_Common_Var));
+        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
+
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_ModuleUsed_Var));
+        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
+
+        Save_Length(newname,47);
+        strcat(ligne,newname);
+    }
+    strcat(ligne, ") :: ");
+    strcat(ligne, v->v_nomvar);
+    if ( strcasecmp(vallengspec,"") ) strcat(ligne,v->v_vallengspec);
+
+    if ( v->v_VariableIsParameter == 1 )
+    {
+        strcat(ligne," = ");
+        strcat(ligne,v->v_initialvalue);
+    }
+    Save_Length(ligne,45);
+}
+
+/******************************************************************************/
+/*                        WriteVarDeclaration                                 */
 /******************************************************************************/
 /* This subroutine is used to write the initial declaration in the file       */
@@ -201,216 +190,228 @@
 /*                                                                            */
 /******************************************************************************/
-void writevardeclaration (listvar * var_record, FILE *fileout, int value, int visibility)
+void WriteVarDeclaration( variable *v, FILE *fileout, int value, int visibility )
 {
   FILE *filecommon;
+  char ligne[LONG_M];
+
+  filecommon = fileout;
+
+  if ( v->v_save == 0 || inmodulemeet == 0 )
+  {
+     WriteBeginDeclaration(v, ligne, visibility);
+
+     if ( v->v_nbdim == 0 )
+        WriteScalarDeclaration(v, ligne);
+     else
+        WriteTableDeclaration(v, ligne, value);
+
+     if ( v->v_VariableIsParameter != 1 && strcasecmp(v->v_initialvalue,"") )
+     {
+        strcat(ligne," = ");
+        strcat(ligne,v->v_initialvalue);
+     }
+     tofich(filecommon, ligne, 1);
+  }
+  else
+    printf("-- in writevardeclaration : |%s| -- MHCHECK\n", v->v_nomvar);
+  Save_Length(ligne,45);
+}
+
+
+void WriteLocalParamDeclaration(FILE* tofile)
+{
+    listvar *parcours;
+
+    parcours = List_Parameter_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
+        {
+            WriteVarDeclaration(parcours->var, tofile, 0, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+void WriteFunctionDeclaration(FILE* tofile, int value)
+{
+    listvar *parcours;
+
+    parcours = List_FunctionType_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) &&
+              strcasecmp(parcours->var->v_typevar, "") )
+        {
+            WriteVarDeclaration(parcours->var, tofile, value, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+void WriteSubroutineDeclaration(int value)
+{
+    listvar *parcours;
+    variable *v;
+
+    parcours = List_SubroutineDeclaration_Var;
+    while ( parcours )
+    {
+        v = parcours->var;
+        if ( !strcasecmp(v->v_subroutinename, subroutinename)   &&
+             (v->v_save == 0)                                   &&
+             (v->v_pointerdeclare == 0)                         &&
+             (v->v_VariableIsParameter == 0)                    &&
+             (v->v_common == 0) )
+        {
+            WriteVarDeclaration(v, fortran_out, value, 1);
+        }
+        else if ( !strcasecmp(v->v_subroutinename, subroutinename)  &&
+                  (v->v_save == 0)                                  &&
+                  (v->v_VariableIsParameter == 0)                   &&
+                  (v->v_common == 0) )
+        {
+            WriteVarDeclaration(v, fortran_out, value, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+void WriteArgumentDeclaration_beforecall()
+{
+    int position;
+    listnom *neededparameter;
+    FILE *paramtoamr;
+    listvar *parcours;
+    variable *v;
+    char ligne[LONG_M];
+
+    fprintf(fortran_out,"#include \"Param_BeforeCall_%s.h\"\n",subroutinename);
+
+    sprintf(ligne,"Param_BeforeCall_%s.h",subroutinename);
+    paramtoamr = open_for_write(ligne);
+
+    neededparameter = (listnom * )NULL;
+    position = 1;
+    parcours = List_SubroutineArgument_Var;
+
+    while ( parcours )
+    {
+        v = parcours->var;
+        if ( !strcasecmp(v->v_subroutinename, subroutinename) && (v->v_positioninblock == position) )
+        {
+            position++;
+            WriteVarDeclaration(v, fortran_out, 0, 1);
+            neededparameter = writedeclarationintoamr(List_Parameter_Var, paramtoamr,
+                                    v, v->v_subroutinename, neededparameter, subroutinename);
+            parcours = List_SubroutineArgument_Var;
+        }
+        else parcours = parcours -> suiv;
+    }
+    Save_Length(ligne,45);
+
+    // Write interface for 'Sub_Loop_machin' in 'Param_BeforeCall_machin.h' when outside a module
+    if ( IsTabvarsUseInArgument_0() && (inmodulemeet == 0) && (inprogramdeclare == 0) )
+    {
+        fprintf(paramtoamr, "      interface\n");
+        if (isrecursive) sprintf(ligne,"  recursive subroutine Sub_Loop_%s(", subroutinename);
+        else             sprintf(ligne,"  subroutine Sub_Loop_%s(", subroutinename);
+        WriteVariablelist_subloop(ligne);
+        WriteVariablelist_subloop_Def(ligne);
+        strcat(ligne,")");
+        Save_Length(ligne,45);
+        tofich(paramtoamr,ligne,1);
+
+        listusemodule *parcours_mod;
+        parcours_mod = List_NameOfModuleUsed;
+        while ( parcours_mod )
+        {
+            if ( !strcasecmp(parcours_mod->u_cursubroutine, subroutinename) )
+            {
+                fprintf(paramtoamr, "          use %s\n", parcours_mod->u_usemodule);
+            }
+            parcours_mod = parcours_mod->suiv;
+        }
+        fprintf(paramtoamr, "          implicit none\n");
+        WriteLocalParamDeclaration(paramtoamr);
+        writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var, paramtoamr);
+        writesub_loopdeclaration_tab(List_UsedInSubroutine_Var, paramtoamr);
+        WriteArgumentDeclaration_Sort(paramtoamr);
+        WriteFunctionDeclaration(paramtoamr, 1);
+
+        sprintf(ligne,"  end subroutine Sub_Loop_%s\n", subroutinename);
+        tofich(paramtoamr, ligne, 1);
+        fprintf(paramtoamr, "      end interface\n");
+    }
+    fclose(paramtoamr);
+}
+
+void WriteArgumentDeclaration_Sort(FILE* tofile)
+{
+    int position = 1;
+    listvar *parcours;
+
+    parcours = List_SubroutineArgument_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) &&
+                         parcours->var->v_positioninblock == position )
+        {
+            position = position + 1;
+            WriteVarDeclaration(parcours->var, tofile, 1, 1);
+            parcours = List_SubroutineArgument_Var;
+        }
+        else parcours = parcours -> suiv;
+    }
+
+    parcours = List_SubroutineArgument_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
+                         parcours->var->v_positioninblock == 0           &&
+                        parcours->var->v_nbdim == 0 )
+        {
+            WriteVarDeclaration(parcours->var,tofile,1,1);
+        }
+        parcours = parcours -> suiv;
+    }
+
+    parcours = List_SubroutineArgument_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
+                         parcours->var->v_positioninblock == 0           &&
+                         parcours->var->v_nbdim != 0 )
+        {
+            WriteVarDeclaration(parcours->var, tofile, 1, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+/******************************************************************************/
+/*                      writedeclarationintoamr                               */
+/******************************************************************************/
+/* This subroutine is used to write the declaration of parameters needed in   */
+/*    allocation subroutines creates in toamr.c                               */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout,
+                              variable *var , const char *commonname,
+                           listnom *neededparameter, const char *name_common)
+{
   listvar *newvar;
   variable *v;
-  char ligne[LONG_4C];
-
-  filecommon=fileout;
-  newvar = var_record;
-  
-  if ( newvar->var->v_save == 0 || inmodulemeet == 0 )
-  {
-     v = newvar->var;
-     if (mark == 1) fprintf(fileout,"222222233333333\n");
-     WriteBeginDeclaration(v,ligne,visibility);
-
-     if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne);
-     else WriteTableDeclaration(v,ligne,value);
-
-     if ( v->v_VariableIsParameter != 1 && strcasecmp(v->v_initialvalue,"") )
-     {
-        strcat(ligne," = ");
-        strcat(ligne,v->v_initialvalue);
-     }
-     
-     tofich (filecommon, ligne,1);
-     if (mark == 1) fprintf(fileout,"44444433333333\n");     
-  }
-  Save_Length(ligne,45);
-  
-}
-
-
-void WriteLocalParamDeclaration()
-{
-   listvar *parcours;
-
-   parcours = List_Parameter_Var;
-   while ( parcours )
-   {
-      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
-      {
-         writevardeclaration(parcours,fortranout,0,1);
-      }
-      parcours = parcours -> suiv;
-   }
-}
-
-void WriteFunctionDeclaration(int value)
-{
-   listvar *parcours;
-
-   parcours = List_FunctionType_Var;
-   while ( parcours )
-   {
-      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
-            strcasecmp(parcours->var->v_typevar,"")
-         )
-      {
-         writevardeclaration(parcours,fortranout,value,1);
-      }
-      parcours = parcours -> suiv;
-   }
-}
-
-void WriteSubroutineDeclaration(int value)
-{
-   listvar *parcours;
-
-   parcours = List_SubroutineDeclaration_Var;
-   while ( parcours )
-   {
-      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
-           parcours->var->v_save == 0                                  &&
-           parcours->var->v_pointerdeclare == 0                        &&
-           parcours->var->v_VariableIsParameter == 0                   &&
-           parcours->var->v_common == 0
-         )
-      {
-         writevardeclaration(parcours,fortranout,value,1);
-
-      }
-      else if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
-           parcours->var->v_save == 0                                  &&
-           parcours->var->v_VariableIsParameter == 0                   &&
-           parcours->var->v_common == 0
-              )
-      {
-         writevardeclaration(parcours,fortranout,value,1);
-
-      }
-      parcours = parcours -> suiv;
-   }
-}
-
-void WriteArgumentDeclaration_beforecall()
-{
-   int position;
-   listnom *neededparameter;
-   FILE *paramtoamr;
-   listvar *newvar;
-   char ligne[LONG_4C];
-
-   fprintf(fortranout,"#include \"Param_BeforeCall_%s.h\" \n",subroutinename);
-   /*                                                                         */
-   sprintf(ligne,"Param_BeforeCall_%s.h",subroutinename);
-   paramtoamr = associate (ligne);
-   /*                                                                         */
-   neededparameter = (listnom * )NULL;
-   /*                                                                         */
-   position = 1;
-   newvar = List_SubroutineArgument_Var;
-   while ( newvar )
-   {
-      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
-                       newvar->var->v_positioninblock == position
-         )
-      {
-         position = position + 1;
-
-         writevardeclaration(newvar,fortranout,0,1);
-         neededparameter = writedeclarationintoamr(List_Parameter_Var,
-                   paramtoamr,newvar->var,newvar->var->v_subroutinename,
-                   neededparameter,subroutinename);
-
-         newvar = List_SubroutineArgument_Var;
-      }
-      else newvar = newvar -> suiv;
-   }
-   Save_Length(ligne,45);
-   fclose(paramtoamr);
-}
-
-void WriteArgumentDeclaration_Sort()
-{
-   int position;
-   listvar *newvar;
-
-   /*                                                                         */
-   position = 1;
-   newvar = List_SubroutineArgument_Var;
-   while ( newvar )
-   {
-      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
-                       newvar->var->v_positioninblock == position
-         )
-      {
-         position = position + 1;
-
-         writevardeclaration(newvar,fortranout,1,1);
-         /*                                                                   */
-         newvar = List_SubroutineArgument_Var;
-      }
-      else newvar = newvar -> suiv;
-   }
-   /*                                                                         */
-   newvar = List_SubroutineArgument_Var;
-   while ( newvar )
-   {
-      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
-                       newvar->var->v_positioninblock == 0           &&
-                       newvar->var->v_nbdim == 0
-         )
-      {
-
-         writevardeclaration(newvar,fortranout,1,1);
-      }
-      newvar = newvar -> suiv;
-   }
-   /*                                                                         */
-   newvar = List_SubroutineArgument_Var;
-   while ( newvar )
-   {
-      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
-                       newvar->var->v_positioninblock == 0           &&
-                       newvar->var->v_nbdim != 0
-         )
-      {
-         writevardeclaration(newvar,fortranout,1,1);
-      }
-      newvar = newvar -> suiv;
-   }
-}
-
-/******************************************************************************/
-/*                      writedeclarationintoamr                               */
-/******************************************************************************/
-/* This subroutine is used to write the declaration of parameters needed in   */
-/*    allocation subroutines creates in toamr.c                               */
-/******************************************************************************/
-/*                                                                            */
-/*                                                                            */
-/******************************************************************************/
-listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout,
-                              variable *var , char commonname[LONG_C],
-                           listnom *neededparameter, char name_common[LONG_C])
-{
-  listvar *newvar;
-  variable *v;
-  char ligne[LONG_4C];
+  char ligne[LONG_M];
   int changeval;
   int out;
   int writeit;
   listnom *parcours;
-  listnom *parcoursprec;
-
-  parcoursprec = (listnom * )NULL;
 
   /* we should list the needed parameter                                      */
   if ( !strcasecmp(name_common,commonname) )
-     neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,
-                                                               neededparameter);
+     neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,neededparameter);
   /*                                                                          */
   parcours = neededparameter;
@@ -422,5 +423,5 @@
      while ( newvar && out == 0 )
      {
-     
+
         if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))
         {
@@ -443,5 +444,5 @@
      while ( newvar && out == 0 )
      {
-        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))        
+        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))
         {
            out=1;
@@ -455,6 +456,4 @@
      parcours=parcours->suiv;
    }
-  /*                                                                          */
-  tofich (fileout, "",1);
   parcours = neededparameter;
   while (parcours)
@@ -482,9 +481,9 @@
 //           v->v_allocatable = 0;
 //        }
-        WriteBeginDeclaration(v,ligne,1);
+        WriteBeginDeclaration(v, ligne, 1);
         if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne);
-        else WriteTableDeclaration(v,ligne,1);
-
-        tofich (fileout, ligne,1);
+        else WriteTableDeclaration(v, ligne, 1);
+
+        tofich(fileout, ligne, 1);
         if ( changeval == 1 )
         {
@@ -498,5 +497,5 @@
         {
            shouldincludempif = 0;
-           fprintf(fileout,"      include \'mpif.h\' \n");
+           fprintf(fileout,"      include \'mpif.h\'\n");
         }
      }
@@ -524,7 +523,7 @@
   listvar *newvar;
   variable *v;
-  char ligne[LONG_4C];
-
-  tofich (fileout, "",1);
+  char ligne[LONG_M];
+
+//   tofich (fileout, "",1);
   newvar = deb_common;
 
@@ -533,8 +532,5 @@
      if ( newvar->var->v_nbdim == 0 &&
           !strcasecmp(newvar->var->v_subroutinename,subroutinename)  &&
-/*RB*/
-           (newvar->var->v_pointerdeclare == 0  || !strcasecmp(newvar->var->v_typevar,"type"))  
-/*RBend*/
-         )
+           (newvar->var->v_pointerdeclare == 0 || !strcasecmp(newvar->var->v_typevar,"type")) )
      {
         v = newvar->var;
@@ -565,19 +561,16 @@
   listvar *newvar;
   variable *v;
-  char ligne[LONG_4C];
+  char ligne[LONG_M];
   int changeval;
 
-  tofich (fileout, "",1);
   newvar = deb_common;
   while (newvar)
   {
-  printf("newvar = %s %d %s\n",newvar->var->v_nomvar,newvar->var->v_pointerdeclare,newvar->var->v_typevar);
-     if ( newvar->var->v_nbdim != 0                                 &&
-          !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
-          (newvar->var->v_pointerdeclare == 0 || !strcasecmp(newvar->var->v_typevar,"type"))
-        )
+      v = newvar->var;
+//  printf("newvar = %s %d %s\n",newvar->var->v_nomvar,newvar->var->v_pointerdeclare,newvar->var->v_typevar);
+     if ( (v->v_nbdim != 0)  && !strcasecmp(v->v_subroutinename, subroutinename) &&
+          (v->v_pointerdeclare == 0 || !strcasecmp(v->v_typevar,"type")) )
      {
         changeval = 0;
-        v = newvar->var;
         if ( v->v_allocatable == 1)
         {
@@ -595,6 +588,6 @@
         }
 
-        WriteBeginDeclaration(v,ligne,1);
-        WriteTableDeclaration(v,ligne,1);
+        WriteBeginDeclaration(v, ligne, 1);
+        WriteTableDeclaration(v, ligne, 1);
         tofich (fileout, ligne,1);
         if ( changeval >= 1 ) v->v_allocatable = 1;
@@ -606,99 +599,70 @@
 }
 
-
 void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl)
 {
-listvar *parcours;
-listvar *parcours2;
-listvar *parcours3;
-int out;
-
-if (insubroutinedeclare == 1)
-{
-parcours = listdecl;
-while (parcours)
-{
-/*
-parcours2 = List_SubroutineArgument_Var;
-out = 0;
-while (parcours2 && out == 0)
-{
-if (!strcasecmp(parcours2->var->v_subroutinename,subroutinename) && !strcasecmp(parcours2->var->v_nomvar,parcours->var->v_nomvar))
- {
- out = 1;
- }
-parcours2 = parcours2->suiv;
-}
-*/
-out = LookingForVariableInList(List_SubroutineArgument_Var,parcours->var);
-if (out == 0) out = VariableIsInListCommon(parcours,List_Common_Var);
-
-
-
-if (out == 0) out = LookingForVariableInList(List_Parameter_Var,parcours->var);
-if (out == 0) out = LookingForVariableInList(List_FunctionType_Var,parcours->var);
-if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var,parcours->var);
-
-/*
-parcours2 = List_Common_Var;
-while (parcours2 && out == 0)
-{
-if (!strcasecmp(parcours2->var->v_commoninfile,mainfile) && !strcasecmp(parcours2->var->v_nomvar,parcours->var->v_nomvar))
- {
- out = 1;
- }
-parcours2 = parcours2->suiv;
-}
-*/
-//printf("nom = %s %d %d %d\n",parcours->var->v_nomvar,out,VariableIsParameter,SaveDeclare);
-if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0) 
-
-{
-writevardeclaration(parcours,fortranout,1,1);
-}
-//if (firstpass == 1 && out == 1)
-if (firstpass == 1)
-  {
-  if (VariableIsParameter == 0 && SaveDeclare == 0)
-    {
-    List_SubroutineDeclaration_Var = insertvar(List_SubroutineDeclaration_Var,parcours->var);
-    }
-  }
-parcours = parcours->suiv;
-}
-}
+    listvar *parcours;
+    variable *v;
+    int out;
+
+    if ( insubroutinedeclare )
+    {
+        parcours = listdecl;
+        while ( parcours )
+        {
+            v = parcours->var;
+                          out = LookingForVariableInList(List_SubroutineArgument_Var, v);
+            if (out == 0) out = VariableIsInListCommon(parcours, List_Common_Var);
+            if (out == 0) out = LookingForVariableInList(List_Parameter_Var, v);
+            if (out == 0) out = LookingForVariableInList(List_FunctionType_Var, v);
+            if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var, v);
+
+            if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0)
+            {
+                WriteVarDeclaration(v, fortran_out, 1, 1);
+            }
+            if (firstpass == 1)
+            {
+                if (VariableIsParameter == 0 && SaveDeclare == 0)
+                {
+                    List_SubroutineDeclaration_Var = insertvar(List_SubroutineDeclaration_Var, v);
+                }
+            }
+            parcours = parcours->suiv;
+        }
+    }
 }
 
 void ReWriteDataStatement_0(FILE * filout)
 {
-listvar *parcours;
-int out;
-char ligne[LONG_C];
-char initialvalue[LONG_C];
-
-if (insubroutinedeclare == 1)
-{
-parcours = List_Data_Var_Cur ;
-while (parcours)
-{
-out = VariableIsInListCommon(parcours,List_Common_Var);
-if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var,parcours->var);
-
-if (out == 0)
-{
-if (strncasecmp(parcours->var->v_initialvalue,"(/",2))
-{
-strcpy(initialvalue,parcours->var->v_initialvalue);
-}
-else
-{
-strncpy(initialvalue,&parcours->var->v_initialvalue[2],strlen(parcours->var->v_initialvalue)-4);
-strcpy(&initialvalue[strlen(parcours->var->v_initialvalue)-4],"\0");
-}
-sprintf(ligne,"data %s/%s/",parcours->var->v_nomvar,initialvalue);
-tofich(filout,ligne,1);
-}
-parcours = parcours->suiv;
-}
-}
-}
+    listvar *parcours;
+    int out;
+    char ligne[LONG_M];
+    char initialvalue[LONG_M];
+
+    if (insubroutinedeclare == 1)
+    {
+        parcours = List_Data_Var_Cur ;
+        while (parcours)
+        {
+            out = VariableIsInListCommon(parcours,List_Common_Var);
+            if (out)   break;
+
+            out = LookingForVariableInListGlobal(List_Global_Var,parcours->var);
+            if (out)   break;
+
+            if (strncasecmp(parcours->var->v_initialvalue,"(/",2))
+            {
+                strcpy(initialvalue,parcours->var->v_initialvalue);
+            }
+            else
+            {
+                strncpy(initialvalue,&parcours->var->v_initialvalue[2],strlen(parcours->var->v_initialvalue)-4);
+                strcpy(&initialvalue[strlen(parcours->var->v_initialvalue)-4],"\0");
+            }
+            sprintf(ligne,"data %s/%s/",parcours->var->v_nomvar,initialvalue);
+            tofich(filout,ligne,1);
+
+            parcours = parcours->suiv;
+        }
+    }
+}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.lex
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.lex	(revision 5659)
+++ 	(revision )
@@ -1,87 +1,0 @@
-/******************************************************************************/
-/*                                                                            */
-/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
-/*                                                                            */
-/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
-/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
-/* This software is governed by the CeCILL-C license under French law and     */
-/* abiding by the rules of distribution of free software.  You can  use,      */
-/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
-/* license as circulated by CEA, CNRS and INRIA at the following URL          */
-/* "http://www.cecill.info".                                                  */
-/*                                                                            */
-/* As a counterpart to the access to the source code and  rights to copy,     */
-/* modify and redistribute granted by the license, users are provided only    */
-/* with a limited warranty  and the software's author,  the holder of the     */
-/* economic rights,  and the successive licensors  have only  limited         */
-/* liability.                                                                 */
-/*                                                                            */
-/* In this respect, the user's attention is drawn to the risks associated     */
-/* with loading,  using,  modifying and/or developing or reproducing the      */
-/* software by the user in light of its specific status of free software,     */
-/* that may mean  that it is complicated to manipulate,  and  that  also      */
-/* therefore means  that it is reserved for developers  and  experienced      */
-/* professionals having in-depth computer knowledge. Users are therefore      */
-/* encouraged to load and test the software's suitability as regards their    */
-/* requirements in conditions enabling the security of their systems and/or   */
-/* data to be ensured and,  more generally, to use and operate it in the      */
-/* same conditions as regards security.                                       */
-/*                                                                            */
-/* The fact that you are presently reading this means that you have had       */
-/* knowledge of the CeCILL-C license and that you accept its terms.           */
-/******************************************************************************/
-/* version 1.7                                                                */
-/******************************************************************************/
-%s character
-%{
-#include <math.h>
-#include <stdlib.h>
-#include <string.h>
-int line_num=1;
-extern FILE * yyin;
-#define MAX_INCLUDE_DEPTH 30
-YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
-%}
-
-COMMENT "%"
-SEPARATEUR "::"
-NIMPORTEQUOI .
-COMMENTAIRES1 {COMMENT}{NIMPORTEQUOI}*{COMMENT}
-PROBTYPE "1D"|"2D"|"3D"
-USEITEM "FIXED_GRIDS"|"ONLY_FIXED_GRIDS"|"F77"
-NAME [a-zA-Z\_][a-zA-Z0-9\_]*
-DIGIT [0-9]+
-NEXTLINE \n+[ \t]+"$"|\n+[ \t]+"&"
-%%
-parammodule return TOK_MODULEMAIN; /* name of the module                      */
-notgriddep  return TOK_NOTGRIDDEP; /* variable which are not grid dependent   */
-use         return TOK_USE;
-{COMMENTAIRES1}    {}
-{SEPARATEUR}        return TOK_SEP;
-{USEITEM}          {strcpy(yylval.na,yytext); return TOK_USEITEM;}
-{PROBTYPE}         {strcpy(yylval.na,yytext); return TOK_PROBTYPE;}
-                                   /* dimension of the problem                */
-{NAME}             {strcpy(yylval.na,yytext); return TOK_NAME;}
-;|\,|\(|\)|:|\[|\] {return (int) *yytext;}
-\n                 {line_num++;return (int) *yytext;}
-[ \t]+ ;
-%%
-
-
-int yywrap()
-{
-}
-
-
-yyerror(char *s)
-{
-if (!strcasecmp(curfile,mainfile))
-{
-   printf("Dans convert %s line %d, fichier %s\n",s,line_num,curfile);
-}
-else
-{
-   printf("Dans convert %s line %d, fichier %s\n",s,line_num,curfile);
-}
-exit(0);
-}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.y
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.y	(revision 5659)
+++ 	(revision )
@@ -1,450 +1,0 @@
-/******************************************************************************/
-/*                                                                            */
-/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
-/*                                                                            */
-/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
-/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
-/* This software is governed by the CeCILL-C license under French law and     */
-/* abiding by the rules of distribution of free software.  You can  use,      */
-/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
-/* license as circulated by CEA, CNRS and INRIA at the following URL          */
-/* "http://www.cecill.info".                                                  */
-/*                                                                            */
-/* As a counterpart to the access to the source code and  rights to copy,     */
-/* modify and redistribute granted by the license, users are provided only    */
-/* with a limited warranty  and the software's author,  the holder of the     */
-/* economic rights,  and the successive licensors  have only  limited         */
-/* liability.                                                                 */
-/*                                                                            */
-/* In this respect, the user's attention is drawn to the risks associated     */
-/* with loading,  using,  modifying and/or developing or reproducing the      */
-/* software by the user in light of its specific status of free software,     */
-/* that may mean  that it is complicated to manipulate,  and  that  also      */
-/* therefore means  that it is reserved for developers  and  experienced      */
-/* professionals having in-depth computer knowledge. Users are therefore      */
-/* encouraged to load and test the software's suitability as regards their    */
-/* requirements in conditions enabling the security of their systems and/or   */
-/* data to be ensured and,  more generally, to use and operate it in the      */
-/* same conditions as regards security.                                       */
-/*                                                                            */
-/* The fact that you are presently reading this means that you have had       */
-/* knowledge of the CeCILL-C license and that you accept its terms.           */
-/******************************************************************************/
-/* version 1.7                                                                */
-/******************************************************************************/
-%{
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include "decl.h"
-%}
-
-%union {
-       int ival;
-       char na[LONG_C];
-       listnom * ln;
-       }
-
-%token TOK_SEP
-%token TOK_USE
-%token TOK_MODULEMAIN      /* name of the module                              */
-%token TOK_NOTGRIDDEP      /* Variable which are not grid dependent           */
-%token <na> TOK_USEITEM
-%token <na> TOK_NAME
-%token <na> TOK_PROBTYPE   /* dimension of the problem                        */
-%token ','
-%token ';'
-%token ':'
-%token '('
-%token ')'
-%token '['
-%token ']'
-%%
-input :
-      | input line
-;
-line :'\n'
-      | TOK_PROBTYPE TOK_NAME ';'                   {initdimprob(1,$2,"0","0");}
-      | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ';'      {initdimprob(2,$2, $4,"0");}
-      | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ',' TOK_NAME ';'
-                                                    {initdimprob(3,$2, $4, $6);}
-      | TOK_MODULEMAIN TOK_NAME ';'
-                             {listofmodules = Addtolistnom($2,listofmodules,0);
-                                                        Addmoduletothelist($2);}
-      | TOK_NOTGRIDDEP TOK_SEP TOK_NAME ';'       {Add_NotGridDepend_Var_1($3);}
-      | TOK_USE TOK_USEITEM ';'  {
-                                    if (!strcasecmp($2,"FIXED_GRIDS"))
-                                                                 fixedgrids=1;
-                                    if (!strcasecmp($2,"ONLY_FIXED_GRIDS"))
-                                                             onlyfixedgrids=1;
-                                 }
-      ;
-%%
-
-int main(int argc,char *argv[])
-{
-   extern FILE * yyin ;
-   FILE *dependglobaloutput;
-   int i;
-   listnom *parcours;
-   listvar *newvar;
-   int stylegiven = 0;
-   int infreegiven ;
-   int infixedgiven ;
-   int lengthmainfile;
-
-   if (argc < 2)
-   {
-       printf("usage : conv <file> [-rm] [-incdir <directory>] \n");
-       printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
-       printf(" [-convfile  <FILENAME >] -SubloopScalar -SubloopScalar1 \n");
-       printf(" [-free|-fixed]\n");
-       exit(0);
-   }
-/******************************************************************************/
-/*  1-  Variables initialization                                              */
-/******************************************************************************/
-   List_Global_Var=(listvar *)NULL;
-   List_GlobalParameter_Var=(listvar *)NULL;
-   List_Allocate_Var=(listallocate *)NULL;
-   List_Common_Var=(listvar *)NULL;
-   List_SubroutineWhereAgrifUsed=(listnom *)NULL;
-   List_Subroutine_For_Alloc=(listnom *)NULL;
-   List_Include=(listusemodule *)NULL;
-   List_NameOfModuleUsed=(listusemodule *)NULL;
-   listofmoduletmp=(listusemodule *)NULL;
-   List_SubroutineDeclaration_Var=(listvar *)NULL;
-   List_UsedInSubroutine_Var=(listvar *)NULL;
-   List_NotGridDepend_Var=(listvar *)NULL;
-   Listofavailableindices=(listindice *)NULL;
-   List_CouplePointed_Var=(listvarpointtovar *)NULL;
-   List_ModuleUsed_Var = (listvar *)NULL;
-   List_ModuleUsedInModuleUsed_Var = (listvar *)NULL;
-   List_GlobParamModuleUsed_Var = (listparameter *)NULL;
-   List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *)NULL;
-   List_SubroutineArgument_Var = (listvar *)NULL;
-   List_FunctionType_Var = (listvar *)NULL;
-   tmpuselocallist = (listusemodule *)NULL;
-   List_ContainsSubroutine = (listnom *)NULL;
-   oldfortranout = (FILE *)NULL;
-
-   strcpy(mainfile,argv[1]);
-   strcpy(nomdir,"AGRIF_INC");
-   strcpy(commondirin,".");
-   strcpy(commondirout,".");
-   strcpy(filetoparse," ");
-   strcpy(subofagrifinitgrids,"");
-   strcpy(meetagrifinitgrids,"");
-   strcpy(mpiinitvar,"");
-
-   length_last = 0 ;
-   length_first = 0 ;
-   length_v_typevar = 0 ;
-   length_v_nomvar = 0 ;
-   length_v_dimchar = 0 ;
-   length_v_modulename = 0 ;
-   length_v_commonname = 0 ;
-   length_v_vallengspec = 0 ;
-   length_v_nameinttypename = 0 ;
-   length_v_commoninfile = 0 ;
-   length_v_subroutinename = 0 ;
-   length_v_precision = 0 ;
-   length_v_IntentSpec = 0 ;
-   length_v_initialvalue = 0 ;
-   length_v_readedlistdimension = 0 ;
-   length_u_usemodule = 0 ;
-   length_u_charusemodule = 0 ;
-   length_u_cursubroutine = 0 ;
-   length_u_modulename = 0 ;
-   length_n_name = 0 ;
-   length_c_namevar = 0 ;
-   length_c_namepointedvar = 0 ;
-   length_o_nom = 0 ;
-   length_o_module = 0 ;
-   length_a_nomvar = 0 ;
-   length_a_subroutine = 0 ;
-   length_a_module = 0 ;
-   length_t_usemodule = 0 ;
-   length_t_cursubroutine = 0 ;
-   length_curfilename = 0 ;
-   length_nomfileoutput = 0 ;
-   length_motparse = 0 ;
-   length_mainfile = 0 ;
-   length_nomdir = 0 ;
-   length_commondirout = 0 ;
-   length_commondirin = 0 ;
-   length_filetoparse = 0 ;
-   length_curbuf = 0 ;
-   length_toprintglob = 0 ;
-   length_tmpvargridname = 0 ;
-   length_ligne_Subloop = 0 ;
-   length_lvargridname_toamr = 0 ;
-   length_toprint_utilagrif = 0 ;
-   length_toprinttmp_utilchar = 0 ;
-   length_ligne_writedecl = 0 ;
-   length_newname_toamr = 0 ;
-   length_newname_writedecl = 0 ;
-   length_ligne_toamr = 0 ;
-   length_tmpligne_writedecl = 0 ;
-   value_char_size = 0 ;
-   value_char_size1 = 0 ;
-   value_char_size2 = 0 ;
-   value_char_size3 = 0 ;
-   inallocate = 0;
-   infixed = 1;
-   infree  = 0;
-
-   checkexistcommon=1;
-   todebug=0;
-   onlyfixedgrids=0;
-   fixedgrids=0;
-   InAgrifParentDef = 0;
-   IndicenbmaillesX=0;
-   IndicenbmaillesY=0;
-   IndicenbmaillesZ=0;
-   created_dimensionlist = 1;
-   indicemaxtabvars = 0;   /* current indice in the table tabvars             */
-   SubloopScalar = 0;
-   todebug = 0;
-   todebugfree = 0;
-   retour77 = 1 ;
-   mark = 0 ;
-   shouldincludempif = 0 ;
-   Read_val_max();
-/******************************************************************************/
-/*  2-  Program arguments                                                     */
-/******************************************************************************/
-
-   if ((yyin=fopen(argv[1],"r"))==NULL)
-   {
-      printf("the file %s doesn't exist \n",argv[1]);
-      exit(0);
-   }
-
-   i=2;
-   while (i<argc)
-   {
-      if (!strcasecmp(argv[i],"-incdir"))
-      {
-         strcpy(nomdir,argv[i+1]);
-         i++;
-      }
-      else if (!strcasecmp(argv[i],"-comdirin")) /* input directory           */
-      {
-         strcpy(commondirin,argv[i+1]);
-         i++;
-      }
-      else if (!strcasecmp(argv[i],"-comdirout")) /* output directory         */
-      {
-         strcpy(commondirout,argv[i+1]);
-         i++;
-      }
-      else if (!strcasecmp(argv[i],"-convfile")) /* file to parse             */
-      {
-         strcpy(filetoparse,argv[i+1]);
-         i++;
-         lengthmainfile = strlen(filetoparse);
-         if (!strcasecmp(&filetoparse[lengthmainfile-4],".f90"))
-         {
-         infixed = 0;
-         infree = 1;
-         }
-         else
-         {
-         infixed = 1;
-         infree = 0;
-         }
-      }
-      else if (!strcasecmp(argv[i],"-free")) /* file to parse        */
-      {
-         stylegiven = 1;
-         infreegiven  = 1 ;
-         infixedgiven = 0;
-      }   
-      else if (!strcasecmp(argv[i],"-fixed")) /* file to parse        */
-      {
-         stylegiven = 1;
-         infreegiven  = 0;
-         infixedgiven = 1;
-      }         
-      else if (!strcasecmp(argv[i],"-SubloopScalar")) /* file to parse        */
-      {
-         SubloopScalar = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-SubloopScalar1")) /* file to parse       */
-      {
-         SubloopScalar = 2 ;
-      }
-      else if (!strcasecmp(argv[i],"-todebug")) /* file to parse       */
-      {
-         todebug = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-mark")) /* file to parse       */
-      {
-         mark = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-todebugfree")) /* file to parse       */
-      {
-         todebugfree = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-rm"))
-      {
-         checkexistcommon=0;
-      }
-      else
-      {
-         printf("Unkwon option : %s\n",argv[i]);
-         exit(0);
-      }
-      i++;
-   }
-
-   if (stylegiven == 1) 
-   {
-   infree = infreegiven;
-   infixed = infixedgiven;   
-   }
-   Save_Length(nomdir,34);
-   Save_Length(commondirout,35);
-   Save_Length(commondirin,36);
-   Save_Length(filetoparse,37);
-
-/******************************************************************************/
-/*  3-  Parsing of the  conv file <name>.in                                   */
-/******************************************************************************/
-
-   if ((yyin=fopen(argv[1],"r"))==NULL)
-   {
-       printf("the file %s doesn't exist \n",argv[1]);
-       exit(0);
-   }
-   strcpy(mainfile,argv[1]);
-   Save_Length(mainfile,33);
-
-   if ( strstr(filetoparse,".f90") ||
-        strstr(filetoparse,".F90") ) retour77 = 0;
-
-   yyparse();
-
-/******************************************************************************/
-/*  4-  Preparation of the file parsing                                       */
-/******************************************************************************/
-   if ((yyin=fopen(filetoparse,"r"))==NULL) /* Is the file to parse exist ?   */
-   {
-      printf("the file %s doesn't exist \n",filetoparse);
-      exit(0);
-   }
-   /* mainfile : the name of the file to parse                                */
-   strcpy(mainfile,filetoparse);
-   /*                                                                         */
-   if ((dependglobaloutput=fopen(".dependglobal_agrif","r"))!=NULL)
-   {
-      fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars);
-      fclose(dependglobaloutput);
-   }
-   Readthedependavailablefile();
-   /* Read the .dependnbxnby file which contains indices of nbmaillsX,        */
-   /*    nbmailleY and nbmailleZ                                              */
-   Readthedependnbxnbyfile();
-   Read_Subroutine_For_Alloc();
-/******************************************************************************/
-/*  5-  Parsing of the input file (2 times)                                   */
-/******************************************************************************/
-   /* Record all variable in list                                             */
-   firstpass = 1;
-   processfortran(filetoparse);
-   /*                                                                         */
-   CompleteThelistvarindoloop();
-   /* Read list of module used                                                */
-   RecordUseModulesVariables();
-   /* Read list of module used in module used                                 */
-   RecordUseModulesUseModulesVariables();
-   /* Save variables are considered as globals ones                           */
-   Update_List_Global_Var_From_List_Save_Var();
-   /* Update all lists                                                        */
-   ListUpdate();
-   /*                                                                         */
-   Clean_List_Global_Var();
-   /* Indice tabvars identification                                           */
-   IndiceTabvarsIdentification();
-   /* Update all lists                                                        */
-   ListUpdate();
-   /* The allocation subroutine is necessary ????                             */
-   New_Allocate_Subroutine_Is_Necessary();
-   /* The allocation subroutine is necessary for common list                  */
-   New_Allocate_Subroutine_For_Common_Is_Necessary();
-   /* Sort List_SubroutineArgument_Var                                        */
-   Sort_List_SubroutineArgument_Var();
-   /* Clean all lists                                                         */
-   ListClean();
-   /* Update Indice of List_UsedInSubroutine_Var from module used             */
-   List_UsedInSubroutine_Var_Update_From_Module_Used();
-   /* Update List_SubroutineWhereAgrifUsed                                    */
-   UpdateList_SubroutineWhereAgrifUsed();
-   /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
-   UpdateList_UsedInSubroutine_With_dimension();;
-   /*                                                                         */
-   ModifyThelistvarindoloop();
-   /*                                                                         */
-   UpdateListDeclarationWithDimensionList();
-   /*                                                                         */
-   GiveTypeOfVariables();
-   Affiche();
-   /* Build new subroutines                                                   */
-   firstpass = 0;
-   processfortran(filetoparse);
-
-   newvar = (listvar *)NULL;
-/*newvar = List_Global_Var; */
-   while ( newvar )
-   {
-      printf("++++ %s %d %s %s %s\n",
-      newvar->var->v_nomvar,
-      newvar->var->v_nbdim,
-      newvar->var->v_subroutinename,
-      newvar->var->v_modulename,
-      newvar->var->v_typevar
-             );
-      newvar = newvar->suiv;
-   }
-/******************************************************************************/
-/*  6-  Write informations in output files                                    */
-/******************************************************************************/
-
-   /* Write the .dependglobal_agrif file which contain the max indice         */
-   /*    of the tabvars table                                                 */
-   dependglobaloutput = fopen(".dependglobal_agrif","w");
-   fprintf(dependglobaloutput,"%d\n",indicemaxtabvars);
-   fclose(dependglobaloutput);
-   /* Write the list of available indice                                      */
-   Writethedependavailablefile();
-   /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
-   /*    nbmailleY and nbmailleZ                                              */
-   Writethedependnbxnbyfile();
-   /* Write the .depend<namefile> file which contain general informations     */
-   /*    about variable of this file                                          */
-   parcours = List_NameOfModule;
-   while( parcours )
-   {
-      Writethedependlistofmoduleused(parcours->o_nom);
-      WritedependParameterList(parcours->o_nom);
-      Writethedependfile(parcours->o_nom,List_Global_Var);
-      parcours=parcours->suiv;
-   }
-   parcours = List_NameOfCommon;
-   while( parcours )
-   {
-      Writethedependfile(parcours->o_nom,List_Common_Var);
-      parcours=parcours->suiv;
-   }
-   Write_Subroutine_For_Alloc();
-/******************************************************************************/
-/*  7-  Create files in AGRIF_INC directory                                   */
-/******************************************************************************/
-   creefichieramr(NameTamponfile);
-
-   Write_val_max();
-
-   if ( todebug == 1 ) printf("Out of CONV \n");
-   return 0;
-}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h	(revision 5682)
@@ -33,10 +33,10 @@
 /* version 1.7                                                                */
 /******************************************************************************/
-#define LONGNOM 8000
-
-#define LONG_C 3000
-#define LONG_4C 4000
-#define LONG_4M 4000
-#define LONG_40M 4000000
+#define LONG_VNAME 80		// Max length for a variable name
+#define LONG_FNAME 1000		// Max length for a file name
+#define LONG_C     200
+#define LONG_M     1500
+
+#define NB_CAT_VARIABLES 5
 
 /******************************************************************************/
@@ -46,6 +46,6 @@
 typedef struct
 {
-   char first[LONG_C];
-   char last[LONG_C];
+   char first[LONG_M];
+   char last[LONG_M];
 } typedim ;                /* fortran dimension as 'ndeb:nfin'                */
 
@@ -58,18 +58,18 @@
 typedef struct variable
 {
-   char v_typevar[LONG_C];
-   char v_nomvar[LONG_C] ;
-   char v_oldname[LONG_C] ;
-   char v_dimchar[LONG_C];
-   char v_modulename[LONG_C];
-   char v_commonname[LONG_C];
-   char v_vallengspec[LONG_C];
-   char v_nameinttypename[LONG_C];
-   char v_commoninfile[LONG_C];
-   char v_subroutinename[LONG_C];
+   char v_typevar[LONG_VNAME];
+   char v_nomvar[LONG_VNAME] ;
+   char v_oldname[LONG_VNAME] ;
+   char v_dimchar[LONG_VNAME];
+   char v_modulename[LONG_VNAME];
+   char v_commonname[LONG_VNAME];
+   char v_vallengspec[LONG_VNAME];
+   char v_nameinttypename[LONG_VNAME];
+   char v_commoninfile[LONG_FNAME];
+   char v_subroutinename[LONG_VNAME];
    char v_precision[LONG_C];
-   char v_initialvalue[LONG_4C];
-   char v_IntentSpec[LONG_C];
-   char v_readedlistdimension[LONG_C];
+   char v_initialvalue[LONG_M];
+   char v_IntentSpec[LONG_M];
+   char v_readedlistdimension[LONG_M];
    int  v_nbdim;
    int  v_common;
@@ -77,4 +77,5 @@
    int  v_module;
    int  v_save;
+   int  v_catvar;
    int  v_VariableIsParameter;
    int  v_PublicDeclare;
@@ -110,8 +111,8 @@
 typedef struct listusemodule
 {
-   char u_usemodule[LONG_C];
-   char u_charusemodule[LONG_C];
-   char u_cursubroutine[LONG_C];
-   char u_modulename[LONG_C];
+   char u_usemodule[LONG_VNAME];
+   char u_charusemodule[LONG_VNAME];
+   char u_cursubroutine[LONG_VNAME];
+   char u_modulename[LONG_VNAME];
    int  u_firstuse;
    struct listusemodule * suiv;
@@ -120,6 +121,6 @@
 typedef struct listparameter
 {
-   char p_name[LONG_C];
-   char p_modulename[LONG_C];
+   char p_name[LONG_M];
+   char p_modulename[LONG_M];
    struct listparameter * suiv;
 } listparameter ;           /* list of names                                  */
@@ -127,5 +128,5 @@
 typedef struct listname
 {
-   char n_name[LONG_C];
+   char n_name[LONG_VNAME];
    struct  listname* suiv;
 } listname ;            /* list of names                                  */
@@ -133,6 +134,6 @@
 typedef struct listcouple
 {
-   char c_namevar[LONG_C];
-   char c_namepointedvar[LONG_C];
+   char c_namevar[LONG_VNAME];
+   char c_namepointedvar[LONG_VNAME];
    struct listcouple * suiv;
 } listcouple;              /* list of names                                   */
@@ -142,6 +143,6 @@
 {
    char o_nom[LONG_C];
-   char o_module[LONG_C];
-   char o_subroutinename[LONG_C];
+   char o_module[LONG_VNAME];
+   char o_subroutinename[LONG_M];
    int  o_val;
    listcouple *couple;
@@ -153,6 +154,6 @@
 {
    char a_nomvar[LONG_C];
-   char a_subroutine[LONG_C];
-   char a_module[LONG_C];
+   char a_subroutine[LONG_VNAME];
+   char a_module[LONG_VNAME];
    struct listallocate * suiv;
 } listallocate ;
@@ -161,6 +162,6 @@
 typedef struct listvarpointtovar
 {
-   char t_usemodule[LONG_C];
-   char t_cursubroutine[LONG_C];
+   char t_usemodule[LONG_VNAME];
+   char t_cursubroutine[LONG_VNAME];
    listcouple *t_couple;
    struct  listvarpointtovar* suiv;
@@ -209,4 +210,5 @@
  listnom *List_Subroutine_For_Alloc;
  listnom *listofmodules;
+ listnom *listofkind;
  listnom *List_NameOfModule;
  listnom *List_NameOfCommon;
@@ -220,4 +222,5 @@
  listindice *Listofavailableindices;
                            /* List of available indices in the tabvars table  */
+ listindice **Listofavailableindices_glob;
 
  listdim *curdim;
@@ -229,6 +232,6 @@
 
  int positioninblock;
- char commonvar[LONG_C];
- char commonblockname[LONG_C];
+ char commonvar[LONG_VNAME];
+ char commonblockname[LONG_VNAME];
 
 /******************************************************************************/
@@ -239,14 +242,14 @@
  int sameagrifargument;
  int InAgrifParentDef;
- char sameagrifname[LONG_C];
+ char sameagrifname[LONG_VNAME];
 /******************************************************************************/
 /****************   *** VAR DEF Variables ***   *******************************/
 /******************************************************************************/
- int indicemaxtabvars;     /* Number of variables in the model i.e. last      */
+ int indicemaxtabvars[NB_CAT_VARIABLES];     /* Number of variables in the model i.e. last      */
                            /*    indice used in  the tabvars table            */
  int PublicDeclare;        /* Variable has been declared as PUBLIC */
  int PrivateDeclare;       /* Variable has been declared as PRIVATE */
  int ExternalDeclare;      /* Variable has been declared as EXTERNAL */
- char InitialValueGiven[LONG_C];  
+ int InitialValueGiven;    /* An initial value has been given */
  int Allocatabledeclare;
  int Targetdeclare;
@@ -255,24 +258,21 @@
  int pointerdeclare;
  int optionaldeclare;
- int VarType;
- int VarTypepar;
+ int inside_type_declare;
  int VariableIsParameter;
  int dimsgiven;
  int shouldincludempif;
  int c_star;
- char DeclType[LONG_C];
- char nameinttypename[LONG_C];
- char nameinttypenameback[LONG_C]; 
+ char DeclType[LONG_VNAME];
+ char nameinttypename[LONG_VNAME];
+ char nameinttypenameback[LONG_VNAME];
  int GlobalDeclaration;
  int GlobalDeclarationType;
- char InitValue[LONG_4C];
- char IntentSpec[LONG_C];
+ char InitValue[LONG_M];
+ char IntentSpec[LONG_M];
  char NamePrecision[LONG_C];
- char CharacterSize[LONG_C];
- char curmodulename[LONG_C];
- char vallengspec[LONG_C];
- char subroutinename[LONG_C];
+ char CharacterSize[LONG_VNAME];
+ char vallengspec[LONG_VNAME];
  int isrecursive;
- char previoussubroutinename[LONG_C];
+ int is_result_present;
 
 /******************************************************************************/
@@ -283,10 +283,8 @@
  int onlyfixedgrids;       /* = 1 if onlyfixedgrids is true                   */
  int todebug;
- int mark;
- int todebugfree;
  int fixedgrids;           /* = 1 if fixedgrids is true                       */
- char nbmaillesX[LONG_C]; /* number of cells in the x direction              */
- char nbmaillesY[LONG_C]; /* number of cells in the y direction              */
- char nbmaillesZ[LONG_C]; /* number of cells in the z direction              */
+ char nbmaillesX[LONG_VNAME];	// number of cells in the x direction
+ char nbmaillesY[LONG_VNAME];	// number of cells in the y direction
+ char nbmaillesZ[LONG_VNAME];	// number of cells in the z direction
  int IndicenbmaillesX;
  int IndicenbmaillesY;
@@ -297,9 +295,7 @@
  int aftercontainsdeclare; /* Signale si l'on vient d'un contains ou non */
  int retour77;
- int colnum;
  int callagrifinitgrids;
  int callmpiinit;
  int firstpass;
- int couldaddvariable;
  int pointedvar;
  int NbMailleXDefined;
@@ -309,7 +305,6 @@
                            /*    only                                         */
                            /*    scalar and not table u(1,1,1) in place of u  */
- int checkexistcommon;
+ int inprogramdeclare;
  int insubroutinedeclare;
- int ininterfacedeclare;
  int inmoduledeclare;
  int dimsempty;
@@ -317,32 +312,26 @@
  int incontainssubroutine;
 
- char meetagrifinitgrids[LONG_C];
- char mpiinitvar[LONG_C];
- char *NameTamponfile;
- char toprintglob[LONG_4C];
- char tmpvargridname[LONG_4C];
- char EmptyChar[2];        /* An empty char */
- char curfilename[LONG_C];
- char nomfileoutput[LONG_C];
- char curbuf[LONG_40M];
- char motparse[LONG_4C];
- char motparse1[LONG_4C];
- char charusemodule[LONG_C];
- char subofagrifinitgrids[LONG_C];
- char curfile[LONG_C];
- char mainfile[LONG_C];
- char nomdir[LONG_C];
- char commondirout[LONG_C];
- char commondirin[LONG_C];
- char filetoparse[LONG_C];
-
- FILE *fortranout;          /* Output File                                    */
- FILE *fortranin;           /* Input File                                     */
- FILE *oldfortranout;
+ char meetagrifinitgrids[LONG_M];
+ char mpiinitvar[LONG_M];
+ char toprintglob[LONG_M];
+ char tmpvargridname[LONG_M];
+ char dependfilename[LONG_FNAME];
+ char charusemodule[LONG_VNAME];
+ char subofagrifinitgrids[LONG_M];
+ char curmodulename[LONG_VNAME];
+ char subroutinename[LONG_VNAME];
+ char cur_filename[LONG_FNAME];		// Name of the current parsed Fortran file
+ char config_file[LONG_FNAME];		// Name of conv configuration file (ex: amr.in)
+ char work_dir[LONG_FNAME];			// Work directory         (default: './')
+ char include_dir[LONG_FNAME];		// Include directory      (default: './AGRIF_INC')
+ char output_dir[LONG_FNAME];		// output directory       (default: './AGRIF_MODELFILES')
+ char input_dir[LONG_FNAME];		// source input directory (default: './')
+
+ FILE *fortran_out;          /* Output File                                    */
+ FILE *fortran_in;           /* Input File                                     */
+ FILE *oldfortran_out;
  FILE *subloop;
  FILE *module_declar;
- FILE *module_declar_type;
  FILE *allocationagrif;
- FILE *paramout;
 
  long int pos_cur;         /* current position in the output file             */
@@ -359,5 +348,4 @@
  long int pos_cursave;     /* current position in the output file             */
  long int pos_curdimension;/* current position in the output file             */
- long int pos_curinit;     /* current position in the output file             */
  long int pos_curinclude;  /* final position of a line in file                */
  long int pos_end;         /* final position of a line in file                */
@@ -365,80 +353,23 @@
                            /* final position of a line in file                */
 
-/* v_oldname = v_nomvar; */
-/* commonvar = v_nomvar; */
-/* commonblockname = v_commonname;*/
-/* sameagrifname = v_nomvar ; */
-/* DeclType = v_typevar; */
-/* nameinttypename = v_nameinttypename; */
-/* IntentSpec = v_IntentSpec; */
-/* NamePrecision = v_precision; */
-/* CharacterSize = v_dimchar; */
-/* curmodulename = v_modulename; */
-/* vallengspec = v_vallengspec; */
-/* subroutinename = v_subroutinename; */
-/* meetagrifinitgrids = v_subroutinename; */
-/* nbmaillesX = v_nomvar; */
-/* nbmaillesY = v_nomvar; */
-/* nbmaillesZ = v_nomvar; */
-/* mpiinitvar = v_nomvar; */
-/* EmptyChar = 2; */
-/* motparse1 = motparse;*/
-/* charusemodule = p_modulename; */
-/* subofagrifinitgrids = v_subroutinename; */
-/* curfile = mainfile; */
-/* InitValue = v_initialvalue; */
-
-/* p_name;???????? */
-/* p_modulename; ?????????????*/
-
- int length_last;
- int length_first;
- int length_v_typevar;
- int length_v_nomvar;
- int length_v_dimchar;
- int length_v_modulename;
- int length_v_commonname;
- int length_v_vallengspec;
- int length_v_nameinttypename;
- int length_v_commoninfile;
- int length_v_subroutinename;
- int length_v_precision;
- int length_v_IntentSpec;
- int length_v_initialvalue;
- int length_v_readedlistdimension;
- int length_u_usemodule;
- int length_u_charusemodule;
- int length_u_cursubroutine;
- int length_u_modulename;
- int length_n_name;
- int length_c_namevar;
- int length_c_namepointedvar;
- int length_o_nom;
- int length_o_module;
- int length_a_nomvar;
- int length_a_subroutine;
- int length_a_module;
- int length_t_usemodule;
- int length_t_cursubroutine;
- int length_curfilename;
- int length_nomfileoutput;
- int length_motparse;
- int length_mainfile;
- int length_nomdir;
- int length_commondirout;
- int length_commondirin;
- int length_filetoparse;
- int length_curbuf;
- int length_toprintglob;
- int length_tmpvargridname;
- int length_ligne_Subloop;
- int length_lvargridname_toamr;
- int length_toprint_utilagrif;
- int length_toprinttmp_utilchar;
- int length_ligne_writedecl;
- int length_newname_toamr;
- int length_newname_writedecl;
- int length_ligne_toamr;
- int length_tmpligne_writedecl;
+size_t length_last;
+size_t length_first;
+size_t length_v_vallengspec;
+size_t length_v_commoninfile;
+size_t length_v_precision;
+size_t length_v_IntentSpec;
+size_t length_v_initialvalue;
+size_t length_v_readedlistdimension;
+size_t length_a_nomvar;
+size_t length_toprintglob;
+size_t length_tmpvargridname;
+size_t length_ligne_Subloop;
+size_t length_toprint_utilagrif;
+size_t length_toprinttmp_utilchar;
+size_t length_ligne_writedecl;
+size_t length_newname_toamr;
+size_t length_newname_writedecl;
+size_t length_ligne_toamr;
+size_t length_tmpligne_writedecl;
  int value_char_size;
  int value_char_size1;
@@ -446,5 +377,5 @@
  int value_char_size3;
 
- 
+
  int inallocate;
  int infixed;
@@ -453,12 +384,15 @@
 /*********** Declaration of externals subroutines *****************************/
 /***************************************************** ************************/
+extern char *fortran_text;
 /******************************************************************************/
 /*********** convert.y ********************************************************/
 /******************************************************************************/
 extern int main(int argc,char *argv[]);
+extern int convert_error(const char *s);
 /******************************************************************************/
 /*********** fortran.y ********************************************************/
 /******************************************************************************/
-extern void processfortran(char *fichier_entree);
+extern void process_fortran(const char *input_file);
+extern int fortran_error(const char *s);
 /******************************************************************************/
 /*********** dependfile.c *****************************************************/
@@ -466,17 +400,15 @@
 extern void Writethedependnbxnbyfile();
 extern void Readthedependnbxnbyfile();
-extern void Writethedependlistofmoduleused(char *NameTampon );
-extern void Readthedependlistofmoduleused(char *NameTampon);
-extern void WritedependParameterList(char *NameTampon );
-extern listparameter *ReaddependParameterList(char *NameTampon,
-                                                        listparameter *listout);
-extern void Writethedependfile(char *NameTampon, listvar *input );
-extern listvar *Readthedependfile( char *NameTampon , listvar *listout);
+extern void Writethedependlistofmoduleused(const char *NameTampon );
+extern void Readthedependlistofmoduleused(const char *NameTampon);
+extern void WritedependParameterList(const char *NameTampon );
+extern listparameter *ReaddependParameterList(const char *NameTampon, listparameter *listout);
+extern void Writethedependfile(const char *NameTampon, listvar *input );
+extern listvar *Readthedependfile(const char *NameTampon , listvar *listout);
 extern void Write_Subroutine_For_Alloc();
 extern void Read_Subroutine_For_Alloc();
 extern void Writethedependavailablefile();
 extern void Readthedependavailablefile();
-extern int Did_filetoparse_readed(char *NameTampon);
-extern int Did_module_common_treaded(char *NameTampon);
+extern int is_dependfile_created(const char *NameTampon);
 extern void Write_val_max();
 extern void Read_val_max();
@@ -485,23 +417,23 @@
 /******************************************************************************/
 extern void Add_Common_var_1();
-extern listnom *Addtolistnom(char *nom, listnom *listin,int value);
-extern listname *Addtolistname(char *nom,listname *input);
-extern int ModuleIsDefineInInputFile(char *name);
-extern void Addmoduletothelisttmp(char *name);
-extern void Add_NameOfModule_1(char *nom);
-extern void Add_NameOfCommon_1(char *nom,char *cursubroutinename);
-extern void Add_CouplePointed_Var_1(char *namemodule,listcouple *couple);
-extern void Add_Include_1(char *name);
+extern listnom  *Addtolistnom(const char *nom, listnom *listin, int value);
+extern listname *Addtolistname(const char *nom, listname *input);
+extern int ModuleIsDefineInInputFile(const char *name);
+extern void Addmoduletothelisttmp(const char *name);
+extern void Add_NameOfModule_1(const char *nom);
+extern void Add_NameOfCommon_1(const char *nom, const char *cursubroutinename);
+extern void Add_CouplePointed_Var_1(const char *namemodule, listcouple *couple);
+extern void Add_Include_1(const char *name);
 extern void Add_ImplicitNoneSubroutine_1();
-extern void WriteIncludeDeclaration();
-extern void Add_Save_Var_1 (char *name,listdim *d);
+extern void WriteIncludeDeclaration(FILE* tofile);
+extern void Add_Save_Var_1 (const char *name,listdim *d);
 extern void Add_Save_Var_dcl_1 (listvar *var);
 /******************************************************************************/
 /*********** SubLoopCreation.c ************************************************/
 /******************************************************************************/
-extern void writeheadnewsub_0();
-extern void WriteVariablelist_subloop(FILE *outputfile,char *ligne);
-extern void WriteVariablelist_subloop_Call(FILE *outputfile,char *ligne);
-extern void WriteVariablelist_subloop_Def(FILE *outputfile,char *ligne);
+extern void WriteBeginof_SubLoop();
+extern void WriteVariablelist_subloop(char *ligne);
+extern void WriteVariablelist_subloop_Call(char **ligne, size_t line_length);
+extern void WriteVariablelist_subloop_Def(char *ligne);
 extern void WriteHeadofSubroutineLoop();
 extern void closeandcallsubloopandincludeit_0(int suborfun);
@@ -510,82 +442,70 @@
 /*********** toamr.c **********************************************************/
 /******************************************************************************/
-extern char *variablenameroottabvars (variable * var);
-extern char *variablenametabvars (variable * var, int iorindice);
-extern char *variablecurgridtabvars (variable * var,int ParentOrCurgrid);
-extern void WARNING_CharSize(variable *var);
-extern char *vargridnametabvars (variable * var,int iorindice);
-extern char *vargridcurgridtabvars (variable * var,int ParentOrCurgrid);
-extern char *vargridcurgridtabvarswithoutAgrif_Gr (variable * var);
-extern char *vargridparam (variable * v, int whichone);
+extern void WARNING_CharSize(const variable *var);
+extern const char * tabvarsname(const variable *var);
+extern const char * variablecurgridtabvars(int which_grid);
+extern const char * vargridnametabvars(const variable *var, int iorindice);
+extern const char * vargridcurgridtabvars(const variable *var, int which_grid);
+extern const char * vargridcurgridtabvarswithoutAgrif_Gr(const variable *var);
+extern const char * vargridparam(const variable *var);
 extern void write_probdimagrif_file();
 extern void write_keysagrif_file();
 extern void write_modtypeagrif_file();
-extern void write_createvarnameagrif_file(variable *v,FILE *createvarname,
-                                                                int *InitEmpty);
+extern void write_createvarnameagrif_file(variable *v,FILE *createvarname,int *InitEmpty);
+extern void write_initialisationsagrif_file(variable *v,FILE *initproc,int *VarnameEmpty);
 extern void write_Setnumberofcells_file();
 extern void write_Getnumberofcells_file();
-extern void write_initialisationsagrif_file(variable *v,FILE *initproc,
-                                                             int *VarnameEmpty);
 extern void Write_Alloc_Agrif_Files();
 extern int IndiceInlist(int indic, listindice *listin);
 extern void write_allocation_Common_0();
 extern void write_allocation_Global_0();
-extern void creefichieramr (char *NameTampon);
+extern void creefichieramr();
 /******************************************************************************/
 /*********** UtilAgrif.c ******************************************************/
 /******************************************************************************/
-extern int Vartonumber(char *tokname);
-extern int Agrif_in_Tok_NAME(char *tokname);
-extern void ModifyTheVariableName_0(char *ident,int lengthname);
-extern void Add_SubroutineWhereAgrifUsed_1(char *sub,char *mod);
+extern int Vartonumber(const char *tokname);
+extern int Agrif_in_Tok_NAME(const char *tokname);
+extern void ModifyTheVariableName_0(const char *ident,int lengthname);
+extern void Add_SubroutineWhereAgrifUsed_1(const char *sub, const char *mod);
 extern void AddUseAgrifUtil_0(FILE *fileout);
 extern void AddUseAgrifUtilBeforeCall_0(FILE *fileout);
-extern void NotifyAgrifFunction_0(char *ident);
-extern void ModifyTheAgrifFunction_0(char *ident);
-extern void AgriffunctionModify_0(char *ident,int whichone);
-extern void Instanciation_0(char *ident);
+extern void NotifyAgrifFunction_0(const char *ident);
+extern void ModifyTheAgrifFunction_0(const char *ident);
+extern void AgriffunctionModify_0(const char *ident,int whichone);
+extern void Instanciation_0(const char *ident);
 /******************************************************************************/
 /*********** UtilCharacter.c **************************************************/
 /******************************************************************************/
-extern void FindAndChangeNameToTabvars(char name[LONG_C],char toprint[LONG_4C],
+extern void FindAndChangeNameToTabvars(const char name[LONG_M],char toprint[LONG_M],
                                              listvar * listtosee, int whichone);
-extern char *ChangeTheInitalvaluebyTabvarsName(char *nom,listvar *listtoread,
-                                                                  int whichone);
-extern int IsVariableReal(char *nom);
-extern void IsVarInUseFile(char *nom);
-extern listnom *DecomposeTheNameinlistnom(char *nom, listnom * listout);
-extern void DecomposeTheName(char *nom);
-extern void convert2lower(char *name);
-extern int convert2int(char *name);
+extern const char *ChangeTheInitalvaluebyTabvarsName(const char *nom,listvar *listtoread);
+extern int IsVariableReal(const char *nom);
+extern void IsVarInUseFile(const char *nom);
+extern listnom *DecomposeTheNameinlistnom(const char *nom, listnom * listout);
+extern void DecomposeTheName(const char *nom);
+extern void convert2lower(char *lowername, const char* inputname);
+extern int convert2int(const char *name);
 /******************************************************************************/
 /*********** UtilFile.c *******************************************************/
 /******************************************************************************/
-extern FILE * associate (char *filename);
-extern FILE * associateaplus (char *filename);
+extern FILE * open_for_write (const char *filename);
+extern FILE * open_for_append (const char *filename);
 extern long int setposcur();
 extern long int setposcurname(FILE *fileout);
-extern long int setposcurinoldfortranout();
-extern void copyuse_0(char *namemodule);
-extern void copyuseonly_0(char *namemodule);
+extern void copyuse_0(const char *namemodule);
+extern void copyuseonly_0(const char *namemodule);
 /******************************************************************************/
 /*********** UtilFortran.c ****************************************************/
 /******************************************************************************/
-extern void initdimprob(int dimprobmod, char * nx, char * ny,char* nz);
-extern int Variableshouldberemove(char *nom);
+extern void initdimprob(int dimprobmod, const char *nx, const char *ny, const char *nz);
+extern int Variableshouldberemoved(const char *nom);
 extern int variableisglobal(listvar *curvar, listvar *listin);
 extern int VariableIsInListCommon(listvar *curvar,listvar *listin);
 extern int VariableIsInList(listvar *curvar,listvar *listin);
-extern void variableisglobalinmodule(listcouple *listin, char *module,
+extern void variableisglobalinmodule(listcouple *listin, const char *module,
                                                                  FILE *fileout,long int oldposcuruse);
-extern void Remove_Word_Contains_0();
-extern void Remove_Word_end_module_0(int modulenamelength);
-extern void Write_Word_Contains_0();
 extern void Write_Word_end_module_0();
-extern void Add_Subroutine_For_Alloc(char *nom);
-extern void Write_Alloc_Subroutine_0();
-extern void Write_Alloc_Subroutine_For_End_0();
-extern void Write_GlobalParameter_Declaration_0();
-extern void Write_GlobalType_Declaration_0();
-extern void Write_NotGridDepend_Declaration_0();
+extern void Add_Subroutine_For_Alloc(const char *nom);
+extern void Write_Closing_Module();
 extern int IsTabvarsUseInArgument_0();
 extern int ImplicitNoneInSubroutine();
@@ -593,29 +513,31 @@
 extern void Add_Pointer_Var_1(char *nom);
 extern int varispointer_0(char *ident);
-extern int VariableIsNotFunction(char *ident);
+extern int VariableIsFunction(const char *ident);
 extern int varistyped_0(char *ident);
+extern void dump_var(const variable* var);
 /******************************************************************************/
 /*********** UtilListe.c ******************************************************/
 /******************************************************************************/
 extern void Init_Variable(variable *var);
-extern listvar * AddListvarToListvar(listvar *l,listvar *glob,
-                                                            int ValueFirstpass);
-extern void CreateAndFillin_Curvar(char *type,variable *curvar);
-extern void duplicatelistvar(listvar *orig);
+extern listvar * AddListvarToListvar(listvar *l,listvar *glob, int ValueFirstpass);
+extern void CreateAndFillin_Curvar(const char *type, variable *curvar);
+// extern void duplicatelistvar(listvar *orig);
 extern listdim * insertdim(listdim *lin,typedim nom);
 extern void change_dim_char(listdim *lin,listvar * l);
-extern int num_dims(listdim *d);
-extern variable * createvar(char *nom,listdim *d);
+extern int get_num_dims(const listdim *d);
+extern variable * createvar(const char *nom, listdim *d);
 extern listvar * insertvar(listvar *lin,variable *v);
-extern listvar *settype(char *nom,listvar *lin);
+extern listvar * settype(const char *nom,listvar *lin);
 extern void printliste(listvar * lin);
 extern int IsinListe(listvar *lin,char *nom);
 extern listname *Insertname(listname *lin,char *nom,int sens);
 extern listname *concat_listname(listname *l1, listname *l2);
-extern void *createstringfromlistname(char *ligne, listname *lin);
+extern void createstringfromlistname(char *ligne, listname *lin);
 extern void printname(listname * lin);
 extern void removeglobfromlist(listname **lin);
 extern void writelistpublic(listname *lin);
 extern void Init_List_Data_Var();
+extern void  addprecision_derivedfromkind(variable *curvar);
+extern int get_cat_var(variable *var);
 /******************************************************************************/
 /*********** UtilNotGridDep.c *************************************************/
@@ -626,7 +548,6 @@
 /*********** WorkWithAllocatelist.c *******************************************/
 /******************************************************************************/
-extern void Add_Allocate_Var_1(char *nom,char *nommodule);
-extern int IsVarAllocatable_0(char *ident);
-extern int varisallocatable_0(char *ident);
+extern void Add_Allocate_Var_1(const char *nom, const char *nommodule);
+extern int IsVarAllocatable_0(const char *ident);
 /******************************************************************************/
 /*********** WorkWithglobliste.c **********************************************/
@@ -643,5 +564,5 @@
 /*********** WorkWithlistmoduleinfile.c ***************************************/
 /******************************************************************************/
-extern void Save_Length(char *nom, int whichone);
+extern void Save_Length(const char *nom, int whichone);
 extern void Save_Length_int(int val, int whichone);
 /******************************************************************************/
@@ -651,14 +572,14 @@
 extern void  RecordUseModulesUseModulesVariables();
 extern void Add_NameOfModuleUsed_1(char *name);
-extern void Addmoduletothelist(char *name);
-extern void WriteUsemoduleDeclaration(char *cursubroutinename);
+extern void Addmoduletothelist(const char *name);
+extern void WriteUsemoduleDeclaration(const char *cursubroutinename);
 /******************************************************************************/
 /*********** WorkWithlistvarindoloop.c ****************************************/
 /******************************************************************************/
-extern void Add_UsedInSubroutine_Var_1 (char *ident);
+extern void Add_UsedInSubroutine_Var_1 (const char *ident);
 extern void ajoutevarindoloop_definedimension (char *name);
 extern void  ModifyThelistvarindoloop();
 extern void  CompleteThelistvarindoloop();
-extern void CopyRecord(variable *var1,variable *var2);
+extern void Merge_Variables(variable *var1,variable *var2);
 extern void Update_List_Subroutine_Var(listvar *list_to_modify);
 extern void Update_List_Global_Var_From_List_Save_Var();
@@ -669,10 +590,11 @@
 extern int LookingForVariableInList(listvar *listin,variable *var);
 extern int LookingForVariableInListGlobal(listvar *listin,variable *var);
-extern int LookingForVariableInListName(listvar *listin,char *var);
+extern int LookingForVariableInListName(listvar *listin,const char *var);
 extern int LookingForVariableInListGlob(listvar *listin,variable *var);
-extern int LookingForVariableInListParamGlob(listparameter *listin,
-                                                                 variable *var);
+extern int LookingForVariableInListParamGlob(listparameter *listin, variable *var);
+extern variable *get_variable_in_list_from_name(listvar *listin, const char *name);
 extern void UpdateListDeclarationWithDimensionList();
 extern void Clean_List_UsedInSubroutine_Var();
+extern void Clean_List_ModuleUsed_Var();
 extern void Clean_List_SubroutineDeclaration_Var();
 extern void Clean_List_Global_Var();
@@ -692,6 +614,7 @@
 extern void UpdateList_SubroutineWhereAgrifUsed();
 extern void UpdateList_UsedInSubroutine_With_dimension();
-extern void Affiche();
+extern void Affiche(listvar *parcours);
 extern int SubInList_ContainsSubroutine();
+extern void update_indicemaxtabvars(variable *var,listindice **Listofindices);
 /******************************************************************************/
 /*********** WorkWithParameterlist.c ******************************************/
@@ -704,25 +627,22 @@
 /******************************************************************************/
 extern void Add_SubroutineArgument_Var_1(listvar *listtoadd);
-extern void Add_FunctionType_Var_1(char *nom);
-extern void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd);
+extern void Add_FunctionType_Var_1(const char *nom);
+// extern void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd);
 /******************************************************************************/
 /*********** Writedeclarations.c **********************************************/
 /******************************************************************************/
-extern void WriteBeginDeclaration(variable *v,char ligne[LONG_4C],int visibility);
-extern void WriteScalarDeclaration(variable *v,char ligne[LONG_4C]);
-extern void WriteTableDeclaration(variable * v,char ligne[LONG_4C],int tmpok);
-extern void writevardeclaration (listvar * var_record, FILE *fileout,
-                                                                     int value,int visibility);
-extern void WriteLocalParamDeclaration();
-extern void WriteFunctionDeclaration(int value);
+extern void WriteBeginDeclaration(variable *v,char ligne[LONG_M],int visibility);
+extern void WriteScalarDeclaration(variable *v,char ligne[LONG_M]);
+extern void WriteTableDeclaration(variable * v,char ligne[LONG_M],int tmpok);
+extern void WriteVarDeclaration( variable *v, FILE *fileout, int value, int visibility );
+extern void WriteLocalParamDeclaration(FILE* tofile);
+extern void WriteFunctionDeclaration(FILE* tofile, int value);
 extern void WriteSubroutineDeclaration(int value);
 extern void WriteArgumentDeclaration_beforecall();
-extern void WriteArgumentDeclaration_Sort();
-extern listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout,
-                                       variable *var , char commonname[LONG_C],
-                           listnom *neededparameter, char name_common[LONG_C]);
-extern void writesub_loopdeclaration_scalar (listvar * deb_common,
-                                                                 FILE *fileout);
-extern void writesub_loopdeclaration_tab (listvar * deb_common, FILE *fileout);
+extern void WriteArgumentDeclaration_Sort(FILE* tofile);
+extern listnom * writedeclarationintoamr(listvar *deb_common, FILE *fileout, variable *var,
+						const char *commonname, listnom *neededparameter, const char *name_common);
+extern void writesub_loopdeclaration_scalar(listvar *deb_common, FILE *fileout);
+extern void writesub_loopdeclaration_tab(listvar *deb_common, FILE *fileout);
 extern void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl);
 extern void ReWriteDataStatement_0(FILE * filout);
@@ -730,17 +650,13 @@
 /*********** WriteInFile.c ****************************************************/
 /******************************************************************************/
-extern void tofich_reste (FILE * filout, char *s,int returnlineornot);
-extern void tofich (FILE * filout, char *s, int returnlineornot);
+extern void tofich_reste (FILE * filout, const char *s, int do_returnline);
+extern void tofich (FILE * filout, const char *s, int do_returnline);
 extern void tofich_blanc (FILE * filout, int size);
-extern void tofich_line (FILE * filout, int size, int long position);
-extern void RemoveWordSET_0(FILE * filout, long int position,
-                                                         long int sizetoremove);
-extern void RemoveWordCUR_0(FILE * filout, long int position,
-                                                         long int sizetoremove);
+extern void RemoveWordSET_0(FILE * filout, long int position, int sizetoremove);
+extern void RemoveWordCUR_0(FILE * filout, int sizetoremove);
 
 /******************************************************************************/
 /*********** WorkWithlistofcoupled.c **********************************************/
-/******************************************************************************/                                                        
-extern int variscoupled_0(char *ident) ;
-extern char * getcoupledname_0(char *ident);
-extern void ModifyTheVariableNamecoupled_0(char *ident, char* coupledident);
+/******************************************************************************/
+extern int variscoupled_0(const char *ident) ;
+extern const char * getcoupledname_0(const char *ident);
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c	(revision 5682)
@@ -74,7 +74,6 @@
   int out;
 
-  /* We are looking for all the variable of the current filetoparse file      */
-  /*    in the List_Global_Var                                                */
-  parcours =List_Global_Var;
+  // We look in 'List_Global_Var' for all the variables of the current file to parse
+  parcours = List_Global_Var;
   out = 0;
   while (parcours && out == 0 )
@@ -96,5 +95,7 @@
   {
      NbMailleXDefined = 1;
-     dependfileoutput = fopen(".dependnbxnby","w");
+     sprintf(dependfilename, "%s/.dependnbxnby", work_dir);
+     dependfileoutput = fopen(dependfilename, "w");
+
      fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars);
      IndicenbmaillesX = parcours->var->v_indicetabvars;
@@ -169,13 +170,14 @@
 void Readthedependnbxnbyfile()
 {
-  FILE *dependfileoutput;
-
-  if ((dependfileoutput = fopen(".dependnbxnby","r"))!=NULL)
-  {
-     fscanf(dependfileoutput,"%d\n",&IndicenbmaillesX);
-     if ( dimprob > 1 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesY);
-     if ( dimprob > 2 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesZ);
-     fclose(dependfileoutput);
-  }
+    FILE *dependfileoutput;
+
+    sprintf(dependfilename, "%s/.dependnbxnby", work_dir);
+    if ((dependfileoutput = fopen(dependfilename, "r"))!=NULL)
+    {
+        fscanf(dependfileoutput,"%d\n",&IndicenbmaillesX);
+        if ( dimprob > 1 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesY);
+        if ( dimprob > 2 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesZ);
+        fclose(dependfileoutput);
+    }
 }
 
@@ -192,27 +194,102 @@
 /*                                                                            */
 /******************************************************************************/
-void Writethedependlistofmoduleused(char *NameTampon )
+void Writethedependlistofmoduleused(const char *NameTampon )
+{
+    FILE *dependfileoutput;
+    listusemodule *parcours;
+    char lowername[LONG_VNAME];
+
+    if ( ! List_NameOfModuleUsed ) return;
+
+    convert2lower(lowername, NameTampon);
+    sprintf(dependfilename, "%s/.depend_use%s", work_dir, lowername);
+    dependfileoutput = fopen(dependfilename, "w");
+
+    parcours = List_NameOfModuleUsed;
+    while (parcours)
+    {
+    if ( !strcasecmp(lowername,parcours->u_modulename) &&
+         !strcasecmp(parcours->u_cursubroutine,"") )
+    {
+        // We look in 'List_NameOfModuleUsed' for all the variables of the current file to parse
+        fprintf(dependfileoutput,"%s\n",parcours->u_usemodule);
+    }
+    parcours = parcours->suiv;
+    }
+    fclose(dependfileoutput);
+}
+
+/******************************************************************************/
+/*                    Readthedependlistofmoduleused                           */
+/******************************************************************************/
+/* This subroutine is used to create the .dependuse<module>                   */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependuse<name>                                             */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+void Readthedependlistofmoduleused(const char *NameTampon)
 {
   FILE *dependfileoutput;
   listusemodule *parcours;
-  char ligne[LONG_C];
-
-
-  if ( List_NameOfModuleUsed )
-  {
-     convert2lower(NameTampon);
-     sprintf(ligne,".dependuse%s",NameTampon);
-     dependfileoutput = fopen(ligne,"w");
-     /*                                                                       */
-     parcours = List_NameOfModuleUsed;
+  char lowername[LONG_VNAME];
+
+  tmpuselocallist = (listusemodule *)NULL;
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_use%s", work_dir, lowername);
+
+  if ((dependfileoutput = fopen(dependfilename, "r"))!=NULL)
+  {
+    /* if the file exist we should verify that this file has changed          */
+      while (!feof(dependfileoutput))
+      {
+         parcours=(listusemodule *)calloc(1,sizeof(listusemodule));
+         fscanf(dependfileoutput,"%s\n",parcours->u_usemodule);
+
+         parcours->suiv = tmpuselocallist;
+         tmpuselocallist = parcours;
+
+         parcours = NULL;
+      }
+      fclose(dependfileoutput);
+  }
+}
+
+
+/******************************************************************************/
+/*                        WritedependParameterList                            */
+/******************************************************************************/
+/* This subroutine is used to create the .dependparameter<name>               */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependparameter<name>                                       */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+void WritedependParameterList(const char *NameTampon )
+{
+  FILE *dependfileoutput;
+  listvar *parcours;
+  char lowername[LONG_VNAME];
+
+  if ( List_GlobalParameter_Var )
+  {
+     convert2lower(lowername, NameTampon);
+     sprintf(dependfilename, "%s/.depend_paramater_%s", work_dir, lowername);
+
+     dependfileoutput = fopen(dependfilename, "w");
+     parcours = List_GlobalParameter_Var;
      while (parcours)
      {
-        if ( !strcasecmp(NameTampon,parcours->u_modulename) &&
-             !strcasecmp(parcours->u_cursubroutine,"")
-           )
-        {
-           /* We are looking for all the variable of the current              */
-           /*    filetoparse file in the List_Global_Var                      */
-           fprintf(dependfileoutput,"%s\n",parcours->u_usemodule);
+        if ( !strcasecmp(lowername, parcours->var->v_modulename) )
+        {
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_modulename);
         }
         parcours = parcours->suiv;
@@ -222,11 +299,12 @@
 }
 
-/******************************************************************************/
-/*                    Readthedependlistofmoduleused                           */
-/******************************************************************************/
-/* This subroutine is used to create the .dependuse<module>                   */
-/******************************************************************************/
-/*                                                                            */
-/*               .dependuse<name>                                             */
+
+/******************************************************************************/
+/*                         ReaddependParameterList                            */
+/******************************************************************************/
+/* This subroutine is used to create the .dependparameter<name>               */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependparameter<name>                                       */
 /*                                                                            */
 /*               mod1                                                         */
@@ -234,104 +312,19 @@
 /*                                                                            */
 /******************************************************************************/
-void Readthedependlistofmoduleused(char *NameTampon)
+listparameter *ReaddependParameterList(const char *NameTampon,listparameter *listout)
 {
   FILE *dependfileoutput;
-  listusemodule *parcours;
-  char ligne[LONG_C];
-
-  convert2lower(NameTampon);
-  sprintf(ligne,".dependuse%s",NameTampon);
-
-  tmpuselocallist = (listusemodule *)NULL;
-  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
-  {
-  }
-  else
+  listparameter *parcours;
+  char lowername[LONG_VNAME];
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_paramater_%s", work_dir, lowername);
+
+  if ((dependfileoutput = fopen(dependfilename,"r"))!=NULL)
   {
     /* if the file exist we should verify that this file has changed          */
       while (!feof(dependfileoutput))
       {
-         parcours=(listusemodule *)malloc(sizeof(listusemodule));
-         fscanf(dependfileoutput,"%s\n",parcours->u_usemodule);
-
-         parcours->suiv = tmpuselocallist;
-         tmpuselocallist = parcours;
-
-         parcours = NULL;
-      }
-      fclose(dependfileoutput);
-  }
-}
-
-
-/******************************************************************************/
-/*                        WritedependParameterList                            */
-/******************************************************************************/
-/* This subroutine is used to create the .dependparameter<name>               */
-/******************************************************************************/
-/*                                                                            */
-/*               .dependparameter<name>                                       */
-/*                                                                            */
-/*               mod1                                                         */
-/*               mod2                                                         */
-/*                                                                            */
-/******************************************************************************/
-void WritedependParameterList(char *NameTampon )
-{
-  FILE *dependfileoutput;
-  listvar *parcours;
-  char ligne[LONG_C];
-
-  if ( List_GlobalParameter_Var )
-  {
-     convert2lower(NameTampon);
-     sprintf(ligne,".dependparameter%s",NameTampon);
-     dependfileoutput = fopen(ligne,"w");
-     /*                                                                       */
-     parcours = List_GlobalParameter_Var;
-     while (parcours)
-     {
-        if ( !strcasecmp(NameTampon,parcours->var->v_modulename) )
-        {
-           fprintf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
-           fprintf(dependfileoutput,"%s\n",parcours->var->v_modulename);
-        }
-        parcours = parcours->suiv;
-     }
-     fclose(dependfileoutput);
-  }
-}
-
-
-/******************************************************************************/
-/*                         ReaddependParameterList                            */
-/******************************************************************************/
-/* This subroutine is used to create the .dependparameter<name>               */
-/******************************************************************************/
-/*                                                                            */
-/*               .dependparameter<name>                                       */
-/*                                                                            */
-/*               mod1                                                         */
-/*               mod2                                                         */
-/*                                                                            */
-/******************************************************************************/
-listparameter *ReaddependParameterList(char *NameTampon,listparameter *listout)
-{
-  FILE *dependfileoutput;
-  listparameter *parcours;
-  char ligne[LONG_C];
-
-  convert2lower(NameTampon);
-  sprintf(ligne,".dependparameter%s",NameTampon);
-
-  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
-  {
-  }
-  else
-  {
-    /* if the file exist we should verify that this file has changed          */
-      while (!feof(dependfileoutput))
-      {
-         parcours=(listparameter *)malloc(sizeof(listparameter));
+         parcours=(listparameter *)calloc(1,sizeof(listparameter));
          fscanf(dependfileoutput,"%s\n",parcours->p_name);
          fscanf(dependfileoutput,"%s\n",parcours->p_modulename);
@@ -367,22 +360,22 @@
 /*                                                                            */
 /******************************************************************************/
-void Writethedependfile(char *NameTampon, listvar *input )
+void Writethedependfile(const char *NameTampon, listvar *input )
 {
   FILE *dependfileoutput;
   listvar *parcours;
   listdim *dims;
-  char ligne[LONG_C];
-  char listdimension[LONG_C];
-  char curname[LONG_C];
+  char ligne[LONG_M];
+  char listdimension[LONG_M];
+  char curname[LONG_M];
+  char lowername[LONG_VNAME];
   int out;
 
   if ( input )
   {
-  convert2lower(NameTampon);
-
-  sprintf(ligne,".depend%s",NameTampon);
-  dependfileoutput = fopen(ligne,"w");
-  /* We are looking for all the variable of the current filetoparse file      */
-  /*    in the input                                                          */
+    convert2lower(lowername, NameTampon);
+    sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername);
+
+  dependfileoutput = fopen(dependfilename,"w");
+  // We look in 'input' for all the variables of the current file to parse
   parcours =input;
   out = 0;
@@ -390,6 +383,6 @@
   while (parcours && out == 0 )
   {
-     if ( !strcasecmp(parcours->var->v_modulename,NameTampon) ||
-          !strcasecmp(parcours->var->v_commonname,NameTampon) )
+     if ( !strcasecmp(parcours->var->v_modulename, lowername) ||
+          !strcasecmp(parcours->var->v_commonname, lowername) )
      {
         /*                                                                    */
@@ -402,8 +395,10 @@
            /********** TYPEVAR ************************************************/
            fprintf(dependfileoutput,"%s\n",parcours->var->v_typevar);
+           /********** CATVAR ************************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_catvar);
            /********** NOMVAR *************************************************/
            fprintf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
            /********** DIMCHAR ************************************************/
-           if ( strcasecmp(parcours->var->v_dimchar,"") )
+           if ( strcasecmp(parcours->var->v_dimchar, "") )
            {
               fprintf(dependfileoutput,"%s\n",parcours->var->v_dimchar);
@@ -479,5 +474,5 @@
            /********** PRIVATE *****************************************/
            fprintf(dependfileoutput,"%d\n",parcours->var->v_PrivateDeclare);
-              
+
            /********** INDICETABVARS ******************************************/
            fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars);
@@ -497,4 +492,5 @@
                  dims = dims->suiv;
               }
+              Save_Length(listdimension,15);
               fprintf(dependfileoutput,"%s\n",listdimension);
            }
@@ -525,19 +521,20 @@
 /*                                                                            */
 /******************************************************************************/
-listvar *Readthedependfile( char *NameTampon , listvar *listout)
-{
-  char ligne[LONG_C];
+listvar *Readthedependfile(const char *NameTampon , listvar *listout)
+{
   FILE *dependfileoutput;
   listvar *parcours0;
   listvar *parcours;
   listvar *parcoursprec;
-  char nothing[LONG_C];
-  int i;
+  char nothing[LONG_M];
+  char lowername[LONG_VNAME];
+  size_t i;
 
   parcoursprec = (listvar *)NULL;
 
-  convert2lower(NameTampon);
-  sprintf(ligne,".depend%s",NameTampon);
-  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername);
+
+  if ((dependfileoutput = fopen(dependfilename, "r"))==NULL)
   {
     /* if the file doesn't exist it means that it is the first time           */
@@ -549,6 +546,6 @@
       while (!feof(dependfileoutput))
       {
-         parcours=(listvar *)malloc(sizeof(listvar));
-         parcours->var=(variable *)malloc(sizeof(variable));
+         parcours=(listvar *)calloc(1,sizeof(listvar));
+         parcours->var=(variable *)calloc(1,sizeof(variable));
          /*                                                                   */
          Init_Variable(parcours->var);
@@ -556,4 +553,6 @@
            /********** TYPEVAR ************************************************/
          fscanf(dependfileoutput,"%s\n",parcours->var->v_typevar);
+           /********** CATVAR ************************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_catvar);
            /********** NOMVAR *************************************************/
          fscanf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
@@ -578,12 +577,10 @@
            /********** MODULENAME *********************************************/
          fscanf(dependfileoutput,"%s\n",parcours->var->v_modulename);
-         
-         printf("MODULENAME = %s %s\n",parcours->var->v_nomvar,parcours->var->v_modulename);
-         
+
          if ( !strcasecmp(parcours->var->v_modulename,"T") )
          {
             strcpy(parcours->var->v_modulename,"");
          }
-         
+
 
            /********** NBDIM **************************************************/
@@ -595,10 +592,9 @@
          if ( parcours->var->v_allocatable == 1 )
          {
-            Add_Allocate_Var_1(parcours->var->v_nomvar,
-                               parcours->var->v_commonname);
+            Add_Allocate_Var_1(parcours->var->v_nomvar, parcours->var->v_commonname);
          }
            /********** TARGET ********************************************/
          fscanf(dependfileoutput,"%d\n",&parcours->var->v_target);
-         
+
            /********** POINTERDECLARE *****************************************/
          fscanf(dependfileoutput,"%d\n",&parcours->var->v_pointerdeclare);
@@ -627,5 +623,5 @@
            /********** PRIVATE *****************************************/
          fscanf(dependfileoutput,"%d\n",&parcours->var->v_PrivateDeclare);
-         
+
            /********** INDICETABVARS ******************************************/
          fscanf(dependfileoutput,"%d\n",&parcours->var->v_indicetabvars);
@@ -692,5 +688,7 @@
    if ( List_Subroutine_For_Alloc )
    {
-      if ((dependfileoutput=fopen(".dependAllocAgrif","w"))!=NULL)
+      sprintf(dependfilename, "%s/.dependAllocAgrif", work_dir);
+
+      if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL)
       {
          parcours = List_Subroutine_For_Alloc;
@@ -707,33 +705,34 @@
 void Read_Subroutine_For_Alloc()
 {
-  FILE *dependfileoutput;
-  listnom *parcours;
-  listnom *ref;
-
-  ref = (listnom *)NULL;
-  if ((dependfileoutput=fopen(".dependAllocAgrif","r"))!=NULL)
-  {
-     List_Subroutine_For_Alloc = (listnom *)NULL;
-     while (!feof(dependfileoutput))
-     {
-        parcours=(listnom *)malloc(sizeof(listnom));
-        strcpy(parcours->o_nom,"");
-
-        fscanf(dependfileoutput,"%s\n",&parcours->o_nom);
-        parcours->suiv = NULL;
-
-        if ( !List_Subroutine_For_Alloc )
-        {
-           List_Subroutine_For_Alloc = parcours;
-           ref = parcours;
-        }
-        else
-        {
-            ref->suiv = parcours;
+    FILE *dependfileoutput;
+    listnom *parcours;
+    listnom *ref;
+
+    ref = (listnom*) NULL;
+    sprintf(dependfilename, "%s/.dependAllocAgrif", work_dir);
+
+    if ( (dependfileoutput=fopen(dependfilename, "r")) != NULL )
+    {
+        List_Subroutine_For_Alloc = (listnom*) NULL;
+        while ( !feof(dependfileoutput) )
+        {
+            parcours = (listnom*) calloc(1,sizeof(listnom));
+            strcpy(parcours->o_nom,"");
+
+            fscanf(dependfileoutput,"%s\n",parcours->o_nom);
+            parcours->suiv = NULL;
+
+            if ( !List_Subroutine_For_Alloc )
+            {
+                List_Subroutine_For_Alloc = parcours;
+            }
+            else
+            {
+                ref->suiv = parcours;
+            }
             ref = parcours;
         }
-     }
-     fclose(dependfileoutput);
-  }
+        fclose(dependfileoutput);
+    }
 }
 
@@ -756,21 +755,27 @@
 void Writethedependavailablefile()
 {
-  FILE *dependfileoutput;
-  listindice *parcours;
-
-  if ((dependfileoutput=fopen(".dependavailable","w"))!=NULL)
-  {
-     /* We are looking for all the indices of the Listofavailableindices      */
-     parcours = Listofavailableindices;
-     while (parcours)
-     {
-        if ( parcours->i_indice != 0 )
-        {
-           fprintf(dependfileoutput,"%d\n",parcours->i_indice);
-        }
-        parcours = parcours->suiv;
-     }
-     fclose(dependfileoutput);
-  }
+    FILE *dependfileoutput;
+    listindice *parcours;
+    int i;
+
+    sprintf(dependfilename, "%s/.dependavailable", work_dir);
+
+    if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL)
+    {
+        /* We are looking for all the indices of the Listofavailableindices      */
+        for (i=0;i<NB_CAT_VARIABLES;i++)
+        {
+            parcours = Listofavailableindices_glob[i];
+            while (parcours)
+            {
+                if ( parcours->i_indice != 0 )
+                {
+                    fprintf(dependfileoutput,"%d %d\n",i,parcours->i_indice);
+                }
+                parcours = parcours->suiv;
+            }
+        }
+        fclose(dependfileoutput);
+    }
 }
 
@@ -795,17 +800,20 @@
   FILE *dependfileoutput;
   listindice *parcours;
-
-  if ((dependfileoutput=fopen(".dependavailable","r"))!=NULL)
+  int current_cat;
+
+  sprintf(dependfilename, "%s/.dependavailable", work_dir);
+
+  if ((dependfileoutput=fopen(dependfilename, "r"))!=NULL)
   {
      /* We are looking for all the indices of the Listofavailableindices      */
-     Listofavailableindices = (listindice *)NULL;
+     Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
      while (!feof(dependfileoutput))
      {
-        parcours=(listindice *)malloc(sizeof(listindice));
-        fscanf(dependfileoutput,"%d\n",&parcours->i_indice);
+        parcours=(listindice *)calloc(1,sizeof(listindice));
+        fscanf(dependfileoutput,"%d %d\n",&current_cat,&parcours->i_indice);
         if ( parcours->i_indice != 0 && parcours->i_indice < 10000000 )
         {
-           parcours -> suiv = Listofavailableindices;
-           Listofavailableindices = parcours;
+           parcours -> suiv = Listofavailableindices_glob[current_cat];
+           Listofavailableindices_glob[current_cat] = parcours;
         }
         else
@@ -820,5 +828,5 @@
 
 /******************************************************************************/
-/*                      Did_filetoparse_readed                                */
+/*                       is_dependfile_created                                */
 /******************************************************************************/
 /* This subroutine is used to know if the .depend<NameTampon> exist           */
@@ -827,188 +835,80 @@
 /*                                                                            */
 /******************************************************************************/
-int Did_filetoparse_readed(char *NameTampon)
+int is_dependfile_created(const char *NameTampon)
 {
   FILE *dependfileoutput;
-  char ligne[LONG_C];
-  int out;
-
-  convert2lower(NameTampon);
-  sprintf(ligne,".depend%s",NameTampon);
-  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
-  {
-      out = 0;
+  char lowername[LONG_VNAME];
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername);
+
+  dependfileoutput = fopen(dependfilename, "r");
+
+  if ( (dependfileoutput = fopen(dependfilename, "r")) != NULL )
+  {
+    fclose(dependfileoutput);
+    return 1;
   }
   else
-  {
-      out = 1;
-      fclose(dependfileoutput);
-  }
-  return out;
-}
-
-
-/******************************************************************************/
-/*                      Did_module_common_treaded                             */
-/******************************************************************************/
-/* This subroutine is used to know if the .depend<NameTampon> exist           */
-/*    it means if the file has been ever parsed                               */
-/******************************************************************************/
-/*                                                                            */
-/******************************************************************************/
-int Did_module_common_treaded(char *NameTampon)
-{
-  FILE *dependfileoutput;
-  char ligne[LONG_C];
-  int out;
-
-  convert2lower(NameTampon);
-  sprintf(ligne,".depend%s",NameTampon);
-  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
-  {
-      out = 0;
-  }
-  else
-  {
-      out = 1;
-      fclose(dependfileoutput);
-  }
-  return out;
-}
-
-
+    return 0;
+}
 
 void Write_val_max()
 {
-  FILE *dependfileoutput;
-
-  if ((dependfileoutput=fopen(".dependvalmax","w"))!=NULL)
-  {
-     fprintf(dependfileoutput,"length_last\n");
-     fprintf(dependfileoutput,"%d\n",length_last);
-     fprintf(dependfileoutput,"length_first\n");
-     fprintf(dependfileoutput,"%d\n",length_first);
-     fprintf(dependfileoutput,"length_v_typevar\n");
-     fprintf(dependfileoutput,"%d\n",length_v_typevar);
-     fprintf(dependfileoutput,"length_v_nomvar\n");
-     fprintf(dependfileoutput,"%d\n",length_v_nomvar);
-     fprintf(dependfileoutput,"length_v_dimchar\n");
-     fprintf(dependfileoutput,"%d\n",length_v_dimchar);
-     fprintf(dependfileoutput,"length_v_modulename\n");
-     fprintf(dependfileoutput,"%d\n",length_v_modulename);
-     fprintf(dependfileoutput,"length_v_commonname\n");
-     fprintf(dependfileoutput,"%d\n",length_v_commonname);
-     fprintf(dependfileoutput,"length_v_vallengspec\n");
-     fprintf(dependfileoutput,"%d\n",length_v_vallengspec);
-     fprintf(dependfileoutput,"length_v_nameinttypename\n");
-     fprintf(dependfileoutput,"%d\n",length_v_nameinttypename);
-     fprintf(dependfileoutput,"length_v_commoninfile\n");
-     fprintf(dependfileoutput,"%d\n",length_v_commoninfile);
-     fprintf(dependfileoutput,"length_v_subroutinename\n");
-     fprintf(dependfileoutput,"%d\n",length_v_subroutinename);
-     fprintf(dependfileoutput,"length_v_precision\n");
-     fprintf(dependfileoutput,"%d\n",length_v_precision);
-     fprintf(dependfileoutput,"length_v_IntentSpec\n");
-     fprintf(dependfileoutput,"%d\n",length_v_IntentSpec);
-     fprintf(dependfileoutput,"length_v_initialvalue\n");
-     fprintf(dependfileoutput,"%d\n",length_v_initialvalue);
-     fprintf(dependfileoutput,"length_v_readedlistdimension\n");
-     fprintf(dependfileoutput,"%d\n",length_v_readedlistdimension);
-     fprintf(dependfileoutput,"length_u_usemodule\n");
-     fprintf(dependfileoutput,"%d\n",length_u_usemodule);
-     fprintf(dependfileoutput,"length_u_charusemodule\n");
-     fprintf(dependfileoutput,"%d\n",length_u_charusemodule);
-     fprintf(dependfileoutput,"length_u_cursubroutine\n");
-     fprintf(dependfileoutput,"%d\n",length_u_cursubroutine);
-     fprintf(dependfileoutput,"length_u_modulename\n");
-     fprintf(dependfileoutput,"%d\n",length_u_modulename);
-     fprintf(dependfileoutput,"length_n_name\n");
-     fprintf(dependfileoutput,"%d\n",length_n_name);
-     fprintf(dependfileoutput,"length_c_namevar\n");
-     fprintf(dependfileoutput,"%d\n",length_c_namevar);
-     fprintf(dependfileoutput,"length_c_namepointedvar\n");
-     fprintf(dependfileoutput,"%d\n",length_c_namepointedvar);
-     fprintf(dependfileoutput,"length_o_nom\n");
-     fprintf(dependfileoutput,"%d\n",length_o_nom);
-     fprintf(dependfileoutput,"length_o_module\n");
-     fprintf(dependfileoutput,"%d\n",length_o_module);
-     fprintf(dependfileoutput,"length_a_nomvar\n");
-     fprintf(dependfileoutput,"%d\n",length_a_nomvar);
-     fprintf(dependfileoutput,"length_a_subroutine\n");
-     fprintf(dependfileoutput,"%d\n",length_a_subroutine);
-     fprintf(dependfileoutput,"length_a_module\n");
-     fprintf(dependfileoutput,"%d\n",length_a_module);
-     fprintf(dependfileoutput,"length_usemodule\n");
-     fprintf(dependfileoutput,"%d\n",length_t_usemodule);
-     fprintf(dependfileoutput,"length_cursubroutine\n");
-     fprintf(dependfileoutput,"%d\n",length_t_cursubroutine);
-     fprintf(dependfileoutput,"length_curfilename\n");
-     fprintf(dependfileoutput,"%d\n",length_curfilename);
-     fprintf(dependfileoutput,"length_nomfileoutput\n");
-     fprintf(dependfileoutput,"%d\n",length_nomfileoutput);
-     fprintf(dependfileoutput,"length_motparse\n");
-     fprintf(dependfileoutput,"%d\n",length_motparse);
-     fprintf(dependfileoutput,"length_mainfile\n");
-     fprintf(dependfileoutput,"%d\n",length_mainfile);
-     fprintf(dependfileoutput,"length_nomdir\n");
-     fprintf(dependfileoutput,"%d\n",length_nomdir);
-     fprintf(dependfileoutput,"length_commondirout\n");
-     fprintf(dependfileoutput,"%d\n",length_commondirout);
-     fprintf(dependfileoutput,"length_commondirin\n");
-     fprintf(dependfileoutput,"%d\n",length_commondirin);
-     fprintf(dependfileoutput,"length_filetoparse\n");
-     fprintf(dependfileoutput,"%d\n",length_filetoparse);
-     fprintf(dependfileoutput,"length_curbuf\n");
-     fprintf(dependfileoutput,"%d\n",length_curbuf);
-     fprintf(dependfileoutput,"length_toprintglob\n");
-     fprintf(dependfileoutput,"%d\n",length_toprintglob);
-     fprintf(dependfileoutput,"Size_char0d\n");
-     fprintf(dependfileoutput,"%d\n",value_char_size);
-     fprintf(dependfileoutput,"Size_char1d\n");
-     fprintf(dependfileoutput,"%d\n",value_char_size1);
-     fprintf(dependfileoutput,"Size_char2d\n");
-     fprintf(dependfileoutput,"%d\n",value_char_size2);
-     fprintf(dependfileoutput,"Size_char3d\n");
-     fprintf(dependfileoutput,"%d\n",value_char_size3);
-     fprintf(dependfileoutput,"length_tmpvargridname\n");
-     fprintf(dependfileoutput,"%d\n",length_tmpvargridname);
-     fprintf(dependfileoutput,"length_ligne_Subloop\n");
-     fprintf(dependfileoutput,"%d\n",length_ligne_Subloop);
-     fprintf(dependfileoutput,"length_lvargridname_toamr\n");
-     fprintf(dependfileoutput,"%d\n",length_lvargridname_toamr);
-     fprintf(dependfileoutput,"length_toprint_toamr\n");
-     fprintf(dependfileoutput,"%d\n",length_toprint_utilagrif);
-     fprintf(dependfileoutput,"length_toprinttmp_utilchar\n");
-     fprintf(dependfileoutput,"%d\n",length_toprinttmp_utilchar);
-     fprintf(dependfileoutput,"length_ligne_writedecl\n");
-     fprintf(dependfileoutput,"%d\n",length_ligne_writedecl);
-     fprintf(dependfileoutput,"length_newname_toamr\n");
-     fprintf(dependfileoutput,"%d\n",length_newname_toamr);
-     fprintf(dependfileoutput,"length_newname_writedecl\n");
-     fprintf(dependfileoutput,"%d\n",length_newname_writedecl);
-     fprintf(dependfileoutput,"length_ligne_toamr\n");
-     fprintf(dependfileoutput,"%d\n",length_ligne_toamr);
-     fprintf(dependfileoutput,"length_tmpligne_writedecl\n");
-     fprintf(dependfileoutput,"%d\n",length_tmpligne_writedecl);
-/*     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);
-     fprintf(dependfileoutput,"\n");
-     fprintf(dependfileoutput,"%d\n",);*/
-
-     fclose(dependfileoutput);
-  }
+    FILE *dependfileoutput;
+
+    sprintf(dependfilename, "%s/.dependvalmax", work_dir);
+
+    if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL)
+    {
+        fprintf(dependfileoutput,"length_last\n");
+        fprintf(dependfileoutput,"%lu\n", length_last);
+        fprintf(dependfileoutput,"length_first\n");
+        fprintf(dependfileoutput,"%lu\n", length_first);
+        fprintf(dependfileoutput,"length_v_vallengspec\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_vallengspec);
+        fprintf(dependfileoutput,"length_v_commoninfile\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_commoninfile);
+        fprintf(dependfileoutput,"length_v_precision\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_precision);
+        fprintf(dependfileoutput,"length_v_IntentSpec\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_IntentSpec);
+        fprintf(dependfileoutput,"length_v_initialvalue\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_initialvalue);
+        fprintf(dependfileoutput,"length_v_readedlistdimension\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_readedlistdimension);
+        fprintf(dependfileoutput,"length_a_nomvar\n");
+        fprintf(dependfileoutput,"%lu\n", length_a_nomvar);
+        fprintf(dependfileoutput,"length_toprintglob\n");
+        fprintf(dependfileoutput,"%lu\n", length_toprintglob);
+        fprintf(dependfileoutput,"Size_char0d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size);
+        fprintf(dependfileoutput,"Size_char1d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size1);
+        fprintf(dependfileoutput,"Size_char2d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size2);
+        fprintf(dependfileoutput,"Size_char3d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size3);
+        fprintf(dependfileoutput,"length_tmpvargridname\n");
+        fprintf(dependfileoutput,"%lu\n", length_tmpvargridname);
+        fprintf(dependfileoutput,"length_ligne_Subloop\n");
+        fprintf(dependfileoutput,"%lu\n", length_ligne_Subloop);
+        fprintf(dependfileoutput,"length_toprint_toamr\n");
+        fprintf(dependfileoutput,"%lu\n", length_toprint_utilagrif);
+        fprintf(dependfileoutput,"length_toprinttmp_utilchar\n");
+        fprintf(dependfileoutput,"%lu\n", length_toprinttmp_utilchar);
+        fprintf(dependfileoutput,"length_ligne_writedecl\n");
+        fprintf(dependfileoutput,"%lu\n", length_ligne_writedecl);
+        fprintf(dependfileoutput,"length_newname_toamr\n");
+        fprintf(dependfileoutput,"%lu\n", length_newname_toamr);
+        fprintf(dependfileoutput,"length_newname_writedecl\n");
+        fprintf(dependfileoutput,"%lu\n", length_newname_writedecl);
+        fprintf(dependfileoutput,"length_ligne_toamr\n");
+        fprintf(dependfileoutput,"%lu\n", length_ligne_toamr);
+        fprintf(dependfileoutput,"length_tmpligne_writedecl\n");
+        fprintf(dependfileoutput,"%lu\n", length_tmpligne_writedecl);
+
+        fclose(dependfileoutput);
+    }
 }
 
@@ -1016,135 +916,59 @@
 void Read_val_max()
 {
-  char nothing[LONG_C];
-  FILE *dependfileoutput;
-
-  if ((dependfileoutput=fopen(".dependvalmax","r"))!=NULL)
-  {
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_last);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_first);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_typevar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_nomvar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_dimchar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_modulename);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_commonname);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_vallengspec);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_nameinttypename);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_commoninfile);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_subroutinename);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_precision);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_IntentSpec);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_initialvalue);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_v_readedlistdimension);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_u_usemodule);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_u_charusemodule);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_u_cursubroutine);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_u_modulename);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_n_name);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_c_namevar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_c_namepointedvar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_o_nom);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_o_module);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_a_nomvar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_a_subroutine);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_a_module);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_t_usemodule);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_t_cursubroutine);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_curfilename);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_nomfileoutput);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_motparse);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_mainfile);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_nomdir);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_commondirout);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_commondirin);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_filetoparse);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_curbuf);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_toprintglob);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&value_char_size);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&value_char_size1);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&value_char_size2);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&value_char_size3);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_tmpvargridname);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_ligne_Subloop);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_lvargridname_toamr);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_toprint_utilagrif);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_toprinttmp_utilchar);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_ligne_writedecl);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_newname_toamr);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_newname_writedecl);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_ligne_toamr);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&length_tmpligne_writedecl);
-/*     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);
-     fscanf(dependfileoutput,"%s\n",nothing);
-     fscanf(dependfileoutput,"%d\n",&);*/
-
-     fclose(dependfileoutput);
-  }
-}
+    char nothing[LONG_M];
+    FILE *dependfileoutput;
+
+    sprintf(dependfilename, "%s/.dependvalmax", work_dir);
+
+    if ((dependfileoutput=fopen(".dependvalmax","r"))!=NULL)
+    {
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_last);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_first);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_vallengspec);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_commoninfile);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_precision);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_IntentSpec);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_initialvalue);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_readedlistdimension);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_a_nomvar);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_toprintglob);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size);
+       fscanf(dependfileoutput,"%s\n", nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size1);
+       fscanf(dependfileoutput,"%s\n", nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size2);
+       fscanf(dependfileoutput,"%s\n", nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size3);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_tmpvargridname);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_ligne_Subloop);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_toprint_utilagrif);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_toprinttmp_utilchar);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_ligne_writedecl);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_newname_toamr);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_newname_writedecl);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_ligne_toamr);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_tmpligne_writedecl);
+
+       fclose(dependfileoutput);
+    }
+}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c	(revision 5682)
@@ -1,23 +1,20 @@
-/* A Bison parser, made by GNU Bison 2.3.  */
-
-/* Skeleton implementation for Bison's Yacc-like parsers in C
-
-   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
-   Free Software Foundation, Inc.
-
-   This program is free software; you can redistribute it and/or modify
+/* A Bison parser, made by GNU Bison 2.7.  */
+
+/* Bison implementation for Yacc-like parsers in C
+   
+      Copyright (C) 1984, 1989-1990, 2000-2012 Free Software Foundation, Inc.
+   
+   This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
-   the Free Software Foundation; either version 2, or (at your option)
-   any later version.
-
+   the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+   
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
-
+   
    You should have received a copy of the GNU General Public License
-   along with this program; if not, write to the Free Software
-   Foundation, Inc., 51 Franklin Street, Fifth Floor,
-   Boston, MA 02110-1301, USA.  */
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
 
 /* As a special exception, you may create a larger work that contains
@@ -30,5 +27,5 @@
    Bison output files to be licensed under the GNU General Public
    License without this special exception.
-
+   
    This special exception was added by the Free Software Foundation in
    version 2.2 of Bison.  */
@@ -48,5 +45,4 @@
 
 /* Bison version.  */
-#define YYBISON_VERSION "2.3"
 
 /* Skeleton name.  */
@@ -56,371 +52,22 @@
 #define YYPURE 0
 
-/* Using locations.  */
-#define YYLSP_NEEDED 0
+/* Push parsers.  */
+#define YYPUSH 0
+
+/* Pull parsers.  */
+#define YYPULL 1
+
 
 /* Substitute the variable and function names.  */
-#define yyparse fortranparse
-#define yylex   fortranlex
-#define yyerror fortranerror
-#define yylval  fortranlval
-#define yychar  fortranchar
-#define yydebug fortrandebug
-#define yynerrs fortrannerrs
-
-
-/* Tokens.  */
-#ifndef YYTOKENTYPE
-# define YYTOKENTYPE
-   /* Put the tokens into the symbol table, so that GDB and other debuggers
-      know about them.  */
-   enum yytokentype {
-     TOK_BINARY_OP = 258,
-     TOK_NEQV = 259,
-     TOK_EQV = 260,
-     TOK_XOR = 261,
-     TOK_OR = 262,
-     TOK_AND = 263,
-     TOK_NOT = 264,
-     TOK_NE = 265,
-     TOK_EQ = 266,
-     TOK_GE = 267,
-     TOK_LE = 268,
-     TOK_GT = 269,
-     TOK_LT = 270,
-     TOK_UNARY_OP = 271,
-     TOK_DSLASH = 272,
-     TOK_SLASH = 273,
-     TOK_DASTER = 274,
-     TOK_SEP = 275,
-     TOK_SEMICOLON = 276,
-     TOK_NEXTLINE = 277,
-     TOK_PARAMETER = 278,
-     TOK_RESULT = 279,
-     TOK_ONLY = 280,
-     TOK_INCLUDE = 281,
-     TOK_SUBROUTINE = 282,
-     TOK_PROGRAM = 283,
-     TOK_FUNCTION = 284,
-     TOK_OMP = 285,
-     TOK_DOLLAR = 286,
-     TOK_FORMAT = 287,
-     TOK_MAX = 288,
-     TOK_TANH = 289,
-     TOK_WHERE = 290,
-     TOK_ELSEWHERE = 291,
-     TOK_ENDWHERE = 292,
-     TOK_MAXVAL = 293,
-     TOK_TRIM = 294,
-     TOK_SUM = 295,
-     TOK_SQRT = 296,
-     TOK_CASE = 297,
-     TOK_SELECTCASE = 298,
-     TOK_FILE = 299,
-     TOK_END = 300,
-     TOK_ERR = 301,
-     TOK_DONOTTREAT = 302,
-     TOK_ENDDONOTTREAT = 303,
-     TOK_EXIST = 304,
-     TOK_MIN = 305,
-     TOK_FLOAT = 306,
-     TOK_EXP = 307,
-     TOK_COS = 308,
-     TOK_COSH = 309,
-     TOK_ACOS = 310,
-     TOK_NINT = 311,
-     TOK_CYCLE = 312,
-     TOK_SIN = 313,
-     TOK_SINH = 314,
-     TOK_ASIN = 315,
-     TOK_EQUIVALENCE = 316,
-     TOK_BACKSPACE = 317,
-     TOK_LOG = 318,
-     TOK_TAN = 319,
-     TOK_ATAN = 320,
-     TOK_RECURSIVE = 321,
-     TOK_ABS = 322,
-     TOK_MOD = 323,
-     TOK_SIGN = 324,
-     TOK_MINLOC = 325,
-     TOK_MAXLOC = 326,
-     TOK_EXIT = 327,
-     TOK_MINVAL = 328,
-     TOK_PUBLIC = 329,
-     TOK_PRIVATE = 330,
-     TOK_ALLOCATABLE = 331,
-     TOK_RETURN = 332,
-     TOK_THEN = 333,
-     TOK_ELSEIF = 334,
-     TOK_ELSE = 335,
-     TOK_ENDIF = 336,
-     TOK_PRINT = 337,
-     TOK_PLAINGOTO = 338,
-     TOK_CONSTRUCTID = 339,
-     TOK_LOGICALIF = 340,
-     TOK_PLAINDO = 341,
-     TOK_CONTAINS = 342,
-     TOK_ENDDO = 343,
-     TOK_MODULE = 344,
-     TOK_ENDMODULE = 345,
-     TOK_DOWHILE = 346,
-     TOK_ALLOCATE = 347,
-     TOK_OPEN = 348,
-     TOK_CLOSE = 349,
-     TOK_INQUIRE = 350,
-     TOK_WRITE = 351,
-     TOK_READ = 352,
-     TOK_REWIND = 353,
-     TOK_DEALLOCATE = 354,
-     TOK_NULLIFY = 355,
-     TOK_FIN = 356,
-     TOK_DEBUT = 357,
-     TOK_DIMENSION = 358,
-     TOK_ENDSELECT = 359,
-     TOK_EXTERNAL = 360,
-     TOK_INTENT = 361,
-     TOK_INTRINSIC = 362,
-     TOK_NAMELIST = 363,
-     TOK_CASEDEFAULT = 364,
-     TOK_OPTIONAL = 365,
-     TOK_POINTER = 366,
-     TOK_CONTINUE = 367,
-     TOK_SAVE = 368,
-     TOK_TARGET = 369,
-     TOK_QUOTE = 370,
-     TOK_IMPLICIT = 371,
-     TOK_NONE = 372,
-     TOK_CALL = 373,
-     TOK_STAT = 374,
-     TOK_POINT_TO = 375,
-     TOK_COMMON = 376,
-     TOK_GLOBAL = 377,
-     TOK_INTERFACE = 378,
-     TOK_ENDINTERFACE = 379,
-     TOK_LEFTAB = 380,
-     TOK_RIGHTAB = 381,
-     TOK_PAUSE = 382,
-     TOK_PROCEDURE = 383,
-     TOK_STOP = 384,
-     TOK_NAMEEQ = 385,
-     TOK_REAL8 = 386,
-     TOK_OUT = 387,
-     TOK_INOUT = 388,
-     TOK_IN = 389,
-     TOK_USE = 390,
-     TOK_TRUE = 391,
-     TOK_FALSE = 392,
-     TOK_LABEL = 393,
-     TOK_TYPE = 394,
-     TOK_TYPEPAR = 395,
-     TOK_ENDTYPE = 396,
-     TOK_REAL = 397,
-     TOK_INTEGER = 398,
-     TOK_LOGICAL = 399,
-     TOK_DOUBLEPRECISION = 400,
-     TOK_DOUBLEREAL = 401,
-     TOK_ENDSUBROUTINE = 402,
-     TOK_ENDFUNCTION = 403,
-     TOK_ENDPROGRAM = 404,
-     TOK_ENDUNIT = 405,
-     TOK_CHARACTER = 406,
-     TOK_CHAR_CONSTANT = 407,
-     TOK_CHAR_CUT = 408,
-     TOK_DATA = 409,
-     TOK_CHAR_INT = 410,
-     TOK_CHAR_MESSAGE = 411,
-     TOK_CSTREAL = 412,
-     TOK_CSTREALDP = 413,
-     TOK_CSTREALQP = 414,
-     TOK_SFREAL = 415,
-     TOK_COMPLEX = 416,
-     TOK_DOUBLECOMPLEX = 417,
-     TOK_NAME = 418,
-     TOK_NAME_CHAR = 419,
-     TOK_PROBTYPE = 420,
-     TOK_INTERPTYPE = 421,
-     TOK_VARTYPE = 422,
-     TOK_BC = 423,
-     TOK_OP = 424,
-     TOK_CSTINT = 425,
-     TOK_COMMENT = 426,
-     TOK_FILENAME = 427
-   };
-#endif
-/* Tokens.  */
-#define TOK_BINARY_OP 258
-#define TOK_NEQV 259
-#define TOK_EQV 260
-#define TOK_XOR 261
-#define TOK_OR 262
-#define TOK_AND 263
-#define TOK_NOT 264
-#define TOK_NE 265
-#define TOK_EQ 266
-#define TOK_GE 267
-#define TOK_LE 268
-#define TOK_GT 269
-#define TOK_LT 270
-#define TOK_UNARY_OP 271
-#define TOK_DSLASH 272
-#define TOK_SLASH 273
-#define TOK_DASTER 274
-#define TOK_SEP 275
-#define TOK_SEMICOLON 276
-#define TOK_NEXTLINE 277
-#define TOK_PARAMETER 278
-#define TOK_RESULT 279
-#define TOK_ONLY 280
-#define TOK_INCLUDE 281
-#define TOK_SUBROUTINE 282
-#define TOK_PROGRAM 283
-#define TOK_FUNCTION 284
-#define TOK_OMP 285
-#define TOK_DOLLAR 286
-#define TOK_FORMAT 287
-#define TOK_MAX 288
-#define TOK_TANH 289
-#define TOK_WHERE 290
-#define TOK_ELSEWHERE 291
-#define TOK_ENDWHERE 292
-#define TOK_MAXVAL 293
-#define TOK_TRIM 294
-#define TOK_SUM 295
-#define TOK_SQRT 296
-#define TOK_CASE 297
-#define TOK_SELECTCASE 298
-#define TOK_FILE 299
-#define TOK_END 300
-#define TOK_ERR 301
-#define TOK_DONOTTREAT 302
-#define TOK_ENDDONOTTREAT 303
-#define TOK_EXIST 304
-#define TOK_MIN 305
-#define TOK_FLOAT 306
-#define TOK_EXP 307
-#define TOK_COS 308
-#define TOK_COSH 309
-#define TOK_ACOS 310
-#define TOK_NINT 311
-#define TOK_CYCLE 312
-#define TOK_SIN 313
-#define TOK_SINH 314
-#define TOK_ASIN 315
-#define TOK_EQUIVALENCE 316
-#define TOK_BACKSPACE 317
-#define TOK_LOG 318
-#define TOK_TAN 319
-#define TOK_ATAN 320
-#define TOK_RECURSIVE 321
-#define TOK_ABS 322
-#define TOK_MOD 323
-#define TOK_SIGN 324
-#define TOK_MINLOC 325
-#define TOK_MAXLOC 326
-#define TOK_EXIT 327
-#define TOK_MINVAL 328
-#define TOK_PUBLIC 329
-#define TOK_PRIVATE 330
-#define TOK_ALLOCATABLE 331
-#define TOK_RETURN 332
-#define TOK_THEN 333
-#define TOK_ELSEIF 334
-#define TOK_ELSE 335
-#define TOK_ENDIF 336
-#define TOK_PRINT 337
-#define TOK_PLAINGOTO 338
-#define TOK_CONSTRUCTID 339
-#define TOK_LOGICALIF 340
-#define TOK_PLAINDO 341
-#define TOK_CONTAINS 342
-#define TOK_ENDDO 343
-#define TOK_MODULE 344
-#define TOK_ENDMODULE 345
-#define TOK_DOWHILE 346
-#define TOK_ALLOCATE 347
-#define TOK_OPEN 348
-#define TOK_CLOSE 349
-#define TOK_INQUIRE 350
-#define TOK_WRITE 351
-#define TOK_READ 352
-#define TOK_REWIND 353
-#define TOK_DEALLOCATE 354
-#define TOK_NULLIFY 355
-#define TOK_FIN 356
-#define TOK_DEBUT 357
-#define TOK_DIMENSION 358
-#define TOK_ENDSELECT 359
-#define TOK_EXTERNAL 360
-#define TOK_INTENT 361
-#define TOK_INTRINSIC 362
-#define TOK_NAMELIST 363
-#define TOK_CASEDEFAULT 364
-#define TOK_OPTIONAL 365
-#define TOK_POINTER 366
-#define TOK_CONTINUE 367
-#define TOK_SAVE 368
-#define TOK_TARGET 369
-#define TOK_QUOTE 370
-#define TOK_IMPLICIT 371
-#define TOK_NONE 372
-#define TOK_CALL 373
-#define TOK_STAT 374
-#define TOK_POINT_TO 375
-#define TOK_COMMON 376
-#define TOK_GLOBAL 377
-#define TOK_INTERFACE 378
-#define TOK_ENDINTERFACE 379
-#define TOK_LEFTAB 380
-#define TOK_RIGHTAB 381
-#define TOK_PAUSE 382
-#define TOK_PROCEDURE 383
-#define TOK_STOP 384
-#define TOK_NAMEEQ 385
-#define TOK_REAL8 386
-#define TOK_OUT 387
-#define TOK_INOUT 388
-#define TOK_IN 389
-#define TOK_USE 390
-#define TOK_TRUE 391
-#define TOK_FALSE 392
-#define TOK_LABEL 393
-#define TOK_TYPE 394
-#define TOK_TYPEPAR 395
-#define TOK_ENDTYPE 396
-#define TOK_REAL 397
-#define TOK_INTEGER 398
-#define TOK_LOGICAL 399
-#define TOK_DOUBLEPRECISION 400
-#define TOK_DOUBLEREAL 401
-#define TOK_ENDSUBROUTINE 402
-#define TOK_ENDFUNCTION 403
-#define TOK_ENDPROGRAM 404
-#define TOK_ENDUNIT 405
-#define TOK_CHARACTER 406
-#define TOK_CHAR_CONSTANT 407
-#define TOK_CHAR_CUT 408
-#define TOK_DATA 409
-#define TOK_CHAR_INT 410
-#define TOK_CHAR_MESSAGE 411
-#define TOK_CSTREAL 412
-#define TOK_CSTREALDP 413
-#define TOK_CSTREALQP 414
-#define TOK_SFREAL 415
-#define TOK_COMPLEX 416
-#define TOK_DOUBLECOMPLEX 417
-#define TOK_NAME 418
-#define TOK_NAME_CHAR 419
-#define TOK_PROBTYPE 420
-#define TOK_INTERPTYPE 421
-#define TOK_VARTYPE 422
-#define TOK_BC 423
-#define TOK_OP 424
-#define TOK_CSTINT 425
-#define TOK_COMMENT 426
-#define TOK_FILENAME 427
-
-
-
+#define yyparse         fortran_parse
+#define yylex           fortran_lex
+#define yyerror         fortran_error
+#define yylval          fortran_lval
+#define yychar          fortran_char
+#define yydebug         fortran_debug
+#define yynerrs         fortran_nerrs
 
 /* Copy the first part of user declarations.  */
+/* Line 371 of yacc.c  */
 #line 36 "fortran.y"
 
@@ -430,25 +77,36 @@
 #include <string.h>
 #include "decl.h"
-extern int line_num_fortran;
-extern int line_num_fortran_common;
-char *tmp;
-char c_selectorname[LONG_C];
-char ligne[LONG_C];
-char truename[LONGNOM];
-char identcopy[LONG_C];
+
+extern int line_num_input;
+extern char *fortran_text;
+
+char c_selectorname[LONG_M];
+char ligne[LONG_M];
+char truename[LONG_VNAME];
+char identcopy[LONG_VNAME];
 int c_selectorgiven=0;
-int incom;
 listvar *curlistvar;
 typedim c_selectordim;
 listcouple *coupletmp;
-listdim *parcoursdim;
 int removeline=0;
 listvar *test;
 
-
-/* Enabling traces.  */
-#ifndef YYDEBUG
-# define YYDEBUG 0
-#endif
+int fortran_error(const char *s)
+{
+    printf("%s line %d, file %s motclef = |%s|\n", s, line_num_input, cur_filename, fortran_text);
+    exit(1);
+}
+
+
+/* Line 371 of yacc.c  */
+#line 104 "fortran.tab.c"
+
+# ifndef YY_NULL
+#  if defined __cplusplus && 201103L <= __cplusplus
+#   define YY_NULL nullptr
+#  else
+#   define YY_NULL 0
+#  endif
+# endif
 
 /* Enabling verbose error messages.  */
@@ -460,38 +118,221 @@
 #endif
 
-/* Enabling the token table.  */
-#ifndef YYTOKEN_TABLE
-# define YYTOKEN_TABLE 0
+
+/* Enabling traces.  */
+#ifndef YYDEBUG
+# define YYDEBUG 1
 #endif
+#if YYDEBUG
+extern int fortran_debug;
+#endif
+
+/* Tokens.  */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+   /* Put the tokens into the symbol table, so that GDB and other debuggers
+      know about them.  */
+   enum yytokentype {
+     TOK_NEQV = 258,
+     TOK_EQV = 259,
+     TOK_XOR = 260,
+     TOK_OR = 261,
+     TOK_AND = 262,
+     TOK_NOT = 263,
+     TOK_NE = 264,
+     TOK_EQ = 265,
+     TOK_GE = 266,
+     TOK_LE = 267,
+     TOK_GT = 268,
+     TOK_LT = 269,
+     TOK_DSLASH = 270,
+     TOK_SLASH = 271,
+     TOK_DASTER = 272,
+     TOK_SEMICOLON = 273,
+     TOK_PARAMETER = 274,
+     TOK_RESULT = 275,
+     TOK_ONLY = 276,
+     TOK_INCLUDE = 277,
+     TOK_SUBROUTINE = 278,
+     TOK_PROGRAM = 279,
+     TOK_FUNCTION = 280,
+     TOK_FORMAT = 281,
+     TOK_MAX = 282,
+     TOK_TANH = 283,
+     TOK_WHERE = 284,
+     TOK_ELSEWHEREPAR = 285,
+     TOK_ELSEWHERE = 286,
+     TOK_ENDWHERE = 287,
+     TOK_MAXVAL = 288,
+     TOK_TRIM = 289,
+     TOK_NULL_PTR = 290,
+     TOK_SUM = 291,
+     TOK_SQRT = 292,
+     TOK_CASE = 293,
+     TOK_SELECTCASE = 294,
+     TOK_FILE = 295,
+     TOK_UNIT = 296,
+     TOK_FMT = 297,
+     TOK_NML = 298,
+     TOK_END = 299,
+     TOK_EOR = 300,
+     TOK_ERR = 301,
+     TOK_EXIST = 302,
+     TOK_MIN = 303,
+     TOK_FLOAT = 304,
+     TOK_EXP = 305,
+     TOK_COS = 306,
+     TOK_COSH = 307,
+     TOK_ACOS = 308,
+     TOK_NINT = 309,
+     TOK_CYCLE = 310,
+     TOK_SIN = 311,
+     TOK_SINH = 312,
+     TOK_ASIN = 313,
+     TOK_EQUIVALENCE = 314,
+     TOK_BACKSPACE = 315,
+     TOK_LOG = 316,
+     TOK_TAN = 317,
+     TOK_ATAN = 318,
+     TOK_RECURSIVE = 319,
+     TOK_ABS = 320,
+     TOK_MOD = 321,
+     TOK_SIGN = 322,
+     TOK_MINLOC = 323,
+     TOK_MAXLOC = 324,
+     TOK_EXIT = 325,
+     TOK_MINVAL = 326,
+     TOK_PUBLIC = 327,
+     TOK_PRIVATE = 328,
+     TOK_ALLOCATABLE = 329,
+     TOK_RETURN = 330,
+     TOK_THEN = 331,
+     TOK_ELSEIF = 332,
+     TOK_ELSE = 333,
+     TOK_ENDIF = 334,
+     TOK_PRINT = 335,
+     TOK_PLAINGOTO = 336,
+     TOK_LOGICALIF = 337,
+     TOK_PLAINDO = 338,
+     TOK_CONTAINS = 339,
+     TOK_ENDDO = 340,
+     TOK_MODULE = 341,
+     TOK_ENDMODULE = 342,
+     TOK_WHILE = 343,
+     TOK_CONCURRENT = 344,
+     TOK_ALLOCATE = 345,
+     TOK_OPEN = 346,
+     TOK_CLOSE = 347,
+     TOK_INQUIRE = 348,
+     TOK_WRITE = 349,
+     TOK_FLUSH = 350,
+     TOK_READ = 351,
+     TOK_REWIND = 352,
+     TOK_DEALLOCATE = 353,
+     TOK_NULLIFY = 354,
+     TOK_DIMENSION = 355,
+     TOK_ENDSELECT = 356,
+     TOK_EXTERNAL = 357,
+     TOK_INTENT = 358,
+     TOK_INTRINSIC = 359,
+     TOK_NAMELIST = 360,
+     TOK_DEFAULT = 361,
+     TOK_OPTIONAL = 362,
+     TOK_POINTER = 363,
+     TOK_CONTINUE = 364,
+     TOK_SAVE = 365,
+     TOK_TARGET = 366,
+     TOK_IMPLICIT = 367,
+     TOK_NONE = 368,
+     TOK_CALL = 369,
+     TOK_STAT = 370,
+     TOK_POINT_TO = 371,
+     TOK_COMMON = 372,
+     TOK_GLOBAL = 373,
+     TOK_LEFTAB = 374,
+     TOK_RIGHTAB = 375,
+     TOK_PAUSE = 376,
+     TOK_PROCEDURE = 377,
+     TOK_STOP = 378,
+     TOK_REAL8 = 379,
+     TOK_FOURDOTS = 380,
+     TOK_HEXA = 381,
+     TOK_ASSIGNTYPE = 382,
+     TOK_OUT = 383,
+     TOK_INOUT = 384,
+     TOK_IN = 385,
+     TOK_USE = 386,
+     TOK_TRUE = 387,
+     TOK_FALSE = 388,
+     TOK_LABEL = 389,
+     TOK_TYPE = 390,
+     TOK_TYPEPAR = 391,
+     TOK_ENDTYPE = 392,
+     TOK_REAL = 393,
+     TOK_INTEGER = 394,
+     TOK_LOGICAL = 395,
+     TOK_DOUBLEPRECISION = 396,
+     TOK_ENDSUBROUTINE = 397,
+     TOK_ENDFUNCTION = 398,
+     TOK_ENDPROGRAM = 399,
+     TOK_ENDUNIT = 400,
+     TOK_CHARACTER = 401,
+     TOK_CHAR_CONSTANT = 402,
+     TOK_CHAR_CUT = 403,
+     TOK_DATA = 404,
+     TOK_CHAR_MESSAGE = 405,
+     TOK_CSTREAL = 406,
+     TOK_COMPLEX = 407,
+     TOK_DOUBLECOMPLEX = 408,
+     TOK_NAME = 409,
+     TOK_CSTINT = 410
+   };
+#endif
+
 
 #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
 typedef union YYSTYPE
-#line 59 "fortran.y"
 {
-       char      nac[LONG_C];
-       char      na[LONGNOM];
-       listdim  *d;
-       listvar  *l;
-       listnom  *ln;
-       listcouple  *lc;
-       listname *lnn;
-       typedim   dim1;
-       variable *v;
-       }
-/* Line 193 of yacc.c.  */
-#line 483 "fortran.tab.c"
-	YYSTYPE;
+/* Line 387 of yacc.c  */
+#line 65 "fortran.y"
+
+    char        na[LONG_M];
+    listdim     *d;
+    listvar     *l;
+    listcouple  *lc;
+    listname    *lnn;
+    typedim     dim1;
+    variable    *v;
+
+
+/* Line 387 of yacc.c  */
+#line 310 "fortran.tab.c"
+} YYSTYPE;
+# define YYSTYPE_IS_TRIVIAL 1
 # define yystype YYSTYPE /* obsolescent; will be withdrawn */
 # define YYSTYPE_IS_DECLARED 1
-# define YYSTYPE_IS_TRIVIAL 1
 #endif
 
+extern YYSTYPE fortran_lval;
+
+#ifdef YYPARSE_PARAM
+#if defined __STDC__ || defined __cplusplus
+int fortran_parse (void *YYPARSE_PARAM);
+#else
+int fortran_parse ();
+#endif
+#else /* ! YYPARSE_PARAM */
+#if defined __STDC__ || defined __cplusplus
+int fortran_parse (void);
+#else
+int fortran_parse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
 
 
 /* Copy the second part of user declarations.  */
 
-
-/* Line 216 of yacc.c.  */
-#line 496 "fortran.tab.c"
+/* Line 390 of yacc.c  */
+#line 338 "fortran.tab.c"
 
 #ifdef short
@@ -546,9 +387,9 @@
 #  if ENABLE_NLS
 #   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
-#   define YY_(msgid) dgettext ("bison-runtime", msgid)
+#   define YY_(Msgid) dgettext ("bison-runtime", Msgid)
 #  endif
 # endif
 # ifndef YY_
-#  define YY_(msgid) msgid
+#  define YY_(Msgid) Msgid
 # endif
 #endif
@@ -556,24 +397,24 @@
 /* Suppress unused-variable warnings by "using" E.  */
 #if ! defined lint || defined __GNUC__
-# define YYUSE(e) ((void) (e))
+# define YYUSE(E) ((void) (E))
 #else
-# define YYUSE(e) /* empty */
+# define YYUSE(E) /* empty */
 #endif
 
 /* Identity function, used to suppress warnings about constant conditions.  */
 #ifndef lint
-# define YYID(n) (n)
+# define YYID(N) (N)
 #else
 #if (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 static int
-YYID (int i)
+YYID (int yyi)
 #else
 static int
-YYID (i)
-    int i;
+YYID (yyi)
+    int yyi;
 #endif
 {
-  return i;
+  return yyi;
 }
 #endif
@@ -596,9 +437,10 @@
 #   else
 #    define YYSTACK_ALLOC alloca
-#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+#    if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 #     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-#     ifndef _STDLIB_H
-#      define _STDLIB_H 1
+      /* Use EXIT_SUCCESS as a witness for stdlib.h.  */
+#     ifndef EXIT_SUCCESS
+#      define EXIT_SUCCESS 0
 #     endif
 #    endif
@@ -623,15 +465,15 @@
 #   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
 #  endif
-#  if (defined __cplusplus && ! defined _STDLIB_H \
+#  if (defined __cplusplus && ! defined EXIT_SUCCESS \
        && ! ((defined YYMALLOC || defined malloc) \
 	     && (defined YYFREE || defined free)))
 #   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-#   ifndef _STDLIB_H
-#    define _STDLIB_H 1
+#   ifndef EXIT_SUCCESS
+#    define EXIT_SUCCESS 0
 #   endif
 #  endif
 #  ifndef YYMALLOC
 #   define YYMALLOC malloc
-#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+#   if ! defined malloc && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
@@ -640,5 +482,5 @@
 #  ifndef YYFREE
 #   define YYFREE free
-#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+#   if ! defined free && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 void free (void *); /* INFRINGES ON USER NAME SPACE */
@@ -656,7 +498,7 @@
 union yyalloc
 {
-  yytype_int16 yyss;
-  YYSTYPE yyvs;
-  };
+  yytype_int16 yyss_alloc;
+  YYSTYPE yyvs_alloc;
+};
 
 /* The size of the maximum gap between one aligned stack and the next.  */
@@ -669,21 +511,5 @@
       + YYSTACK_GAP_MAXIMUM)
 
-/* Copy COUNT objects from FROM to TO.  The source and destination do
-   not overlap.  */
-# ifndef YYCOPY
-#  if defined __GNUC__ && 1 < __GNUC__
-#   define YYCOPY(To, From, Count) \
-      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
-#  else
-#   define YYCOPY(To, From, Count)		\
-      do					\
-	{					\
-	  YYSIZE_T yyi;				\
-	  for (yyi = 0; yyi < (Count); yyi++)	\
-	    (To)[yyi] = (From)[yyi];		\
-	}					\
-      while (YYID (0))
-#  endif
-# endif
+# define YYCOPY_NEEDED 1
 
 /* Relocate STACK from its old location to the new one.  The
@@ -692,10 +518,10 @@
    stack.  Advance YYPTR to a properly aligned location for the next
    stack.  */
-# define YYSTACK_RELOCATE(Stack)					\
+# define YYSTACK_RELOCATE(Stack_alloc, Stack)				\
     do									\
       {									\
 	YYSIZE_T yynewbytes;						\
-	YYCOPY (&yyptr->Stack, Stack, yysize);				\
-	Stack = &yyptr->Stack;						\
+	YYCOPY (&yyptr->Stack_alloc, Stack, yysize);			\
+	Stack = &yyptr->Stack_alloc;					\
 	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
 	yyptr += yynewbytes / sizeof (*yyptr);				\
@@ -705,21 +531,41 @@
 #endif
 
+#if defined YYCOPY_NEEDED && YYCOPY_NEEDED
+/* Copy COUNT objects from SRC to DST.  The source and destination do
+   not overlap.  */
+# ifndef YYCOPY
+#  if defined __GNUC__ && 1 < __GNUC__
+#   define YYCOPY(Dst, Src, Count) \
+      __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src)))
+#  else
+#   define YYCOPY(Dst, Src, Count)              \
+      do                                        \
+        {                                       \
+          YYSIZE_T yyi;                         \
+          for (yyi = 0; yyi < (Count); yyi++)   \
+            (Dst)[yyi] = (Src)[yyi];            \
+        }                                       \
+      while (YYID (0))
+#  endif
+# endif
+#endif /* !YYCOPY_NEEDED */
+
 /* YYFINAL -- State number of the termination state.  */
 #define YYFINAL  2
 /* YYLAST -- Last index in YYTABLE.  */
-#define YYLAST   6070
+#define YYLAST   6268
 
 /* YYNTOKENS -- Number of terminals.  */
-#define YYNTOKENS  190
+#define YYNTOKENS  169
 /* YYNNTS -- Number of nonterminals.  */
-#define YYNNTS  184
+#define YYNNTS  206
 /* YYNRULES -- Number of rules.  */
-#define YYNRULES  555
+#define YYNRULES  597
 /* YYNRULES -- Number of states.  */
-#define YYNSTATES  982
+#define YYNSTATES  1051
 
 /* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
 #define YYUNDEFTOK  2
-#define YYMAXUTOK   427
+#define YYMAXUTOK   410
 
 #define YYTRANSLATE(YYX)						\
@@ -730,13 +576,13 @@
 {
        0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-     187,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     166,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,   183,     2,     2,     2,   189,     2,     2,
-     179,   180,    23,    21,     3,    22,     2,   188,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,   168,     2,     2,
+     162,   163,    21,    19,     3,    20,     2,   167,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     4,     2,
-     185,     5,   186,     2,     2,     2,     2,     2,     2,     2,
+     164,     5,   165,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,   181,     2,   182,     2,   184,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
@@ -756,5 +602,5 @@
        2,     2,     2,     2,     2,     2,     1,     2,     6,     7,
        8,     9,    10,    11,    12,    13,    14,    15,    16,    17,
-      18,    19,    20,    24,    25,    26,    27,    28,    29,    30,
+      18,    22,    23,    24,    25,    26,    27,    28,    29,    30,
       31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
       41,    42,    43,    44,    45,    46,    47,    48,    49,    50,
@@ -770,6 +616,5 @@
      141,   142,   143,   144,   145,   146,   147,   148,   149,   150,
      151,   152,   153,   154,   155,   156,   157,   158,   159,   160,
-     161,   162,   163,   164,   165,   166,   167,   168,   169,   170,
-     171,   172,   173,   174,   175,   176,   177,   178
+     161
 };
 
@@ -779,60 +624,64 @@
 static const yytype_uint16 yyprhs[] =
 {
-       0,     0,     3,     4,     7,    10,    13,    15,    19,    23,
-      25,    29,    32,    35,    39,    43,    46,    49,    52,    54,
-      56,    58,    60,    61,    62,    65,    66,    68,    69,    70,
-      72,    73,    78,    81,    88,    93,    96,    98,    99,   101,
-     103,   104,   107,   111,   112,   115,   119,   121,   125,   127,
-     129,   132,   137,   140,   143,   148,   151,   153,   155,   157,
-     159,   161,   163,   165,   167,   169,   171,   176,   180,   184,
-     187,   191,   192,   194,   196,   198,   200,   202,   204,   206,
-     208,   210,   212,   214,   216,   218,   220,   222,   224,   226,
-     228,   230,   232,   234,   236,   238,   240,   242,   244,   248,
-     252,   258,   260,   264,   268,   271,   276,   278,   282,   283,
-     286,   289,   293,   295,   297,   299,   304,   311,   316,   318,
-     322,   325,   329,   335,   339,   341,   342,   345,   347,   352,
-     356,   359,   363,   367,   371,   375,   376,   378,   381,   384,
-     388,   394,   398,   399,   402,   405,   407,   413,   419,   422,
-     426,   429,   433,   435,   439,   442,   446,   452,   454,   457,
-     459,   463,   466,   468,   472,   473,   475,   477,   481,   485,
-     488,   490,   494,   497,   500,   501,   508,   516,   517,   520,
-     523,   527,   531,   533,   534,   537,   542,   546,   550,   555,
-     558,   560,   562,   564,   566,   568,   570,   572,   574,   575,
-     578,   580,   584,   585,   588,   592,   594,   598,   601,   605,
-     607,   609,   611,   613,   614,   618,   619,   622,   627,   629,
-     633,   635,   637,   639,   642,   644,   649,   651,   653,   655,
-     657,   659,   661,   663,   665,   667,   669,   670,   674,   676,
-     680,   682,   684,   687,   690,   694,   696,   698,   700,   704,
-     706,   708,   712,   716,   721,   726,   730,   735,   740,   744,
-     749,   754,   759,   764,   769,   774,   779,   784,   789,   794,
-     799,   804,   809,   813,   818,   823,   828,   833,   835,   839,
-     841,   843,   845,   848,   851,   854,   856,   858,   861,   864,
-     867,   870,   873,   876,   879,   882,   885,   888,   891,   895,
-     898,   902,   905,   908,   911,   914,   917,   920,   923,   924,
-     926,   929,   932,   935,   937,   939,   941,   943,   944,   946,
-     949,   954,   960,   965,   969,   973,   975,   978,   980,   984,
-     986,   988,   992,   998,  1003,  1007,  1010,  1013,  1015,  1017,
-    1019,  1021,  1023,  1025,  1027,  1029,  1032,  1035,  1037,  1040,
-    1042,  1044,  1045,  1047,  1053,  1054,  1056,  1058,  1060,  1061,
-    1065,  1069,  1070,  1076,  1079,  1084,  1091,  1098,  1100,  1102,
-    1104,  1108,  1112,  1114,  1118,  1122,  1124,  1126,  1132,  1138,
-    1143,  1145,  1148,  1151,  1154,  1157,  1159,  1162,  1168,  1170,
-    1172,  1175,  1181,  1183,  1186,  1190,  1195,  1197,  1199,  1201,
-    1203,  1205,  1207,  1209,  1211,  1215,  1219,  1223,  1226,  1229,
-    1230,  1236,  1244,  1245,  1248,  1250,  1252,  1253,  1255,  1257,
-    1259,  1261,  1264,  1266,  1268,  1270,  1276,  1282,  1285,  1288,
-    1291,  1294,  1296,  1297,  1302,  1309,  1311,  1315,  1318,  1321,
-    1324,  1325,  1329,  1330,  1332,  1335,  1337,  1339,  1343,  1345,
-    1348,  1350,  1352,  1355,  1358,  1361,  1365,  1368,  1370,  1371,
-    1373,  1376,  1379,  1380,  1383,  1387,  1391,  1395,  1399,  1401,
-    1405,  1407,  1409,  1413,  1415,  1417,  1419,  1423,  1426,  1431,
-    1436,  1439,  1442,  1444,  1446,  1448,  1450,  1452,  1454,  1456,
-    1458,  1460,  1464,  1466,  1468,  1472,  1476,  1480,  1484,  1487,
-    1491,  1494,  1497,  1500,  1503,  1507,  1509,  1511,  1513,  1515,
-    1519,  1520,  1522,  1525,  1530,  1533,  1536,  1542,  1543,  1545,
-    1548,  1550,  1552,  1554,  1558,  1562,  1566,  1570,  1574,  1578,
-    1580,  1582,  1584,  1588,  1594,  1600,  1606,  1612,  1620,  1622,
-    1631,  1634,  1636,  1638,  1642,  1644,  1646,  1648,  1653,  1655,
-    1659,  1660,  1665,  1667,  1671,  1675
+       0,     0,     3,     4,     7,     9,    11,    14,    16,    19,
+      21,    25,    28,    31,    33,    37,    41,    44,    47,    51,
+      53,    54,    55,    57,    58,    61,    66,    69,    75,    78,
+      80,    83,    85,    87,    88,    91,    95,    96,    99,   103,
+     105,   109,   111,   113,   116,   121,   124,   127,   132,   135,
+     137,   139,   141,   143,   145,   147,   149,   151,   153,   158,
+     162,   166,   169,   172,   173,   175,   177,   179,   181,   183,
+     185,   187,   189,   191,   193,   195,   197,   199,   201,   203,
+     205,   207,   209,   211,   213,   215,   217,   219,   221,   223,
+     225,   229,   233,   239,   241,   245,   249,   252,   257,   259,
+     263,   264,   266,   269,   273,   275,   277,   280,   282,   286,
+     291,   296,   305,   307,   311,   314,   318,   324,   328,   330,
+     331,   334,   336,   341,   345,   348,   352,   356,   360,   364,
+     365,   367,   370,   374,   380,   384,   386,   392,   398,   401,
+     405,   408,   412,   414,   416,   420,   424,   427,   431,   437,
+     439,   442,   444,   448,   451,   453,   457,   458,   460,   462,
+     466,   470,   473,   475,   479,   482,   485,   491,   498,   499,
+     502,   505,   509,   513,   514,   517,   522,   526,   530,   535,
+     538,   540,   542,   544,   546,   548,   550,   552,   553,   556,
+     558,   562,   563,   566,   570,   572,   576,   579,   583,   585,
+     587,   589,   591,   593,   594,   598,   599,   601,   605,   607,
+     611,   613,   615,   617,   620,   622,   627,   629,   631,   633,
+     635,   637,   639,   641,   643,   645,   647,   648,   652,   654,
+     658,   660,   662,   665,   668,   672,   674,   676,   678,   680,
+     682,   686,   690,   694,   699,   704,   708,   713,   718,   722,
+     727,   732,   737,   742,   747,   752,   757,   762,   767,   772,
+     777,   782,   787,   791,   796,   800,   805,   810,   812,   816,
+     818,   820,   822,   825,   828,   831,   833,   835,   838,   841,
+     844,   847,   850,   853,   856,   859,   862,   866,   870,   873,
+     876,   879,   882,   885,   888,   891,   894,   897,   900,   901,
+     903,   906,   909,   912,   914,   916,   918,   920,   921,   923,
+     926,   931,   937,   942,   947,   951,   953,   956,   958,   962,
+     964,   966,   970,   976,   981,   985,   988,   991,   993,   995,
+     997,   999,  1001,  1003,  1005,  1007,  1010,  1013,  1015,  1018,
+    1020,  1022,  1023,  1025,  1031,  1032,  1034,  1036,  1038,  1039,
+    1042,  1045,  1051,  1054,  1059,  1066,  1073,  1075,  1077,  1081,
+    1085,  1087,  1091,  1095,  1097,  1099,  1101,  1103,  1105,  1107,
+    1109,  1111,  1113,  1116,  1118,  1120,  1123,  1126,  1129,  1133,
+    1136,  1142,  1148,  1151,  1154,  1157,  1160,  1162,  1167,  1169,
+    1172,  1175,  1178,  1181,  1183,  1185,  1187,  1189,  1195,  1202,
+    1203,  1207,  1208,  1213,  1214,  1219,  1224,  1226,  1228,  1230,
+    1232,  1234,  1238,  1243,  1245,  1248,  1250,  1253,  1254,  1255,
+    1258,  1262,  1264,  1269,  1271,  1273,  1278,  1281,  1287,  1291,
+    1295,  1297,  1302,  1305,  1312,  1321,  1327,  1331,  1333,  1335,
+    1337,  1339,  1341,  1344,  1351,  1352,  1354,  1357,  1361,  1362,
+    1364,  1367,  1371,  1379,  1385,  1391,  1398,  1400,  1403,  1405,
+    1408,  1414,  1419,  1420,  1422,  1425,  1429,  1436,  1441,  1444,
+    1448,  1450,  1453,  1457,  1459,  1461,  1465,  1467,  1470,  1473,
+    1477,  1479,  1481,  1483,  1485,  1487,  1489,  1491,  1493,  1495,
+    1496,  1501,  1509,  1511,  1515,  1518,  1521,  1524,  1525,  1529,
+    1530,  1532,  1535,  1538,  1540,  1542,  1546,  1548,  1551,  1553,
+    1555,  1556,  1558,  1561,  1564,  1565,  1568,  1572,  1576,  1580,
+    1582,  1586,  1588,  1590,  1594,  1596,  1598,  1600,  1604,  1610,
+    1615,  1618,  1621,  1622,  1624,  1626,  1628,  1630,  1632,  1634,
+    1636,  1638,  1640,  1644,  1646,  1648,  1652,  1656,  1660,  1664,
+    1667,  1671,  1674,  1677,  1680,  1683,  1686,  1689,  1692,  1696,
+    1698,  1700,  1702,  1704,  1708,  1711,  1716,  1719,  1722,  1728,
+    1729,  1731,  1734,  1736,  1738,  1740,  1742,  1746,  1750,  1754,
+    1758,  1762,  1766,  1772,  1778,  1784,  1790,  1798,  1807,  1810,
+    1812,  1816,  1818,  1820,  1824,  1825,  1830,  1832
 };
 
@@ -840,172 +689,188 @@
 static const yytype_int16 yyrhs[] =
 {
-     191,     0,    -1,    -1,   191,   192,    -1,   187,   198,    -1,
-     199,   193,    -1,   177,    -1,   197,   200,   205,    -1,     1,
-     205,   201,    -1,   194,    -1,   193,    27,   194,    -1,   203,
-     196,    -1,   212,   196,    -1,   206,   207,   196,    -1,   315,
-     200,   205,    -1,   195,   196,    -1,   298,     4,    -1,   198,
-     200,    -1,    53,    -1,    54,    -1,    36,    -1,    37,    -1,
-      -1,    -1,   144,   201,    -1,    -1,   177,    -1,    -1,    -1,
-      72,    -1,    -1,   202,    33,   204,   208,    -1,    34,   204,
-      -1,   202,    35,   204,   208,    30,   209,    -1,   202,    35,
-     204,   208,    -1,    95,   169,    -1,   169,    -1,    -1,    32,
-      -1,   158,    -1,    -1,   179,   180,    -1,   179,   210,   180,
-      -1,    -1,   179,   180,    -1,   179,   210,   180,    -1,   211,
-      -1,   210,     3,   211,    -1,   169,    -1,    23,    -1,   257,
-     222,    -1,   145,   213,   221,   324,    -1,   147,   324,    -1,
-     117,   216,    -1,   224,   179,   249,   180,    -1,   224,   249,
-      -1,   243,    -1,   228,    -1,   253,    -1,   239,    -1,   241,
-      -1,   240,    -1,   308,    -1,   251,    -1,   237,    -1,   234,
-      -1,    68,   179,   280,   180,    -1,   111,   221,   242,    -1,
-     113,   221,   215,    -1,    67,   217,    -1,   225,   226,   187,
-      -1,    -1,   275,    -1,    46,    -1,    40,    -1,    44,    -1,
-      56,    -1,    79,    -1,    45,    -1,    47,    -1,    62,    -1,
-      57,    -1,    58,    -1,    59,    -1,    60,    -1,    61,    -1,
-      64,    -1,    65,    -1,    66,    -1,    69,    -1,    70,    -1,
-      71,    -1,    74,    -1,    75,    -1,    76,    -1,    77,    -1,
-     169,    -1,   214,    -1,   215,     3,   214,    -1,   179,   220,
-     180,    -1,   216,     3,   179,   220,   180,    -1,   218,    -1,
-     217,     3,   218,    -1,   179,   219,   180,    -1,   298,   276,
-      -1,   219,     3,   298,   276,    -1,   280,    -1,   220,     3,
-     280,    -1,    -1,     4,     4,    -1,   255,   256,    -1,   223,
-     204,   208,    -1,    35,    -1,    29,    -1,   160,    -1,   169,
-      24,   227,    24,    -1,   226,   248,   169,    24,   227,    24,
-      -1,   231,    24,   227,    24,    -1,   232,    -1,   232,     3,
-     227,    -1,   229,   230,    -1,   229,   247,   230,    -1,   228,
-     248,   247,   248,   230,    -1,   228,     3,   230,    -1,   119,
-      -1,    -1,   169,   276,    -1,   169,    -1,   169,   179,   280,
-     180,    -1,   231,     3,   231,    -1,   233,   299,    -1,   232,
-      21,   232,    -1,   232,    22,   232,    -1,   232,    23,   232,
-      -1,   232,   188,   232,    -1,    -1,   284,    -1,   235,   236,
-      -1,   114,   298,    -1,   114,   247,   298,    -1,   235,   248,
-     247,   248,   298,    -1,   235,     3,   298,    -1,    -1,   129,
-     324,    -1,   130,   324,    -1,   109,    -1,   238,   248,   169,
-     276,   264,    -1,   239,     3,   169,   276,   264,    -1,    81,
-     187,    -1,    81,   221,   242,    -1,    80,   187,    -1,    80,
-     221,   242,    -1,   169,    -1,   242,     3,   169,    -1,   244,
-     245,    -1,   244,   247,   245,    -1,   243,   248,   247,   248,
-     245,    -1,   127,    -1,   128,   127,    -1,   246,    -1,   245,
-       3,   246,    -1,   169,   276,    -1,    20,    -1,    24,   169,
-      24,    -1,    -1,     3,    -1,   250,    -1,   249,     3,   250,
-      -1,   169,     5,   280,    -1,   134,   252,    -1,   169,    -1,
-     252,     3,   169,    -1,   122,   123,    -1,   122,   137,    -1,
-      -1,   271,   254,   169,   276,   264,   305,    -1,   255,     3,
-     254,   169,   276,   264,   305,    -1,    -1,   262,   266,    -1,
-     261,   259,    -1,   263,    23,   176,    -1,   258,   268,   180,
-      -1,   146,    -1,    -1,    23,   176,    -1,    23,   179,   260,
-     180,    -1,   179,   260,   180,    -1,   169,   269,   270,    -1,
-     169,     5,   269,   270,    -1,   269,   270,    -1,   157,    -1,
-     263,    -1,   149,    -1,   148,    -1,   167,    -1,   151,    -1,
-     168,    -1,   150,    -1,    -1,    23,   265,    -1,   280,    -1,
-     179,    23,   180,    -1,    -1,    23,   267,    -1,   179,   268,
-     180,    -1,   280,    -1,   179,    23,   180,    -1,   169,   269,
-      -1,   169,     5,   269,    -1,   169,    -1,   176,    -1,   280,
-      -1,    23,    -1,    -1,     3,   169,   269,    -1,    -1,     4,
-       4,    -1,     3,   272,     4,     4,    -1,   273,    -1,   272,
-       3,   273,    -1,    29,    -1,   275,    -1,    82,    -1,   109,
-     276,    -1,   111,    -1,   112,   179,   274,   180,    -1,   113,
-      -1,   116,    -1,   117,    -1,   119,    -1,   120,    -1,   140,
-      -1,   138,    -1,   139,    -1,    80,    -1,    81,    -1,    -1,
-     179,   277,   180,    -1,   278,    -1,   277,     3,   278,    -1,
-     279,    -1,     4,    -1,   280,     4,    -1,     4,   280,    -1,
-     280,     4,   279,    -1,    23,    -1,   280,    -1,   283,    -1,
-     179,   280,   180,    -1,   307,    -1,   281,    -1,    46,   282,
-     180,    -1,    39,   282,   180,    -1,    40,   179,   282,   180,
-      -1,    44,   179,   282,   180,    -1,    56,   282,   180,    -1,
-      79,   179,   282,   180,    -1,    45,   179,   280,   180,    -1,
-      47,   280,   180,    -1,   148,   179,   282,   180,    -1,    62,
-     179,   280,   180,    -1,    57,   179,   280,   180,    -1,    58,
-     179,   280,   180,    -1,    59,   179,   280,   180,    -1,    60,
-     179,   280,   180,    -1,    61,   179,   280,   180,    -1,    64,
-     179,   280,   180,    -1,    65,   179,   280,   180,    -1,    66,
-     179,   280,   180,    -1,    69,   179,   280,   180,    -1,    70,
-     179,   280,   180,    -1,    71,   179,   280,   180,    -1,    73,
-     280,   180,    -1,    74,   179,   282,   180,    -1,    75,   179,
-     282,   180,    -1,    76,   179,   282,   180,    -1,    77,   179,
-     282,   180,    -1,   280,    -1,   282,     3,   280,    -1,   288,
-      -1,   299,    -1,   293,    -1,   280,   285,    -1,   284,   280,
-      -1,    12,   280,    -1,    21,    -1,    22,    -1,    21,   280,
-      -1,    22,   280,    -1,    23,   280,    -1,    25,   280,    -1,
-      14,   280,    -1,     8,   280,    -1,    17,   280,    -1,   186,
-     280,    -1,    18,   280,    -1,   185,   280,    -1,    15,   280,
-      -1,   186,     5,   280,    -1,    16,   280,    -1,   185,     5,
-     280,    -1,    13,   280,    -1,     7,   280,    -1,     9,   280,
-      -1,    10,   280,    -1,    11,   280,    -1,    24,   286,    -1,
-       5,   287,    -1,    -1,   280,    -1,     5,   280,    -1,    24,
-     280,    -1,     5,   280,    -1,   280,    -1,   298,    -1,   292,
-      -1,   290,    -1,    -1,   291,    -1,   291,   302,    -1,   292,
-     179,   294,   180,    -1,   292,   179,   294,   180,   302,    -1,
-     298,   179,   294,   180,    -1,   288,   189,   288,    -1,   131,
-     360,   132,    -1,   289,    -1,   289,   295,    -1,   296,    -1,
-     295,     3,   296,    -1,   280,    -1,   297,    -1,   280,     4,
-     280,    -1,   280,     4,   280,     4,   280,    -1,     4,   280,
-       4,   280,    -1,     4,     4,   280,    -1,     4,   280,    -1,
-     280,     4,    -1,     4,    -1,   169,    -1,   142,    -1,   143,
-      -1,   176,    -1,   163,    -1,   164,    -1,   165,    -1,   299,
-     169,    -1,   300,   301,    -1,   158,    -1,   300,   158,    -1,
-     162,    -1,   159,    -1,    -1,   302,    -1,   179,   303,     4,
-     303,   180,    -1,    -1,   280,    -1,   187,    -1,   280,    -1,
-      -1,   306,     5,   280,    -1,   306,   126,   280,    -1,    -1,
-     179,   283,     3,   283,   180,    -1,   309,   310,    -1,   309,
-     310,     3,   311,    -1,   309,   310,     3,    31,     4,   187,
-      -1,   309,   310,     3,    31,     4,   313,    -1,   141,    -1,
-     169,    -1,   312,    -1,   311,     3,   312,    -1,   169,   126,
-     169,    -1,   314,    -1,   313,     3,   314,    -1,   169,   126,
-     169,    -1,   169,    -1,   328,    -1,    98,   179,   366,   370,
-     180,    -1,   105,   179,   369,   370,   180,    -1,   106,   179,
-     371,   180,    -1,   317,    -1,   318,   324,    -1,   316,   324,
-      -1,   319,   324,    -1,    96,   324,    -1,   321,    -1,   372,
-     328,    -1,    41,   179,   280,   180,   304,    -1,    42,    -1,
-      43,    -1,   372,    84,    -1,    85,   179,   280,   180,    84,
-      -1,    86,    -1,    87,   324,    -1,    48,   320,   180,    -1,
-      49,   179,   280,   180,    -1,   115,    -1,   110,    -1,    93,
-      -1,   153,    -1,   156,    -1,   155,    -1,   154,    -1,   280,
-      -1,   320,     3,   280,    -1,   320,     4,   280,    -1,   326,
-     323,   322,    -1,   327,   280,    -1,    94,   325,    -1,    -1,
-     373,     5,   280,     3,   280,    -1,   373,     5,   280,     3,
-     280,     3,   280,    -1,    -1,   176,   248,    -1,   187,    -1,
-     169,    -1,    -1,   169,    -1,    92,    -1,    97,    -1,   118,
-      -1,   330,   332,    -1,   365,    -1,   341,    -1,   333,    -1,
-      98,   179,   366,   370,   180,    -1,   105,   179,   369,   370,
-     180,    -1,    78,   303,    -1,    83,   304,    -1,    63,   304,
-      -1,   340,   304,    -1,   331,    -1,    -1,   298,   329,   276,
-     276,    -1,   330,   189,   298,   329,   276,   276,    -1,   176,
-      -1,   331,     3,   176,    -1,     5,   280,    -1,   126,   280,
-      -1,   336,   334,    -1,    -1,   179,   335,   180,    -1,    -1,
-     338,    -1,   337,   169,    -1,   124,    -1,   339,    -1,   338,
-       3,   339,    -1,   280,    -1,    23,   364,    -1,   133,    -1,
-     135,    -1,   349,   345,    -1,   351,   343,    -1,   352,   345,
-      -1,   352,   345,   360,    -1,   104,   346,    -1,    38,    -1,
-      -1,   356,    -1,   345,   342,    -1,   350,   344,    -1,    -1,
-       3,   356,    -1,   179,   347,   180,    -1,   179,   353,   180,
-      -1,   179,   298,   180,    -1,   179,   176,   180,    -1,   176,
-      -1,   179,   283,   180,    -1,   169,    -1,   348,    -1,   347,
-       3,   348,    -1,   353,    -1,    23,    -1,    25,    -1,   298,
-     280,   276,    -1,   298,   280,    -1,   298,   280,   189,   330,
-      -1,   298,   179,   297,   180,    -1,   298,    23,    -1,   298,
-      25,    -1,    99,    -1,   100,    -1,   354,    -1,    23,    -1,
-     103,    -1,   101,    -1,    88,    -1,   102,    -1,   354,    -1,
-     179,   353,   180,    -1,   288,    -1,   299,    -1,   353,   355,
-     353,    -1,   353,    23,   353,    -1,   353,    24,   353,    -1,
-     353,    25,   353,    -1,   355,   353,    -1,   353,    20,   353,
-      -1,    50,   280,    -1,    55,   280,    -1,    52,   280,    -1,
-      51,   280,    -1,   169,     5,   280,    -1,   281,    -1,    21,
-      -1,    22,    -1,   358,    -1,   356,     3,   358,    -1,    -1,
-     288,    -1,   357,   359,    -1,   179,   356,   180,   359,    -1,
-     281,   359,    -1,   299,   359,    -1,   179,   356,     3,   363,
-     180,    -1,    -1,   285,    -1,   359,   285,    -1,   283,    -1,
-     362,    -1,   361,    -1,   283,     3,   280,    -1,   283,     3,
-     362,    -1,   362,     3,   280,    -1,   362,     3,   362,    -1,
-     361,     3,   280,    -1,   361,     3,   362,    -1,   283,    -1,
-     281,    -1,   307,    -1,   179,   280,   180,    -1,   179,   283,
-       3,   363,   180,    -1,   179,   362,     3,   363,   180,    -1,
-     179,   361,     3,   363,   180,    -1,   169,     5,   280,     3,
-     280,    -1,   169,     5,   280,     3,   280,     3,   280,    -1,
-     176,    -1,    89,   179,   280,     3,   280,   180,     3,   280,
-      -1,    89,   364,    -1,   367,    -1,   330,    -1,   366,     3,
-     367,    -1,   298,    -1,   292,    -1,   368,    -1,   298,   179,
-     295,   180,    -1,   367,    -1,   369,     3,   367,    -1,    -1,
-       3,   125,     5,   298,    -1,   298,    -1,   371,     3,   298,
-      -1,    91,   280,   180,    -1,   298,    -1
+     170,     0,    -1,    -1,   170,   171,    -1,   172,    -1,   173,
+      -1,   140,   173,    -1,     1,    -1,   166,   175,    -1,    24,
+      -1,   172,   166,   175,    -1,   172,    24,    -1,   172,   140,
+      -1,   174,    -1,   173,    24,   166,    -1,   173,    24,   174,
+      -1,   178,   175,    -1,   186,   175,    -1,    28,   181,   175,
+      -1,   282,    -1,    -1,    -1,    70,    -1,    -1,    26,   183,
+      -1,   176,    29,   180,   182,    -1,    30,   180,    -1,   176,
+      31,   180,   182,   177,    -1,    92,   160,    -1,   161,    -1,
+     179,   161,    -1,   160,    -1,   153,    -1,    -1,   162,   163,
+      -1,   162,   184,   163,    -1,    -1,   162,   163,    -1,   162,
+     184,   163,    -1,   185,    -1,   184,     3,   185,    -1,   160,
+      -1,    21,    -1,   228,   196,    -1,   141,   187,   195,   336,
+      -1,   143,   336,    -1,   114,   190,    -1,   198,   162,   221,
+     163,    -1,   198,   221,    -1,   215,    -1,   203,    -1,   225,
+      -1,   211,    -1,   213,    -1,   212,    -1,   276,    -1,   223,
+      -1,   209,    -1,    66,   162,   249,   163,    -1,   108,   195,
+     214,    -1,   110,   195,   189,    -1,    65,   191,    -1,   199,
+     166,    -1,    -1,   244,    -1,    42,    -1,    34,    -1,    39,
+      -1,    54,    -1,    77,    -1,    40,    -1,    43,    -1,    60,
+      -1,    55,    -1,    56,    -1,    57,    -1,    58,    -1,    59,
+      -1,    62,    -1,    63,    -1,    64,    -1,    67,    -1,    68,
+      -1,    69,    -1,    72,    -1,    73,    -1,    74,    -1,    75,
+      -1,   160,    -1,   188,    -1,   189,     3,   188,    -1,   162,
+     194,   163,    -1,   190,     3,   162,   194,   163,    -1,   192,
+      -1,   191,     3,   192,    -1,   162,   193,   163,    -1,   267,
+     245,    -1,   193,     3,   267,   245,    -1,   249,    -1,   194,
+       3,   249,    -1,    -1,   131,    -1,   226,   227,    -1,   197,
+     180,   182,    -1,    31,    -1,    25,    -1,   155,   200,    -1,
+     201,    -1,   200,   220,   201,    -1,   160,    22,   202,    22,
+      -1,   206,    22,   202,    22,    -1,   162,   257,     3,   368,
+     163,    22,   202,    22,    -1,   207,    -1,   207,     3,   202,
+      -1,   204,   205,    -1,   204,   219,   205,    -1,   203,   220,
+     219,   220,   205,    -1,   203,     3,   205,    -1,   116,    -1,
+      -1,   160,   245,    -1,   160,    -1,   160,   162,   249,   163,
+      -1,   206,     3,   206,    -1,   208,   268,    -1,   207,    19,
+     207,    -1,   207,    20,   207,    -1,   207,    21,   207,    -1,
+     207,   167,   207,    -1,    -1,   253,    -1,   111,   267,    -1,
+     111,   219,   267,    -1,   209,   220,   219,   220,   267,    -1,
+     209,     3,   267,    -1,   106,    -1,   210,   220,   160,   245,
+     233,    -1,   211,     3,   160,   245,   233,    -1,    79,   166,
+      -1,    79,   195,   214,    -1,    78,   166,    -1,    78,   195,
+     214,    -1,   160,    -1,   133,    -1,   214,     3,   160,    -1,
+     214,     3,   133,    -1,   216,   217,    -1,   216,   219,   217,
+      -1,   215,   220,   219,   220,   217,    -1,   123,    -1,   124,
+     123,    -1,   218,    -1,   217,     3,   218,    -1,   160,   245,
+      -1,    18,    -1,    22,   160,    22,    -1,    -1,     3,    -1,
+     222,    -1,   221,     3,   222,    -1,   160,     5,   249,    -1,
+     128,   224,    -1,   160,    -1,   224,     3,   160,    -1,   118,
+     119,    -1,   118,   130,    -1,   240,   160,   245,   233,   274,
+      -1,   226,     3,   160,   245,   233,   274,    -1,    -1,   232,
+     235,    -1,   231,   229,    -1,   232,    21,   161,    -1,   142,
+     237,   163,    -1,    -1,    21,   161,    -1,    21,   162,   230,
+     163,    -1,   162,   230,   163,    -1,   160,   238,   239,    -1,
+     160,     5,   238,   239,    -1,   238,   239,    -1,   152,    -1,
+     145,    -1,   146,    -1,   144,    -1,   158,    -1,   159,    -1,
+     147,    -1,    -1,    21,   234,    -1,   249,    -1,   162,    21,
+     163,    -1,    -1,    21,   236,    -1,   162,   237,   163,    -1,
+     249,    -1,   162,    21,   163,    -1,   160,   238,    -1,   160,
+       5,   238,    -1,   160,    -1,   161,    -1,   133,    -1,   249,
+      -1,    21,    -1,    -1,     3,   160,   238,    -1,    -1,   131,
+      -1,     3,   241,   131,    -1,   242,    -1,   241,     3,   242,
+      -1,    25,    -1,   244,    -1,    80,    -1,   106,   245,    -1,
+     108,    -1,   109,   162,   243,   163,    -1,   110,    -1,   113,
+      -1,   114,    -1,   116,    -1,   117,    -1,   136,    -1,   134,
+      -1,   135,    -1,    78,    -1,    79,    -1,    -1,   162,   246,
+     163,    -1,   247,    -1,   246,     3,   247,    -1,   248,    -1,
+       4,    -1,   249,     4,    -1,     4,   249,    -1,   249,     4,
+     248,    -1,    21,    -1,   249,    -1,   252,    -1,   275,    -1,
+     250,    -1,   162,   249,   163,    -1,    42,   251,   163,    -1,
+      33,   251,   163,    -1,    34,   162,   251,   163,    -1,    39,
+     162,   251,   163,    -1,    54,   251,   163,    -1,    77,   162,
+     251,   163,    -1,    40,   162,   249,   163,    -1,    43,   249,
+     163,    -1,   144,   162,   251,   163,    -1,    60,   162,   249,
+     163,    -1,    55,   162,   249,   163,    -1,    56,   162,   249,
+     163,    -1,    57,   162,   249,   163,    -1,    58,   162,   249,
+     163,    -1,    59,   162,   249,   163,    -1,    62,   162,   249,
+     163,    -1,    63,   162,   249,   163,    -1,    64,   162,   249,
+     163,    -1,    67,   162,   249,   163,    -1,    68,   162,   249,
+     163,    -1,    69,   162,   249,   163,    -1,    71,   249,   163,
+      -1,    72,   162,   251,   163,    -1,    73,   251,   163,    -1,
+      74,   162,   251,   163,    -1,    75,   162,   251,   163,    -1,
+     249,    -1,   251,     3,   249,    -1,   257,    -1,   268,    -1,
+     262,    -1,   249,   254,    -1,   253,   249,    -1,    11,   249,
+      -1,    19,    -1,    20,    -1,    19,   249,    -1,    20,   249,
+      -1,    21,   249,    -1,    23,   249,    -1,    13,   249,    -1,
+       7,   249,    -1,    16,   249,    -1,   165,   249,    -1,   164,
+     249,    -1,   165,     5,   249,    -1,   164,     5,   249,    -1,
+      17,   249,    -1,    14,   249,    -1,    15,   249,    -1,    12,
+     249,    -1,     6,   249,    -1,     8,   249,    -1,     9,   249,
+      -1,    10,   249,    -1,    22,   255,    -1,     5,   256,    -1,
+      -1,   249,    -1,     5,   249,    -1,    22,   249,    -1,     5,
+     249,    -1,   249,    -1,   267,    -1,   261,    -1,   259,    -1,
+      -1,   260,    -1,   260,   271,    -1,   261,   162,   263,   163,
+      -1,   261,   162,   263,   163,   271,    -1,   267,   162,   263,
+     163,    -1,   257,   168,   356,   257,    -1,   125,   366,   126,
+      -1,   258,    -1,   258,   264,    -1,   265,    -1,   264,     3,
+     265,    -1,   249,    -1,   266,    -1,   249,     4,   249,    -1,
+     249,     4,   249,     4,   249,    -1,     4,   249,     4,   249,
+      -1,     4,     4,   249,    -1,     4,   249,    -1,   249,     4,
+      -1,     4,    -1,   160,    -1,   138,    -1,   139,    -1,    41,
+      -1,   161,    -1,   157,    -1,   132,    -1,   268,   160,    -1,
+     269,   270,    -1,   153,    -1,   269,   153,    -1,   156,    -1,
+     154,    -1,    -1,   271,    -1,   162,   272,     4,   272,   163,
+      -1,    -1,   249,    -1,   166,    -1,   249,    -1,    -1,     5,
+     249,    -1,   122,   249,    -1,   162,   252,     3,   252,   163,
+      -1,   277,   160,    -1,   277,   160,     3,   278,    -1,   277,
+     160,     3,    27,     4,   166,    -1,   277,   160,     3,    27,
+       4,   280,    -1,   137,    -1,   279,    -1,   278,     3,   279,
+      -1,   160,   122,   160,    -1,   281,    -1,   280,     3,   281,
+      -1,   160,   122,   160,    -1,   160,    -1,   283,    -1,   331,
+      -1,   284,    -1,   300,    -1,   320,    -1,   310,    -1,   287,
+      -1,   115,    -1,   338,   340,    -1,   369,    -1,   341,    -1,
+     357,   352,    -1,   359,   350,    -1,   100,   352,    -1,   100,
+     352,   366,    -1,   103,   353,    -1,    96,   162,   370,   373,
+     163,    -1,   104,   162,   372,   373,   163,    -1,    76,   272,
+      -1,    81,   273,    -1,    61,   273,    -1,   348,   273,    -1,
+     339,    -1,   105,   162,   374,   163,    -1,   333,    -1,   334,
+     336,    -1,   332,   336,    -1,   335,   336,    -1,    93,   336,
+      -1,   319,    -1,   286,    -1,    90,    -1,   249,    -1,    35,
+     162,   294,   163,   293,    -1,   291,   172,   288,   289,   290,
+     297,    -1,    -1,   288,   292,   172,    -1,    -1,   289,   295,
+     172,   288,    -1,    -1,   290,   296,   172,   288,    -1,    35,
+     162,   294,   163,    -1,   293,    -1,   286,    -1,   287,    -1,
+     285,    -1,   249,    -1,    36,   294,   163,    -1,    36,   294,
+     163,   160,    -1,    37,    -1,    37,   160,    -1,    38,    -1,
+      38,   160,    -1,    -1,    -1,   299,   282,    -1,   299,   282,
+     172,    -1,   301,    -1,   302,   172,   307,   308,    -1,   303,
+      -1,   304,    -1,   160,     4,    89,   179,    -1,    89,   179,
+      -1,   160,     4,    89,   179,   305,    -1,    89,   179,   305,
+      -1,   160,     4,    89,    -1,    89,    -1,   160,     4,    89,
+     305,    -1,    89,   305,    -1,   220,   306,     5,   249,     3,
+     249,    -1,   220,   306,     5,   249,     3,   249,     3,   249,
+      -1,   220,    94,   162,   249,   163,    -1,   220,    95,   298,
+      -1,   267,    -1,   299,    -1,   309,    -1,   330,    -1,    91,
+      -1,    91,   160,    -1,   315,   172,   299,   311,   313,   318,
+      -1,    -1,   312,    -1,   311,   312,    -1,   316,   172,   299,
+      -1,    -1,   314,    -1,   313,   312,    -1,   317,   172,   299,
+      -1,   160,     4,    88,   162,   249,   163,    82,    -1,    88,
+     162,   249,   163,    82,    -1,    83,   162,   249,   163,    82,
+      -1,    83,   162,   249,   163,    82,   160,    -1,    84,    -1,
+      84,   160,    -1,    85,    -1,    85,   160,    -1,    88,   162,
+     249,   163,   284,    -1,   323,   172,   321,   325,    -1,    -1,
+     322,    -1,   321,   322,    -1,   324,   172,   299,    -1,   160,
+       4,    45,   162,   249,   163,    -1,    45,   162,   249,   163,
+      -1,    44,   326,    -1,    44,   326,   160,    -1,   107,    -1,
+     107,   160,    -1,   162,   327,   163,    -1,   112,    -1,   328,
+      -1,   327,     3,   328,    -1,   329,    -1,   329,     4,    -1,
+       4,   329,    -1,   329,     4,   329,    -1,   249,    -1,   115,
+      -1,    32,    -1,   148,    -1,   151,    -1,   150,    -1,   149,
+      -1,   166,    -1,   160,    -1,    -1,   267,   337,   245,   245,
+      -1,   338,   168,   356,   267,   337,   245,   245,    -1,   161,
+      -1,   339,     3,   161,    -1,     5,   249,    -1,   122,   249,
+      -1,   344,   342,    -1,    -1,   162,   343,   163,    -1,    -1,
+     346,    -1,   345,   101,    -1,   345,   160,    -1,   120,    -1,
+     347,    -1,   346,     3,   347,    -1,   249,    -1,    21,   161,
+      -1,   127,    -1,   129,    -1,    -1,   363,    -1,   352,   349,
+      -1,   358,   351,    -1,    -1,     3,   363,    -1,   162,   354,
+     163,    -1,   162,   267,   163,    -1,   162,   161,   163,    -1,
+     161,    -1,   162,   252,   163,    -1,   160,    -1,   355,    -1,
+     354,     3,   355,    -1,   360,    -1,    21,    -1,    23,    -1,
+     267,   249,   245,    -1,   267,   249,   168,   356,   338,    -1,
+     267,   162,   266,   163,    -1,   267,    21,    -1,   267,    23,
+      -1,    -1,    97,    -1,    98,    -1,   101,    -1,   361,    -1,
+      21,    -1,   102,    -1,    99,    -1,    86,    -1,   361,    -1,
+     162,   360,   163,    -1,   257,    -1,   268,    -1,   360,   362,
+     360,    -1,   360,    21,   360,    -1,   360,    22,   360,    -1,
+     360,    23,   360,    -1,   362,   360,    -1,   360,    18,   360,
+      -1,    46,   249,    -1,    47,   249,    -1,    49,   249,    -1,
+      48,   249,    -1,    53,   249,    -1,    52,   249,    -1,    50,
+     249,    -1,   160,     5,   249,    -1,   250,    -1,    19,    -1,
+      20,    -1,   364,    -1,   363,     3,   364,    -1,   257,   365,
+      -1,   162,   363,   163,   365,    -1,   250,   365,    -1,   268,
+     365,    -1,   162,   363,     3,   368,   163,    -1,    -1,   254,
+      -1,   365,   254,    -1,   275,    -1,   250,    -1,   252,    -1,
+     367,    -1,   252,     3,   249,    -1,   252,     3,   367,    -1,
+     367,     3,   249,    -1,   367,     3,   367,    -1,   366,     3,
+     249,    -1,   366,     3,   367,    -1,   162,   252,     3,   368,
+     163,    -1,   162,   366,     3,   368,   163,    -1,   162,   367,
+       3,   368,   163,    -1,   160,     5,   249,     3,   249,    -1,
+     160,     5,   249,     3,   249,     3,   249,    -1,    87,   162,
+     249,     3,   249,   163,     3,   249,    -1,    87,   161,    -1,
+     371,    -1,   370,     3,   371,    -1,   257,    -1,   371,    -1,
+     372,     3,   371,    -1,    -1,     3,   121,     5,   257,    -1,
+     267,    -1,   374,     3,   267,    -1
 };
 
@@ -1013,144 +878,153 @@
 static const yytype_uint16 yyrline[] =
 {
-       0,   336,   336,   337,   339,   340,   341,   342,   343,   346,
-     347,   349,   350,   351,   360,   361,   363,   365,   367,   374,
-     379,   380,   382,   384,   385,   387,   388,   394,   397,   398,
-     401,   402,   430,   448,   481,   515,   532,   539,   541,   545,
-     550,   553,   556,   561,   562,   563,   571,   582,   594,   595,
-     597,   605,   613,   619,   620,   635,   648,   649,   655,   656,
-     693,   706,   707,   708,   709,   710,   711,   712,   713,   714,
-     715,   734,   735,   741,   742,   743,   744,   745,   746,   747,
-     748,   749,   750,   751,   752,   753,   754,   755,   756,   757,
-     758,   759,   760,   761,   762,   763,   764,   766,   767,   769,
-     770,   772,   773,   775,   777,   778,   780,   781,   783,   784,
-     786,   870,   907,   913,   918,   923,   937,   951,   966,   973,
-     982,   983,   984,   985,   987,   992,   993,   998,  1002,  1007,
-    1012,  1014,  1016,  1018,  1020,  1024,  1025,  1028,  1030,  1031,
-    1032,  1033,  1035,  1037,  1042,  1047,  1053,  1069,  1086,  1087,
-    1089,  1093,  1098,  1102,  1107,  1113,  1124,  1136,  1141,  1147,
-    1152,  1156,  1166,  1175,  1185,  1186,  1188,  1192,  1197,  1220,
-    1222,  1223,  1225,  1235,  1237,  1239,  1272,  1307,  1309,  1311,
-    1315,  1320,  1326,  1334,  1335,  1337,  1338,  1340,  1341,  1342,
-    1344,  1349,  1351,  1356,  1360,  1363,  1369,  1371,  1377,  1378,
-    1380,  1381,  1383,  1384,  1385,  1387,  1388,  1390,  1391,  1400,
-    1404,  1409,  1411,  1414,  1415,  1417,  1418,  1419,  1421,  1422,
-    1424,  1428,  1429,  1431,  1436,  1438,  1440,  1441,  1442,  1443,
-    1449,  1452,  1453,  1454,  1456,  1458,  1461,  1466,  1470,  1472,
-    1476,  1481,  1485,  1490,  1495,  1503,  1504,  1506,  1507,  1509,
-    1511,  1515,  1517,  1519,  1521,  1523,  1525,  1527,  1529,  1531,
-    1533,  1535,  1537,  1539,  1541,  1543,  1545,  1547,  1549,  1551,
-    1553,  1555,  1557,  1559,  1561,  1563,  1565,  1568,  1569,  1573,
-    1574,  1576,  1578,  1580,  1582,  1585,  1586,  1588,  1590,  1592,
-    1594,  1596,  1598,  1600,  1602,  1604,  1606,  1608,  1610,  1612,
-    1614,  1616,  1618,  1620,  1622,  1624,  1626,  1628,  1631,  1632,
-    1634,  1636,  1639,  1641,  1645,  1650,  1655,  1661,  1673,  1678,
-    1680,  1683,  1687,  1697,  1703,  1706,  1707,  1710,  1711,  1714,
-    1715,  1717,  1719,  1722,  1724,  1725,  1726,  1727,  1729,  1787,
-    1789,  1790,  1791,  1792,  1793,  1794,  1796,  1798,  1800,  1801,
-    1803,  1806,  1807,  1809,  1812,  1813,  1815,  1816,  1818,  1819,
-    1827,  1836,  1838,  1841,  1861,  1895,  1915,  1966,  1974,  1977,
-    1981,  1991,  2002,  2006,  2016,  2028,  2037,  2038,  2044,  2050,
-    2051,  2101,  2119,  2139,  2158,  2203,  2204,  2205,  2206,  2207,
-    2208,  2209,  2210,  2211,  2212,  2213,  2214,  2215,  2216,  2260,
-    2270,  2279,  2288,  2297,  2298,  2299,  2301,  2302,  2303,  2305,
-    2306,  2307,  2308,  2309,  2311,  2312,  2314,  2315,  2317,  2319,
-    2326,  2327,  2328,  2329,  2330,  2331,  2337,  2343,  2344,  2345,
-    2346,  2347,  2349,  2350,  2360,  2362,  2363,  2365,  2366,  2368,
-    2396,  2397,  2399,  2400,  2402,  2432,  2434,  2435,  2438,  2452,
-    2455,  2456,  2459,  2460,  2461,  2462,  2463,  2464,  2476,  2477,
-    2479,  2480,  2485,  2486,  2488,  2489,  2491,  2492,  2493,  2494,
-    2495,  2497,  2498,  2500,  2501,  2502,  2503,  2504,  2505,  2506,
-    2507,  2508,  2510,  2511,  2513,  2514,  2517,  2518,  2519,  2522,
-    2525,  2526,  2528,  2529,  2530,  2531,  2532,  2533,  2534,  2535,
-    2536,  2537,  2538,  2539,  2540,  2541,  2543,  2544,  2546,  2547,
-    2549,  2550,  2552,  2553,  2554,  2555,  2556,  2558,  2559,  2560,
-    2562,  2563,  2564,  2566,  2568,  2570,  2572,  2574,  2576,  2578,
-    2579,  2581,  2583,  2585,  2587,  2589,  2593,  2596,  2603,  2605,
-    2606,  2608,  2609,  2610,  2612,  2614,  2615,  2617,  2624,  2625,
-    2627,  2628,  2630,  2631,  2639,  2641
+       0,   313,   313,   314,   316,   317,   318,   319,   322,   323,
+     324,   325,   326,   329,   330,   331,   334,   335,   336,   344,
+     347,   350,   351,   354,   355,   358,   366,   375,   392,   411,
+     412,   415,   417,   419,   420,   421,   423,   424,   425,   427,
+     439,   451,   452,   454,   455,   456,   457,   458,   475,   492,
+     493,   498,   499,   536,   549,   550,   551,   552,   553,   554,
+     555,   556,   557,   570,   571,   578,   579,   580,   581,   582,
+     583,   584,   585,   586,   587,   588,   589,   590,   591,   592,
+     593,   594,   595,   596,   597,   598,   599,   600,   601,   604,
+     605,   608,   609,   612,   613,   615,   618,   619,   622,   623,
+     625,   626,   629,   695,   710,   712,   716,   719,   720,   723,
+     729,   734,   748,   749,   752,   753,   754,   755,   758,   760,
+     761,   764,   765,   766,   769,   770,   771,   772,   773,   775,
+     776,   779,   780,   781,   782,   785,   792,   802,   814,   815,
+     818,   819,   822,   823,   824,   825,   828,   834,   842,   852,
+     853,   856,   857,   860,   868,   874,   881,   882,   885,   886,
+     889,   905,   908,   909,   912,   921,   923,   945,   970,   972,
+     973,   974,   975,   977,   978,   979,   980,   983,   984,   985,
+     987,   990,   991,   992,   993,   994,   995,   997,   998,  1001,
+    1002,  1004,  1005,  1006,  1008,  1009,  1012,  1013,  1023,  1024,
+    1025,  1028,  1029,  1031,  1032,  1034,  1035,  1036,  1038,  1039,
+    1042,  1043,  1044,  1045,  1046,  1047,  1049,  1050,  1051,  1052,
+    1053,  1056,  1057,  1058,  1061,  1062,  1064,  1065,  1073,  1079,
+    1086,  1087,  1088,  1089,  1090,  1093,  1094,  1096,  1097,  1098,
+    1099,  1103,  1104,  1105,  1106,  1107,  1108,  1109,  1110,  1111,
+    1112,  1113,  1114,  1115,  1116,  1117,  1118,  1119,  1120,  1121,
+    1122,  1123,  1124,  1125,  1126,  1127,  1128,  1130,  1131,  1133,
+    1134,  1135,  1136,  1137,  1138,  1140,  1141,  1145,  1146,  1147,
+    1148,  1149,  1150,  1151,  1152,  1153,  1154,  1155,  1156,  1157,
+    1158,  1159,  1160,  1161,  1162,  1163,  1164,  1165,  1167,  1168,
+    1169,  1170,  1173,  1174,  1177,  1178,  1179,  1183,  1194,  1195,
+    1196,  1197,  1200,  1209,  1216,  1219,  1220,  1223,  1224,  1227,
+    1228,  1231,  1232,  1233,  1234,  1235,  1236,  1237,  1239,  1285,
+    1286,  1287,  1288,  1289,  1290,  1291,  1293,  1296,  1297,  1298,
+    1299,  1301,  1302,  1305,  1307,  1308,  1311,  1312,  1314,  1315,
+    1321,  1329,  1332,  1352,  1379,  1399,  1439,  1446,  1450,  1457,
+    1467,  1468,  1476,  1486,  1498,  1499,  1504,  1505,  1506,  1507,
+    1508,  1513,  1514,  1515,  1516,  1517,  1518,  1519,  1520,  1521,
+    1522,  1523,  1524,  1525,  1526,  1527,  1528,  1529,  1530,  1567,
+    1576,  1587,  1595,  1617,  1618,  1619,  1657,  1661,  1665,  1668,
+    1669,  1672,  1673,  1676,  1677,  1682,  1686,  1687,  1688,  1692,
+    1696,  1701,  1702,  1707,  1708,  1713,  1714,  1718,  1722,  1723,
+    1724,  1729,  1734,  1739,  1740,  1745,  1746,  1747,  1748,  1753,
+    1754,  1755,  1756,  1761,  1762,  1763,  1764,  1768,  1772,  1776,
+    1777,  1782,  1783,  1787,  1790,  1791,  1792,  1796,  1799,  1800,
+    1801,  1804,  1809,  1810,  1815,  1816,  1821,  1822,  1827,  1828,
+    1832,  1836,  1839,  1840,  1841,  1844,  1849,  1850,  1855,  1856,
+    1861,  1862,  1867,  1868,  1872,  1873,  1878,  1879,  1880,  1881,
+    1885,  1889,  1893,  1897,  1905,  1912,  1919,  1926,  1927,  1930,
+    1933,  1944,  1950,  1951,  1954,  1955,  1957,  1970,  1971,  1973,
+    1974,  1977,  1978,  2000,  2003,  2004,  2007,  2015,  2018,  2019,
+    2022,  2023,  2026,  2027,  2029,  2030,  2032,  2035,  2036,  2037,
+    2038,  2039,  2042,  2043,  2046,  2047,  2048,  2049,  2050,  2051,
+    2052,  2053,  2056,  2059,  2060,  2061,  2063,  2064,  2067,  2068,
+    2069,  2072,  2073,  2076,  2077,  2078,  2079,  2080,  2081,  2082,
+    2083,  2084,  2085,  2086,  2087,  2088,  2089,  2090,  2091,  2092,
+    2094,  2095,  2097,  2098,  2104,  2105,  2106,  2107,  2108,  2110,
+    2111,  2112,  2115,  2116,  2117,  2118,  2119,  2120,  2121,  2122,
+    2123,  2124,  2127,  2128,  2129,  2131,  2132,  2134,  2135,  2138,
+    2139,  2142,  2145,  2146,  2148,  2149,  2152,  2153
 };
 #endif
 
-#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
+#if YYDEBUG || YYERROR_VERBOSE || 0
 /* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
    First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
 static const char *const yytname[] =
 {
-  "$end", "error", "$undefined", "','", "':'", "'='", "TOK_BINARY_OP",
-  "TOK_NEQV", "TOK_EQV", "TOK_XOR", "TOK_OR", "TOK_AND", "TOK_NOT",
-  "TOK_NE", "TOK_EQ", "TOK_GE", "TOK_LE", "TOK_GT", "TOK_LT",
-  "TOK_UNARY_OP", "TOK_DSLASH", "'+'", "'-'", "'*'", "TOK_SLASH",
-  "TOK_DASTER", "TOK_SEP", "TOK_SEMICOLON", "TOK_NEXTLINE",
-  "TOK_PARAMETER", "TOK_RESULT", "TOK_ONLY", "TOK_INCLUDE",
-  "TOK_SUBROUTINE", "TOK_PROGRAM", "TOK_FUNCTION", "TOK_OMP", "TOK_DOLLAR",
-  "TOK_FORMAT", "TOK_MAX", "TOK_TANH", "TOK_WHERE", "TOK_ELSEWHERE",
-  "TOK_ENDWHERE", "TOK_MAXVAL", "TOK_TRIM", "TOK_SUM", "TOK_SQRT",
-  "TOK_CASE", "TOK_SELECTCASE", "TOK_FILE", "TOK_END", "TOK_ERR",
-  "TOK_DONOTTREAT", "TOK_ENDDONOTTREAT", "TOK_EXIST", "TOK_MIN",
-  "TOK_FLOAT", "TOK_EXP", "TOK_COS", "TOK_COSH", "TOK_ACOS", "TOK_NINT",
-  "TOK_CYCLE", "TOK_SIN", "TOK_SINH", "TOK_ASIN", "TOK_EQUIVALENCE",
-  "TOK_BACKSPACE", "TOK_LOG", "TOK_TAN", "TOK_ATAN", "TOK_RECURSIVE",
-  "TOK_ABS", "TOK_MOD", "TOK_SIGN", "TOK_MINLOC", "TOK_MAXLOC", "TOK_EXIT",
-  "TOK_MINVAL", "TOK_PUBLIC", "TOK_PRIVATE", "TOK_ALLOCATABLE",
-  "TOK_RETURN", "TOK_THEN", "TOK_ELSEIF", "TOK_ELSE", "TOK_ENDIF",
-  "TOK_PRINT", "TOK_PLAINGOTO", "TOK_CONSTRUCTID", "TOK_LOGICALIF",
-  "TOK_PLAINDO", "TOK_CONTAINS", "TOK_ENDDO", "TOK_MODULE",
-  "TOK_ENDMODULE", "TOK_DOWHILE", "TOK_ALLOCATE", "TOK_OPEN", "TOK_CLOSE",
-  "TOK_INQUIRE", "TOK_WRITE", "TOK_READ", "TOK_REWIND", "TOK_DEALLOCATE",
-  "TOK_NULLIFY", "TOK_FIN", "TOK_DEBUT", "TOK_DIMENSION", "TOK_ENDSELECT",
-  "TOK_EXTERNAL", "TOK_INTENT", "TOK_INTRINSIC", "TOK_NAMELIST",
-  "TOK_CASEDEFAULT", "TOK_OPTIONAL", "TOK_POINTER", "TOK_CONTINUE",
-  "TOK_SAVE", "TOK_TARGET", "TOK_QUOTE", "TOK_IMPLICIT", "TOK_NONE",
-  "TOK_CALL", "TOK_STAT", "TOK_POINT_TO", "TOK_COMMON", "TOK_GLOBAL",
-  "TOK_INTERFACE", "TOK_ENDINTERFACE", "TOK_LEFTAB", "TOK_RIGHTAB",
-  "TOK_PAUSE", "TOK_PROCEDURE", "TOK_STOP", "TOK_NAMEEQ", "TOK_REAL8",
+  "$end", "error", "$undefined", "','", "':'", "'='", "TOK_NEQV",
+  "TOK_EQV", "TOK_XOR", "TOK_OR", "TOK_AND", "TOK_NOT", "TOK_NE", "TOK_EQ",
+  "TOK_GE", "TOK_LE", "TOK_GT", "TOK_LT", "TOK_DSLASH", "'+'", "'-'",
+  "'*'", "TOK_SLASH", "TOK_DASTER", "TOK_SEMICOLON", "TOK_PARAMETER",
+  "TOK_RESULT", "TOK_ONLY", "TOK_INCLUDE", "TOK_SUBROUTINE", "TOK_PROGRAM",
+  "TOK_FUNCTION", "TOK_FORMAT", "TOK_MAX", "TOK_TANH", "TOK_WHERE",
+  "TOK_ELSEWHEREPAR", "TOK_ELSEWHERE", "TOK_ENDWHERE", "TOK_MAXVAL",
+  "TOK_TRIM", "TOK_NULL_PTR", "TOK_SUM", "TOK_SQRT", "TOK_CASE",
+  "TOK_SELECTCASE", "TOK_FILE", "TOK_UNIT", "TOK_FMT", "TOK_NML",
+  "TOK_END", "TOK_EOR", "TOK_ERR", "TOK_EXIST", "TOK_MIN", "TOK_FLOAT",
+  "TOK_EXP", "TOK_COS", "TOK_COSH", "TOK_ACOS", "TOK_NINT", "TOK_CYCLE",
+  "TOK_SIN", "TOK_SINH", "TOK_ASIN", "TOK_EQUIVALENCE", "TOK_BACKSPACE",
+  "TOK_LOG", "TOK_TAN", "TOK_ATAN", "TOK_RECURSIVE", "TOK_ABS", "TOK_MOD",
+  "TOK_SIGN", "TOK_MINLOC", "TOK_MAXLOC", "TOK_EXIT", "TOK_MINVAL",
+  "TOK_PUBLIC", "TOK_PRIVATE", "TOK_ALLOCATABLE", "TOK_RETURN", "TOK_THEN",
+  "TOK_ELSEIF", "TOK_ELSE", "TOK_ENDIF", "TOK_PRINT", "TOK_PLAINGOTO",
+  "TOK_LOGICALIF", "TOK_PLAINDO", "TOK_CONTAINS", "TOK_ENDDO",
+  "TOK_MODULE", "TOK_ENDMODULE", "TOK_WHILE", "TOK_CONCURRENT",
+  "TOK_ALLOCATE", "TOK_OPEN", "TOK_CLOSE", "TOK_INQUIRE", "TOK_WRITE",
+  "TOK_FLUSH", "TOK_READ", "TOK_REWIND", "TOK_DEALLOCATE", "TOK_NULLIFY",
+  "TOK_DIMENSION", "TOK_ENDSELECT", "TOK_EXTERNAL", "TOK_INTENT",
+  "TOK_INTRINSIC", "TOK_NAMELIST", "TOK_DEFAULT", "TOK_OPTIONAL",
+  "TOK_POINTER", "TOK_CONTINUE", "TOK_SAVE", "TOK_TARGET", "TOK_IMPLICIT",
+  "TOK_NONE", "TOK_CALL", "TOK_STAT", "TOK_POINT_TO", "TOK_COMMON",
+  "TOK_GLOBAL", "TOK_LEFTAB", "TOK_RIGHTAB", "TOK_PAUSE", "TOK_PROCEDURE",
+  "TOK_STOP", "TOK_REAL8", "TOK_FOURDOTS", "TOK_HEXA", "TOK_ASSIGNTYPE",
   "TOK_OUT", "TOK_INOUT", "TOK_IN", "TOK_USE", "TOK_TRUE", "TOK_FALSE",
   "TOK_LABEL", "TOK_TYPE", "TOK_TYPEPAR", "TOK_ENDTYPE", "TOK_REAL",
-  "TOK_INTEGER", "TOK_LOGICAL", "TOK_DOUBLEPRECISION", "TOK_DOUBLEREAL",
-  "TOK_ENDSUBROUTINE", "TOK_ENDFUNCTION", "TOK_ENDPROGRAM", "TOK_ENDUNIT",
-  "TOK_CHARACTER", "TOK_CHAR_CONSTANT", "TOK_CHAR_CUT", "TOK_DATA",
-  "TOK_CHAR_INT", "TOK_CHAR_MESSAGE", "TOK_CSTREAL", "TOK_CSTREALDP",
-  "TOK_CSTREALQP", "TOK_SFREAL", "TOK_COMPLEX", "TOK_DOUBLECOMPLEX",
-  "TOK_NAME", "TOK_NAME_CHAR", "TOK_PROBTYPE", "TOK_INTERPTYPE",
-  "TOK_VARTYPE", "TOK_BC", "TOK_OP", "TOK_CSTINT", "TOK_COMMENT",
-  "TOK_FILENAME", "'('", "')'", "'['", "']'", "'!'", "'_'", "'<'", "'>'",
-  "'\\n'", "'/'", "'%'", "$accept", "input", "line", "suite_line_list",
-  "suite_line", "instr", "fin_line", "keyword", "position", "thislabel",
-  "cmnt", "nulcurbuf", "opt_recursive", "entry", "name_routine",
-  "writedeclar", "before_include", "filename", "arglist", "arglist1",
+  "TOK_INTEGER", "TOK_LOGICAL", "TOK_DOUBLEPRECISION", "TOK_ENDSUBROUTINE",
+  "TOK_ENDFUNCTION", "TOK_ENDPROGRAM", "TOK_ENDUNIT", "TOK_CHARACTER",
+  "TOK_CHAR_CONSTANT", "TOK_CHAR_CUT", "TOK_DATA", "TOK_CHAR_MESSAGE",
+  "TOK_CSTREAL", "TOK_COMPLEX", "TOK_DOUBLECOMPLEX", "TOK_NAME",
+  "TOK_CSTINT", "'('", "')'", "'<'", "'>'", "'\\n'", "'/'", "'%'",
+  "$accept", "input", "line", "line-break", "suite_line_list",
+  "suite_line", "fin_line", "opt_recursive", "opt_result", "entry",
+  "label", "name_routine", "filename", "arglist", "arglist_after_result",
   "args", "arg", "spec", "opt_spec", "name_intrinsic",
   "use_intrinsic_list", "list_couple", "list_expr_equi", "expr_equi",
   "list_expr_equi1", "list_expr", "opt_sep", "after_type",
-  "before_function", "before_parameter", "before_data", "data",
-  "datavallist", "save", "before_save", "varsave", "datanamelist",
-  "expr_data", "opt_signe", "namelist", "namelist_action",
-  "after_namelist", "interface", "before_dimension", "dimension",
-  "private", "public", "use_name_list", "common", "before_common",
-  "var_common_list", "var_common", "comblock", "opt_comma", "paramlist",
-  "paramitem", "module_proc_stmt", "proc_name_list", "implicit",
-  "opt_retour", "dcl", "nodimsgiven", "type", "before_typepar",
-  "c_selector", "c_attribute", "before_character", "typespec", "typename",
-  "lengspec", "proper_lengspec", "selector", "proper_selector",
-  "attribute", "clause", "opt_clause", "options", "attr_spec_list",
-  "attr_spec", "intent_spec", "access_spec", "dims", "dimlist", "dim",
-  "ubound", "expr", "predefinedfunction", "minmaxlist", "uexpr", "signe",
-  "operation", "after_slash", "after_equal", "lhs", "beforefunctionuse",
+  "before_function", "before_parameter", "data_stmt", "data_stmt_set_list",
+  "data_stmt_set", "data_stmt_value_list", "save", "before_save",
+  "varsave", "datanamelist", "expr_data", "opt_signe", "namelist",
+  "before_dimension", "dimension", "private", "public", "use_name_list",
+  "common", "before_common", "var_common_list", "var_common", "comblock",
+  "opt_comma", "paramlist", "paramitem", "module_proc_stmt",
+  "proc_name_list", "implicit", "dcl", "nodimsgiven", "type", "c_selector",
+  "c_attribute", "before_character", "typespec", "lengspec",
+  "proper_lengspec", "selector", "proper_selector", "attribute", "clause",
+  "opt_clause", "options", "attr_spec_list", "attr_spec", "intent_spec",
+  "access_spec", "dims", "dimlist", "dim", "ubound", "expr",
+  "predefinedfunction", "minmaxlist", "uexpr", "signe", "operation",
+  "after_slash", "after_equal", "lhs", "beforefunctionuse",
   "array_ele_substring_func_ref", "begin_array", "structure_component",
   "vec", "funarglist", "funargs", "funarg", "triplet", "ident",
   "simple_const", "string_constant", "opt_substring", "substring",
-  "optexpr", "opt_expr", "initial_value", "before_initial",
-  "complex_const", "use_stat", "word_use", "module_name", "rename_list",
-  "rename_name", "only_list", "only_name", "exec", "word_endsubroutine",
-  "word_endunit", "word_endprogram", "word_endfunction", "caselist",
-  "boucledo", "do_arg", "opt_int", "opt_name", "optname", "worddo",
-  "wordwhile", "iffable", "before_dims", "ident_dims", "int_list",
-  "after_ident_dims", "call", "opt_call", "opt_callarglist", "keywordcall",
-  "before_call", "callarglist", "callarg", "stop", "io", "option_inlist",
-  "option_read", "opt_inlist", "ioctl", "after_rewind", "ctllist",
-  "ioclause", "iofctl", "infmt", "read", "write", "fexpr", "unpar_fexpr",
-  "addop", "inlist", "opt_lhs", "inelt", "opt_operation", "outlist",
-  "out2", "other", "dospec", "label", "goto", "allocation_list",
-  "allocate_object", "array_element", "allocate_object_list",
-  "opt_stat_spec", "pointer_name_list", "logif", "do_var", 0
+  "optexpr", "opt_expr", "initial_value", "complex_const", "use_stat",
+  "word_use", "rename_list", "rename_name", "only_list", "only_name",
+  "execution-part-construct", "executable-construct", "action-stmt",
+  "assignment-stmt", "where-stmt", "where-construct",
+  "opt-where-body-construct", "opt-masked-elsewhere-construct",
+  "opt-elsewhere-construct", "where-construct-stmt",
+  "where-body-construct", "where-assignment-stmt", "mask-expr",
+  "masked-elsewhere-stmt", "elsewhere-stmt", "end-where-stmt",
+  "forall-header", "block", "do-construct", "block-do-construct",
+  "do-stmt", "label-do-stmt", "nonlabel-do-stmt", "loop-control",
+  "do-variable", "do-block", "end-do", "end-do-stmt", "if-construct",
+  "opt-else-if-stmt-block", "else-if-stmt-block", "opt-else-stmt-block",
+  "else-stmt-block", "if-then-stmt", "else-if-stmt", "else-stmt",
+  "end-if-stmt", "if-stmt", "case-construct", "opt_case-stmt-block",
+  "case-stmt-block", "select-case-stmt", "case-stmt", "end-select-stmt",
+  "case-selector", "case-value-range-list", "case-value-range",
+  "case-value", "continue-stmt", "format-stmt", "word_endsubroutine",
+  "word_endunit", "word_endprogram", "word_endfunction", "opt_name",
+  "before_dims", "ident_dims", "int_list", "after_ident_dims", "call",
+  "opt_call", "opt_callarglist", "keywordcall", "before_call",
+  "callarglist", "callarg", "stop", "option_inlist", "option_read",
+  "opt_inlist", "ioctl", "after_rewind", "ctllist", "ioclause",
+  "declare_after_percent", "iofctl", "infmt", "read", "fexpr",
+  "unpar_fexpr", "addop", "inlist", "inelt", "opt_operation", "outlist",
+  "other", "dospec", "goto", "allocation_list", "allocate_object",
+  "allocate_object_list", "opt_stat_spec", "pointer_name_list", YY_NULL
 };
 #endif
@@ -1162,6 +1036,6 @@
 {
        0,   256,   257,    44,    58,    61,   258,   259,   260,   261,
-     262,   263,   264,   265,   266,   267,   268,   269,   270,   271,
-     272,    43,    45,    42,   273,   274,   275,   276,   277,   278,
+     262,   263,   264,   265,   266,   267,   268,   269,   270,    43,
+      45,    42,   271,   272,   273,   274,   275,   276,   277,   278,
      279,   280,   281,   282,   283,   284,   285,   286,   287,   288,
      289,   290,   291,   292,   293,   294,   295,   296,   297,   298,
@@ -1177,7 +1051,5 @@
      389,   390,   391,   392,   393,   394,   395,   396,   397,   398,
      399,   400,   401,   402,   403,   404,   405,   406,   407,   408,
-     409,   410,   411,   412,   413,   414,   415,   416,   417,   418,
-     419,   420,   421,   422,   423,   424,   425,   426,   427,    40,
-      41,    91,    93,    33,    95,    60,    62,    10,    47,    37
+     409,   410,    40,    41,    60,    62,    10,    47,    37
 };
 # endif
@@ -1186,60 +1058,64 @@
 static const yytype_uint16 yyr1[] =
 {
-       0,   190,   191,   191,   192,   192,   192,   192,   192,   193,
-     193,   194,   194,   194,   194,   194,   195,   196,   197,   197,
-     197,   197,   198,   199,   199,   200,   200,   201,   202,   202,
-     203,   203,   203,   203,   203,   203,   204,   205,   206,   207,
-     208,   208,   208,   209,   209,   209,   210,   210,   211,   211,
-     212,   212,   212,   212,   212,   212,   212,   212,   212,   212,
-     212,   212,   212,   212,   212,   212,   212,   212,   212,   212,
-     212,   213,   213,   214,   214,   214,   214,   214,   214,   214,
-     214,   214,   214,   214,   214,   214,   214,   214,   214,   214,
-     214,   214,   214,   214,   214,   214,   214,   215,   215,   216,
+       0,   169,   170,   170,   171,   171,   171,   171,   172,   172,
+     172,   172,   172,   173,   173,   173,   174,   174,   174,   174,
+     175,   176,   176,   177,   177,   178,   178,   178,   178,   179,
+     179,   180,   181,   182,   182,   182,   183,   183,   183,   184,
+     184,   185,   185,   186,   186,   186,   186,   186,   186,   186,
+     186,   186,   186,   186,   186,   186,   186,   186,   186,   186,
+     186,   186,   186,   187,   187,   188,   188,   188,   188,   188,
+     188,   188,   188,   188,   188,   188,   188,   188,   188,   188,
+     188,   188,   188,   188,   188,   188,   188,   188,   188,   189,
+     189,   190,   190,   191,   191,   192,   193,   193,   194,   194,
+     195,   195,   196,   196,   197,   198,   199,   200,   200,   201,
+     201,   201,   202,   202,   203,   203,   203,   203,   204,   205,
+     205,   206,   206,   206,   207,   207,   207,   207,   207,   208,
+     208,   209,   209,   209,   209,   210,   211,   211,   212,   212,
+     213,   213,   214,   214,   214,   214,   215,   215,   215,   216,
      216,   217,   217,   218,   219,   219,   220,   220,   221,   221,
-     222,   222,   223,   224,   225,   226,   226,   226,   227,   227,
-     228,   228,   228,   228,   229,   230,   230,   231,   231,   231,
-     232,   232,   232,   232,   232,   233,   233,   234,   235,   235,
-     235,   235,   236,   237,   237,   238,   239,   239,   240,   240,
-     241,   241,   242,   242,   243,   243,   243,   244,   244,   245,
-     245,   246,   247,   247,   248,   248,   249,   249,   250,   251,
-     252,   252,   253,   253,   254,   255,   255,   256,   257,   257,
-     257,   257,   258,   259,   259,   259,   259,   260,   260,   260,
-     261,   262,   263,   263,   263,   263,   263,   263,   264,   264,
-     265,   265,   266,   266,   266,   267,   267,   268,   268,   268,
-     268,   269,   269,   270,   270,   271,   271,   271,   272,   272,
-     273,   273,   273,   273,   273,   273,   273,   273,   273,   273,
-     273,   274,   274,   274,   275,   275,   276,   276,   277,   277,
-     278,   278,   278,   278,   278,   279,   279,   280,   280,   280,
-     280,   281,   281,   281,   281,   281,   281,   281,   281,   281,
-     281,   281,   281,   281,   281,   281,   281,   281,   281,   281,
-     281,   281,   281,   281,   281,   281,   281,   282,   282,   283,
-     283,   283,   283,   283,   283,   284,   284,   285,   285,   285,
-     285,   285,   285,   285,   285,   285,   285,   285,   285,   285,
-     285,   285,   285,   285,   285,   285,   285,   285,   286,   286,
-     286,   286,   287,   287,   288,   288,   288,   289,   290,   290,
-     290,   290,   291,   292,   293,   294,   294,   295,   295,   296,
-     296,   297,   297,   297,   297,   297,   297,   297,   298,   299,
-     299,   299,   299,   299,   299,   299,   299,   300,   300,   300,
-     300,   301,   301,   302,   303,   303,   304,   304,   305,   305,
-     305,   306,   307,   308,   308,   308,   308,   309,   310,   311,
-     311,   312,   313,   313,   314,   314,   315,   315,   315,   315,
-     315,   315,   315,   315,   315,   315,   315,   315,   315,   315,
-     315,   315,   315,   315,   315,   315,   315,   315,   315,   316,
-     317,   318,   319,   320,   320,   320,   321,   321,   321,   322,
-     322,   322,   323,   323,   324,   324,   325,   325,   326,   327,
-     328,   328,   328,   328,   328,   328,   328,   328,   328,   328,
-     328,   328,   329,   330,   330,   331,   331,   332,   332,   333,
-     334,   334,   335,   335,   336,   337,   338,   338,   339,   339,
-     340,   340,   341,   341,   341,   341,   341,   341,   342,   342,
-     343,   343,   344,   344,   345,   345,   346,   346,   346,   346,
-     346,   347,   347,   348,   348,   348,   348,   348,   348,   348,
-     348,   348,   349,   349,   350,   350,   351,   351,   351,   352,
-     353,   353,   354,   354,   354,   354,   354,   354,   354,   354,
-     354,   354,   354,   354,   354,   354,   355,   355,   356,   356,
-     357,   357,   358,   358,   358,   358,   358,   359,   359,   359,
-     360,   360,   360,   361,   361,   361,   361,   361,   361,   361,
-     361,   362,   362,   362,   362,   362,   363,   363,   364,   365,
-     365,   366,   366,   366,   367,   367,   367,   368,   369,   369,
-     370,   370,   371,   371,   372,   373
+     222,   223,   224,   224,   225,   225,   226,   226,   227,   228,
+     228,   228,   228,   229,   229,   229,   229,   230,   230,   230,
+     231,   232,   232,   232,   232,   232,   232,   233,   233,   234,
+     234,   235,   235,   235,   236,   236,   237,   237,   237,   237,
+     237,   238,   238,   239,   239,   240,   240,   240,   241,   241,
+     242,   242,   242,   242,   242,   242,   242,   242,   242,   242,
+     242,   243,   243,   243,   244,   244,   245,   245,   246,   246,
+     247,   247,   247,   247,   247,   248,   248,   249,   249,   249,
+     249,   250,   250,   250,   250,   250,   250,   250,   250,   250,
+     250,   250,   250,   250,   250,   250,   250,   250,   250,   250,
+     250,   250,   250,   250,   250,   250,   250,   251,   251,   252,
+     252,   252,   252,   252,   252,   253,   253,   254,   254,   254,
+     254,   254,   254,   254,   254,   254,   254,   254,   254,   254,
+     254,   254,   254,   254,   254,   254,   254,   254,   255,   255,
+     255,   255,   256,   256,   257,   257,   257,   258,   259,   259,
+     259,   259,   260,   261,   262,   263,   263,   264,   264,   265,
+     265,   266,   266,   266,   266,   266,   266,   266,   267,   268,
+     268,   268,   268,   268,   268,   268,   268,   269,   269,   269,
+     269,   270,   270,   271,   272,   272,   273,   273,   274,   274,
+     274,   275,   276,   276,   276,   276,   277,   278,   278,   279,
+     280,   280,   281,   281,   282,   282,   283,   283,   283,   283,
+     283,   284,   284,   284,   284,   284,   284,   284,   284,   284,
+     284,   284,   284,   284,   284,   284,   284,   284,   284,   284,
+     284,   284,   284,   284,   284,   284,   285,   286,   287,   288,
+     288,   289,   289,   290,   290,   291,   292,   292,   292,   293,
+     294,   295,   295,   296,   296,   297,   297,   298,   299,   299,
+     299,   300,   301,   302,   302,   303,   303,   303,   303,   304,
+     304,   304,   304,   305,   305,   305,   305,   306,   307,   308,
+     308,   309,   309,   310,   311,   311,   311,   312,   313,   313,
+     313,   314,   315,   315,   316,   316,   317,   317,   318,   318,
+     319,   320,   321,   321,   321,   322,   323,   323,   324,   324,
+     325,   325,   326,   326,   327,   327,   328,   328,   328,   328,
+     329,   330,   331,   332,   333,   334,   335,   336,   336,   337,
+     338,   338,   339,   339,   340,   340,   341,   342,   342,   343,
+     343,   344,   344,   345,   346,   346,   347,   347,   348,   348,
+     349,   349,   350,   350,   351,   351,   352,   353,   353,   353,
+     353,   353,   354,   354,   355,   355,   355,   355,   355,   355,
+     355,   355,   356,   357,   357,   357,   358,   358,   359,   359,
+     359,   360,   360,   361,   361,   361,   361,   361,   361,   361,
+     361,   361,   361,   361,   361,   361,   361,   361,   361,   361,
+     362,   362,   363,   363,   364,   364,   364,   364,   364,   365,
+     365,   365,   366,   366,   366,   366,   366,   366,   366,   366,
+     366,   366,   367,   367,   367,   368,   368,   369,   369,   370,
+     370,   371,   372,   372,   373,   373,   374,   374
 };
 
@@ -1247,166 +1123,177 @@
 static const yytype_uint8 yyr2[] =
 {
-       0,     2,     0,     2,     2,     2,     1,     3,     3,     1,
-       3,     2,     2,     3,     3,     2,     2,     2,     1,     1,
-       1,     1,     0,     0,     2,     0,     1,     0,     0,     1,
-       0,     4,     2,     6,     4,     2,     1,     0,     1,     1,
-       0,     2,     3,     0,     2,     3,     1,     3,     1,     1,
-       2,     4,     2,     2,     4,     2,     1,     1,     1,     1,
-       1,     1,     1,     1,     1,     1,     4,     3,     3,     2,
-       3,     0,     1,     1,     1,     1,     1,     1,     1,     1,
+       0,     2,     0,     2,     1,     1,     2,     1,     2,     1,
+       3,     2,     2,     1,     3,     3,     2,     2,     3,     1,
+       0,     0,     1,     0,     2,     4,     2,     5,     2,     1,
+       2,     1,     1,     0,     2,     3,     0,     2,     3,     1,
+       3,     1,     1,     2,     4,     2,     2,     4,     2,     1,
+       1,     1,     1,     1,     1,     1,     1,     1,     4,     3,
+       3,     2,     2,     0,     1,     1,     1,     1,     1,     1,
        1,     1,     1,     1,     1,     1,     1,     1,     1,     1,
-       1,     1,     1,     1,     1,     1,     1,     1,     3,     3,
-       5,     1,     3,     3,     2,     4,     1,     3,     0,     2,
-       2,     3,     1,     1,     1,     4,     6,     4,     1,     3,
-       2,     3,     5,     3,     1,     0,     2,     1,     4,     3,
-       2,     3,     3,     3,     3,     0,     1,     2,     2,     3,
-       5,     3,     0,     2,     2,     1,     5,     5,     2,     3,
-       2,     3,     1,     3,     2,     3,     5,     1,     2,     1,
-       3,     2,     1,     3,     0,     1,     1,     3,     3,     2,
-       1,     3,     2,     2,     0,     6,     7,     0,     2,     2,
-       3,     3,     1,     0,     2,     4,     3,     3,     4,     2,
-       1,     1,     1,     1,     1,     1,     1,     1,     0,     2,
-       1,     3,     0,     2,     3,     1,     3,     2,     3,     1,
-       1,     1,     1,     0,     3,     0,     2,     4,     1,     3,
+       1,     1,     1,     1,     1,     1,     1,     1,     1,     1,
+       3,     3,     5,     1,     3,     3,     2,     4,     1,     3,
+       0,     1,     2,     3,     1,     1,     2,     1,     3,     4,
+       4,     8,     1,     3,     2,     3,     5,     3,     1,     0,
+       2,     1,     4,     3,     2,     3,     3,     3,     3,     0,
+       1,     2,     3,     5,     3,     1,     5,     5,     2,     3,
+       2,     3,     1,     1,     3,     3,     2,     3,     5,     1,
+       2,     1,     3,     2,     1,     3,     0,     1,     1,     3,
+       3,     2,     1,     3,     2,     2,     5,     6,     0,     2,
+       2,     3,     3,     0,     2,     4,     3,     3,     4,     2,
+       1,     1,     1,     1,     1,     1,     1,     0,     2,     1,
+       3,     0,     2,     3,     1,     3,     2,     3,     1,     1,
+       1,     1,     1,     0,     3,     0,     1,     3,     1,     3,
        1,     1,     1,     2,     1,     4,     1,     1,     1,     1,
        1,     1,     1,     1,     1,     1,     0,     3,     1,     3,
-       1,     1,     2,     2,     3,     1,     1,     1,     3,     1,
-       1,     3,     3,     4,     4,     3,     4,     4,     3,     4,
+       1,     1,     2,     2,     3,     1,     1,     1,     1,     1,
+       3,     3,     3,     4,     4,     3,     4,     4,     3,     4,
        4,     4,     4,     4,     4,     4,     4,     4,     4,     4,
-       4,     4,     3,     4,     4,     4,     4,     1,     3,     1,
+       4,     4,     3,     4,     3,     4,     4,     1,     3,     1,
        1,     1,     2,     2,     2,     1,     1,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     3,     2,
-       3,     2,     2,     2,     2,     2,     2,     2,     0,     1,
+       2,     2,     2,     2,     2,     2,     3,     3,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     0,     1,
        2,     2,     2,     1,     1,     1,     1,     0,     1,     2,
-       4,     5,     4,     3,     3,     1,     2,     1,     3,     1,
+       4,     5,     4,     4,     3,     1,     2,     1,     3,     1,
        1,     3,     5,     4,     3,     2,     2,     1,     1,     1,
        1,     1,     1,     1,     1,     2,     2,     1,     2,     1,
-       1,     0,     1,     5,     0,     1,     1,     1,     0,     3,
-       3,     0,     5,     2,     4,     6,     6,     1,     1,     1,
-       3,     3,     1,     3,     3,     1,     1,     5,     5,     4,
-       1,     2,     2,     2,     2,     1,     2,     5,     1,     1,
-       2,     5,     1,     2,     3,     4,     1,     1,     1,     1,
-       1,     1,     1,     1,     3,     3,     3,     2,     2,     0,
-       5,     7,     0,     2,     1,     1,     0,     1,     1,     1,
-       1,     2,     1,     1,     1,     5,     5,     2,     2,     2,
-       2,     1,     0,     4,     6,     1,     3,     2,     2,     2,
-       0,     3,     0,     1,     2,     1,     1,     3,     1,     2,
-       1,     1,     2,     2,     2,     3,     2,     1,     0,     1,
-       2,     2,     0,     2,     3,     3,     3,     3,     1,     3,
-       1,     1,     3,     1,     1,     1,     3,     2,     4,     4,
-       2,     2,     1,     1,     1,     1,     1,     1,     1,     1,
-       1,     3,     1,     1,     3,     3,     3,     3,     2,     3,
-       2,     2,     2,     2,     3,     1,     1,     1,     1,     3,
-       0,     1,     2,     4,     2,     2,     5,     0,     1,     2,
-       1,     1,     1,     3,     3,     3,     3,     3,     3,     1,
-       1,     1,     3,     5,     5,     5,     5,     7,     1,     8,
-       2,     1,     1,     3,     1,     1,     1,     4,     1,     3,
-       0,     4,     1,     3,     3,     1
+       1,     0,     1,     5,     0,     1,     1,     1,     0,     2,
+       2,     5,     2,     4,     6,     6,     1,     1,     3,     3,
+       1,     3,     3,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     2,     1,     1,     2,     2,     2,     3,     2,
+       5,     5,     2,     2,     2,     2,     1,     4,     1,     2,
+       2,     2,     2,     1,     1,     1,     1,     5,     6,     0,
+       3,     0,     4,     0,     4,     4,     1,     1,     1,     1,
+       1,     3,     4,     1,     2,     1,     2,     0,     0,     2,
+       3,     1,     4,     1,     1,     4,     2,     5,     3,     3,
+       1,     4,     2,     6,     8,     5,     3,     1,     1,     1,
+       1,     1,     2,     6,     0,     1,     2,     3,     0,     1,
+       2,     3,     7,     5,     5,     6,     1,     2,     1,     2,
+       5,     4,     0,     1,     2,     3,     6,     4,     2,     3,
+       1,     2,     3,     1,     1,     3,     1,     2,     2,     3,
+       1,     1,     1,     1,     1,     1,     1,     1,     1,     0,
+       4,     7,     1,     3,     2,     2,     2,     0,     3,     0,
+       1,     2,     2,     1,     1,     3,     1,     2,     1,     1,
+       0,     1,     2,     2,     0,     2,     3,     3,     3,     1,
+       3,     1,     1,     3,     1,     1,     1,     3,     5,     4,
+       2,     2,     0,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     3,     1,     1,     3,     3,     3,     3,     2,
+       3,     2,     2,     2,     2,     2,     2,     2,     3,     1,
+       1,     1,     1,     3,     2,     4,     2,     2,     5,     0,
+       1,     2,     1,     1,     1,     1,     3,     3,     3,     3,
+       3,     3,     5,     5,     5,     5,     7,     8,     2,     1,
+       3,     1,     1,     3,     0,     4,     1,     3
 };
 
-/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
-   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
+/* YYDEFACT[STATE-NAME] -- Default reduction number in state STATE-NUM.
+   Performed when YYTABLE doesn't specify something else to do.  Zero
    means the default is an error.  */
 static const yytype_uint16 yydefact[] =
 {
-       2,     0,     1,    37,    20,    21,    18,    19,    27,     6,
-      22,     3,    25,    30,    27,    24,     4,    26,    37,   113,
-      38,     0,   457,     0,   388,   389,     0,     0,     0,     0,
-       0,    29,   354,   108,   108,     0,     0,   392,     0,   488,
-       0,     0,   418,   398,   416,     0,     0,   419,     0,   482,
-     483,   487,   489,   486,     0,     0,     0,   145,   397,   108,
-     108,     0,   396,     0,   420,   124,     0,   445,   157,     0,
-       0,     0,   450,     0,   451,   367,    71,   182,     0,   193,
-     192,   197,   195,   399,   402,   401,   400,   190,   114,   194,
-     196,   338,   435,     5,     9,    22,     0,    22,     0,    22,
-       0,     0,    57,   125,    65,   142,    64,   164,    59,    61,
-      60,    56,     0,    63,    58,   215,     0,   183,   202,   191,
-     432,    62,     0,    25,     0,   380,     0,     0,   385,   412,
-       0,   376,     0,   431,   424,   440,     0,     0,   423,     0,
-       0,     0,   422,     0,     8,     7,    36,    32,     0,     0,
-     285,   286,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   339,   340,
-       0,   347,   350,   349,   342,   343,   344,   341,     0,   403,
-     250,   247,     0,   279,   316,   318,   315,   281,   314,   280,
-     351,   249,     0,     0,   356,   357,   429,     0,    69,   101,
-       0,   355,   427,     0,   150,     0,   148,     0,   428,     0,
-     415,   414,   393,   538,     0,   540,     0,   417,   408,    35,
-     384,     0,   470,   468,     0,   456,     0,     0,     0,     0,
-     162,     0,     0,   138,     0,    53,   172,   173,   158,   143,
-     144,   170,   169,   234,   235,   108,    72,    52,    30,    15,
-      25,     0,     0,    11,    39,    22,    12,     0,     0,    55,
-     166,   127,   164,     0,   125,     0,   236,   120,   125,   165,
-     137,     0,   165,     0,     0,     0,   236,   154,   159,     0,
-       0,     0,   112,    50,     0,   177,   174,   209,   210,     0,
-       0,     0,   179,     0,     0,   178,     0,    16,   236,   368,
-     363,    37,   382,   381,   383,   164,   409,   407,     0,     0,
-       0,   421,     0,   442,   439,   444,   430,     0,   452,   506,
-     507,   485,     0,     0,     0,     0,   338,     0,   505,   492,
-     493,   453,   458,   462,     0,   484,     0,   454,   390,     0,
-       0,   432,   386,     0,   284,   277,     0,     0,     0,     0,
+       2,     0,     1,     7,     9,   105,     0,     0,   482,     0,
+       0,     0,     0,     0,    22,   344,   100,   100,     0,   540,
+       0,     0,   156,   395,     0,     0,     0,   533,   534,   539,
+       0,   535,   538,     0,     0,     0,   135,   100,   100,     0,
+       0,   371,   118,     0,   503,   149,     0,   508,     0,   509,
+     356,    21,    63,     0,     0,   183,   181,   182,   186,   483,
+     486,   485,   484,   180,     0,   184,   185,   328,   492,    20,
+       3,     4,     5,    13,     0,    20,    20,     0,     0,    50,
+     119,    57,   156,    52,    54,    53,    49,     0,    56,    51,
+     205,   173,   191,   489,    55,     0,    19,   364,   366,   394,
+     370,     0,   367,   421,     0,   423,   424,   369,     0,   393,
+     368,     0,   365,     0,   388,     0,     0,     0,   386,   374,
+     497,     0,     0,     0,     0,   373,    32,    20,    31,    26,
+       0,     0,     0,   275,   276,     0,     0,     0,     0,   331,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,   530,   520,   249,     0,   522,   521,     0,
-       0,   247,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   308,     0,     0,
-       0,   282,   283,     0,   354,   319,   317,   317,   345,   348,
-     346,   352,     0,     0,   394,     0,     0,   236,     0,     0,
-     109,   152,   151,   149,     0,     0,   554,     0,   545,   432,
-     542,   550,   541,   546,   341,   247,   314,   544,   548,   550,
-     552,     0,    67,    74,    75,    78,    73,    79,    76,    81,
-      82,    83,    84,    85,    80,    86,    87,    88,    89,    90,
-      91,    92,    93,    94,    95,    77,    96,    97,    68,     0,
-     139,     0,   106,     0,     0,     0,    10,    17,    40,    40,
-      13,     0,     0,     0,   135,     0,    70,     0,     0,   135,
-     123,   164,     0,   126,   121,   141,   164,   236,   236,   164,
-     161,     0,   155,   220,   222,   236,   224,     0,   226,   227,
-     228,   229,   230,     0,   218,   221,   216,    40,   174,   110,
-       0,     0,   212,   207,   211,   181,   184,     0,   338,     0,
-     213,     0,   203,   205,     0,   180,   236,     0,    14,   413,
-     555,   406,     0,   437,   438,   432,   436,     0,   448,     0,
-     443,   446,   474,   475,     0,   314,     0,   471,   473,   490,
-     500,   503,   502,   501,     0,   473,   510,   517,   511,   517,
-     460,   459,   517,   508,   510,   461,     0,     0,     0,     0,
-       0,   498,   455,     0,     0,     0,     0,   252,     0,     0,
-       0,   251,   258,   255,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   272,     0,     0,     0,
-       0,     0,     0,   247,     0,     0,     0,   324,     0,     0,
-       0,   248,     0,     0,   313,   307,   302,   292,   303,   304,
-     305,   301,   291,   297,   299,   293,   295,   287,   288,   289,
-       0,     0,   309,   306,   290,     0,   296,     0,   294,   323,
-       0,   325,     0,     0,   404,   405,   395,     0,   103,   104,
-     102,    66,     0,     0,     0,   317,     0,     0,   467,   469,
-     466,     0,     0,     0,   379,     0,   163,     0,    99,     0,
-     171,    51,     0,    31,    34,   168,    54,   167,     0,   118,
-       0,   136,     0,     0,   127,   129,     0,   125,   241,   245,
-       0,   238,   240,   246,     0,   198,   198,     0,   160,   223,
-       0,     0,     0,   111,     0,   236,   208,     0,     0,   213,
-     186,     0,   189,     0,   204,   433,     0,     0,   364,   369,
-       0,   236,   449,   441,     0,     0,   480,   481,   317,   236,
-       0,   464,   465,   504,   465,     0,   518,   514,   515,   510,
-     512,   463,   499,   495,   496,   497,   494,   550,   550,   387,
-     278,   253,   254,   257,   261,   262,   263,   264,   265,   260,
-     266,   267,   268,   269,   270,   271,   273,   274,   275,   276,
-     256,   248,     0,     0,     0,   523,   524,   527,   528,   525,
-     526,   259,   247,   312,   310,   311,   300,   298,   354,   337,
-     329,   326,   327,   330,   320,   322,   236,   153,   391,     0,
-       0,     0,   543,   377,   549,   378,   553,    98,   107,     0,
-      49,    48,    41,     0,    46,    43,   115,   135,   135,   135,
-     135,   135,   130,   128,   135,   117,   122,   243,     0,   237,
-     242,   140,     0,   146,   147,   156,   232,   233,   231,     0,
-     219,   217,   236,   198,   185,   213,   187,     0,   206,     0,
-       0,     0,     0,   236,   447,   491,     0,     0,     0,   476,
-     472,   473,   510,   517,   519,   509,     0,     0,   338,     0,
-       0,     0,   362,     0,     0,   335,   336,     0,   321,   105,
-       0,   547,     0,   100,     0,    42,     0,    33,   119,   131,
-     132,   133,   134,     0,   239,   244,   246,     0,   199,   200,
-     225,   198,   358,   188,   214,   375,   365,   366,   372,   371,
-     370,     0,   434,   479,   478,     0,   513,   425,   426,     0,
-     533,   535,   534,   353,   334,     0,   331,   328,     0,   551,
-      47,    44,     0,   116,     0,   358,   175,     0,     0,     0,
-     410,   516,     0,   333,     0,   539,    45,   201,   176,     0,
-       0,   374,   373,     0,     0,   332,   359,   360,   411,   536,
-       0,   537
+       0,     0,   334,   329,   330,     0,   337,   340,   339,   333,
+     328,   332,     0,   346,   347,   239,   237,     0,   269,   306,
+     308,   305,   271,   304,   270,   341,   384,   238,     0,    61,
+      93,     0,   345,   382,   101,   140,     0,   138,     0,   383,
+     588,     0,     0,   157,    29,   156,     0,   432,    28,   488,
+     487,   392,     0,     0,   377,   521,   519,     0,   379,     0,
+       0,     0,     0,   154,     0,     0,   131,     0,    46,   164,
+     165,   150,   162,   161,     6,   224,   225,   100,    64,   200,
+     198,   199,     0,    45,   121,     0,   156,   107,     0,     0,
+       8,    11,    12,    20,    21,     0,     0,    16,    17,     0,
+       0,    48,   158,    62,   119,     0,   226,   114,   119,   157,
+       0,     0,     0,     0,   226,   146,   151,     0,     0,   104,
+     206,    43,     0,   168,     0,     0,     0,   170,     0,     0,
+     169,   226,   352,   399,   418,   418,   462,   390,   389,   391,
+       0,     0,   532,   372,     0,   499,   496,   501,   502,   385,
+     375,   560,   561,   537,     0,     0,     0,     0,     0,     0,
+       0,   328,     0,   559,   543,   544,   376,   510,   514,     0,
+     536,     0,    18,   410,     0,     0,   274,   267,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   573,   574,   572,     0,   575,
+       0,     0,   237,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   298,     0,
+       0,     0,   272,   273,   532,   344,   309,   307,   307,   335,
+     338,   336,   342,     0,   226,     0,     0,   143,   142,   141,
+     139,     0,     0,    30,   428,     0,   417,   437,     0,   591,
+     594,   589,   525,   526,     0,   304,     0,   522,   524,   541,
+     378,   332,   237,   304,   592,   594,   596,     0,    59,    66,
+      67,    70,    65,    71,    68,    73,    74,    75,    76,    77,
+      72,    78,    79,    80,    81,    82,    83,    84,    85,    86,
+      87,    69,    88,    89,    60,     0,   132,     0,    98,     0,
+       0,     0,     0,   202,   196,   201,   172,   129,     0,     0,
+       0,     0,   129,     0,     0,   156,    10,    14,    15,    33,
+      33,     0,     0,     0,   117,   156,     0,   120,   115,   134,
+     156,   226,   226,   156,   153,     0,   147,   210,   212,   226,
+     214,     0,   216,   217,   218,   219,   220,     0,   208,   211,
+      33,     0,   102,   226,   174,     0,   328,     0,   203,   332,
+       0,   192,   194,     0,   226,     0,   401,   438,     0,   444,
+       0,     0,   463,     0,   494,   495,     0,   493,     0,   506,
+       0,   500,   504,   551,   552,   554,   553,   557,   556,   555,
+       0,   524,     0,   569,   569,   569,   512,   511,   562,     0,
+     513,     0,     0,     0,     0,     0,   549,   405,   467,     0,
+     242,     0,     0,     0,   241,   248,   245,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   262,
+       0,   264,     0,     0,     0,   237,     0,     0,     0,     0,
+     314,     0,     0,   240,     0,     0,   303,   297,   292,   282,
+     293,   294,   295,   291,   281,   289,   290,   283,   288,   277,
+     278,   279,     0,     0,   299,   296,   280,     0,   285,     0,
+     284,     0,     0,   315,     0,     0,     0,    95,    96,    94,
+      58,     0,     0,     0,     0,   436,     0,     0,     0,     0,
+     530,   531,   307,   226,     0,   516,   518,   520,   517,     0,
+       0,     0,   387,     0,   155,     0,    91,     0,   163,    44,
+     197,     0,   112,     0,   130,     0,     0,   108,   121,   123,
+       0,     0,     0,   156,   431,     0,    25,    23,   160,    47,
+     159,   119,   231,   235,     0,   228,   230,   236,     0,   187,
+     187,     0,   152,   213,     0,     0,   207,   103,   226,   187,
+       0,     0,   203,   176,     0,   179,     0,   193,   490,     0,
+       0,   353,   357,   396,   409,   407,   408,   403,     0,   406,
+     419,   441,   481,   422,   439,   440,     0,   448,   445,     0,
+     473,     0,   468,   470,   464,   461,   418,   489,   507,   498,
+       0,   558,   542,     0,   570,   566,   564,   567,     0,   515,
+     550,   546,   547,   548,   545,   397,   268,   243,   244,   247,
+     251,   252,   253,   254,   255,   250,   256,   257,   258,   259,
+     260,   261,   263,   265,   266,   246,     0,     0,     0,   576,
+     577,   580,   581,   578,   579,   249,   237,   302,   300,   301,
+     287,   286,   313,   344,   327,   319,   316,   317,   320,   310,
+     312,   226,   145,   144,     0,     0,   453,     0,   460,     0,
+       0,     0,   590,   380,     0,     0,   532,   527,   523,   593,
+     381,   597,    90,    99,     0,   109,   129,   129,   129,   129,
+     129,   124,   122,     0,     0,   110,     0,     0,   427,    42,
+      41,    34,     0,    39,    36,    27,   116,   233,     0,   227,
+     232,   133,     0,   136,   137,   148,   222,   223,   221,     0,
+     209,   187,   348,   175,   203,   177,     0,   195,     0,     0,
+       0,     0,     0,     0,   400,   420,   442,     0,   456,   446,
+       0,   449,     0,   418,     0,   480,     0,   474,   476,   469,
+     471,   465,   226,   505,     0,   569,   571,   563,   328,     0,
+       0,     0,   351,     0,     0,   325,   326,     0,   311,    97,
+       0,     0,     0,   435,     0,     0,   529,     0,    92,   113,
+     125,   126,   127,   128,     0,     0,   466,     0,     0,    35,
+       0,    24,   229,   234,   236,     0,   188,   189,   215,   348,
+       0,     0,   166,   178,   204,   363,   354,   355,   360,   359,
+     358,     0,   413,   415,     0,   398,   399,     0,   457,   458,
+     450,   443,   418,   447,   478,     0,   472,   477,   226,     0,
+     565,   582,   583,   584,   343,   324,     0,   321,   318,     0,
+       0,     0,   433,   595,   528,     0,   129,   452,    40,    37,
+       0,     0,   167,   349,   350,     0,     0,   411,   414,   416,
+     399,   402,     0,   459,   451,   475,   479,   491,   568,   323,
+       0,   587,     0,     0,     0,     0,     0,    38,   190,   362,
+     361,   412,   404,   454,   322,   434,   585,   111,   455,     0,
+     586
 };
 
@@ -1414,129 +1301,138 @@
 static const yytype_int16 yydefgoto[] =
 {
-      -1,     1,    11,    93,    94,    95,   259,    12,   260,    13,
-      18,    15,    96,    97,   147,    14,    98,   265,   693,   907,
-     833,   834,    99,   255,   477,   478,   245,   208,   209,   426,
-     481,   215,   293,   294,   100,   101,   272,   698,   102,   103,
-     277,   273,   699,   700,   104,   105,   280,   106,   107,   108,
-     109,   110,   432,   111,   112,   287,   288,   242,   275,   269,
-     270,   113,   252,   114,   530,   295,   529,   115,   116,   302,
-     539,   117,   118,   119,   853,   918,   305,   542,   299,   540,
-     732,   296,   523,   524,   859,   525,   503,   710,   711,   712,
-     355,   190,   356,   191,   192,   411,   653,   635,   193,   661,
-     194,   195,   196,   197,   663,   811,   812,   813,   198,   199,
-     200,   420,   415,   212,   206,   956,   957,   201,   121,   122,
-     310,   738,   739,   927,   928,   123,   124,   125,   126,   127,
-     202,   128,   551,   316,   222,   228,   129,   130,   131,   308,
-     132,   133,   321,   134,   324,   559,   135,   136,   560,   561,
-     137,   138,   580,   341,   585,   328,   235,   566,   567,   139,
-     343,   140,   141,   344,   569,   346,   581,   582,   583,   757,
-     386,   387,   388,   889,   225,   142,   441,   442,   443,   449,
-     677,   451,   143,   552
+      -1,     1,    70,    71,    72,    73,   250,    74,   865,    75,
+     205,   129,   127,   696,   951,   862,   863,    76,   237,   463,
+     464,   228,   189,   190,   403,   467,   196,   281,   282,    77,
+      78,   246,   247,   681,    79,    80,   267,   248,   682,   683,
+      81,    82,    83,    84,    85,   409,    86,    87,   275,   276,
+     225,   206,   261,   262,    88,   233,    89,   283,   522,    90,
+     287,   527,    91,    92,   873,   956,   290,   531,   242,   528,
+     725,   284,   517,   518,   879,   519,   497,   704,   705,   706,
+     337,   175,   338,   176,   177,   392,   635,   617,   178,   643,
+     179,   180,   181,   182,   645,   816,   817,   818,   183,   184,
+     185,   401,   396,   193,   186,   962,   187,    94,    95,   731,
+     732,   967,   968,   740,    97,    98,   734,    99,   100,   536,
+     737,   892,   101,   738,   739,   334,   893,   974,   975,   655,
+     537,   102,   103,   104,   105,   106,   207,   418,   538,   743,
+     744,   107,   747,   748,   900,   901,   108,   749,   902,   981,
+     109,   110,   541,   542,   111,   543,   755,   752,   906,   907,
+     908,   745,   112,   113,   114,   115,   116,   211,   291,   117,
+     118,   303,   119,   306,   550,   120,   121,   551,   552,   122,
+     566,   326,   570,   214,   218,   426,   427,   546,   123,   328,
+     124,   428,   429,   331,   567,   568,   765,   368,   369,   854,
+     125,   420,   421,   435,   658,   437
 };
 
 /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
    STATE-NUM.  */
-#define YYPACT_NINF -711
+#define YYPACT_NINF -845
 static const yytype_int16 yypact[] =
 {
-    -711,   923,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,   -98,  5724,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,   -51,  -711,   -47,  -711,  -711,  4731,    54,  2666,    70,
-     115,  -711,  4731,    34,    40,  2666,   117,  -711,   -63,  -711,
-       7,  4731,  -711,  -711,   -39,    66,   -63,  -711,   137,  -711,
-    -711,  -711,  -711,  -711,   184,   141,   170,  -711,  -711,   199,
-     199,   155,  -711,   175,  -711,  -711,    37,  -711,  -711,    92,
-     -63,   -63,  -711,   129,  -711,  -711,   116,  -711,   -63,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,   217,  -711,  -711,    31,  -711,    96,  -711,
-     -64,   187,    97,   156,  -711,   149,  -711,   384,   390,  -711,
-    -711,   395,   165,  -711,  -711,    91,   -15,    80,   125,   372,
-     416,  -711,   253,   -98,   -63,  -711,   -63,   -63,  -711,   247,
-    4731,  -711,    24,   434,  -711,   267,   278,  2666,  -711,   270,
-    5575,   270,  -711,  2341,  -711,  -711,  -711,  -711,  4731,  4731,
-    -711,  -711,  4731,   276,   279,   280,  4731,  4731,  4731,   285,
-     291,   292,   296,   299,   301,   309,   310,   313,   316,   317,
-     318,  4731,   319,   325,   328,   329,   330,  4859,  -711,  -711,
-     331,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  4731,  2530,
-    -711,  -711,  4731,   304,  -711,   334,   342,  -711,   343,   354,
-     -33,  -711,    43,  4731,  -711,  2530,  -711,   356,   528,  -711,
-    4731,  2530,  -711,   534,  -711,   376,  -711,   376,  -711,  4731,
-    -711,  -711,  -711,  -711,  4731,  -711,  1494,  -711,  -711,  -711,
-    -711,   356,  -711,  -711,  4987,  -711,   356,   356,   376,  2588,
-    -711,   377,   356,  -711,  4731,   544,  -711,  -711,  -711,  -711,
-    -711,  -711,   546,  -711,  -711,   199,  -711,  -711,  5724,  -711,
-     -98,   -51,   -51,  -711,  -711,  -711,  -711,   557,   394,   561,
-    -711,    21,    33,   144,   397,   139,   388,  -711,   397,   356,
-    -711,   139,  -711,   399,   402,   139,   388,   571,  -711,   407,
-     733,   575,  -711,  -711,   -51,   572,  -711,  3067,  -711,   401,
-     215,  3963,  -711,  5115,   -15,  -711,   425,  -711,   388,  -711,
-     601,  -711,  -711,  -711,  -711,   384,   356,  2530,  4731,  4731,
-     356,  -711,   429,  4091,  -711,  -711,  -711,  5430,  -711,  -711,
-    -711,  -711,  4731,  4731,  4731,  4731,   610,  5430,  -711,   304,
-     354,  -711,  1098,   616,   588,   618,  5621,  4859,  -711,   441,
-     443,  -711,  -711,  1515,   670,  2530,    27,  4731,  4731,  4731,
-      36,  1550,    45,  4731,  4731,  4731,  4731,  4731,  4731,  4731,
-    4731,  4731,  4731,  4731,  4731,  1572,  4731,  4731,  4731,  4731,
-    4731,  4859,  2530,  1594,   782,  -711,   500,   630,   631,  4731,
-    1615,   633,  3451,  4731,  4731,  4731,  4731,  4731,  4731,  4731,
-    4731,  4731,  4731,  4731,  4731,  4731,  4731,  3195,  4731,  3579,
-    3707,  -711,   128,   356,  4731,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  4731,  4731,  -711,  1637,    48,   388,    70,  1697,
-    -711,  -711,   641,   641,  1819,  1173,  -711,   304,   -24,    -1,
-     457,   647,  -711,  -711,   471,   472,   151,    -1,  -711,   650,
-    -711,    62,   641,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,   651,   634,
-    -711,    71,  2530,   476,   488,   -63,  -711,  -711,   480,   480,
-    -711,  4731,    72,   394,   314,  4731,  -711,   491,   495,   314,
-    -711,   384,  2538,  -711,  -711,  -711,   384,   388,   388,   384,
-    -711,   407,   571,  -711,  -711,   388,  -711,   486,  -711,  -711,
-    -711,  -711,  -711,   358,  -711,  -711,  -711,   480,  -711,  -711,
-     497,  4219,  -711,  -711,  2530,  -711,  -711,  3963,  3323,   487,
-     665,  4347,  -711,  2530,   489,  -711,   388,    23,  -711,  -711,
-    -711,  -711,   667,  2530,  2530,  -711,  -711,   498,  2530,   493,
-     672,  -711,  -711,  -711,  5621,  3835,    75,  -711,   119,  -711,
-    2530,  2530,  2530,  2530,  4731,   530,  5850,  2530,   304,  1840,
-    -711,   674,  2530,  -711,  5850,  -711,  5621,  5621,  5621,  5621,
-    5621,   654,  -711,   356,   356,  2666,  4731,  -711,    84,    85,
-    1879,  -711,  -711,  -711,  1900,  1921,  1942,  1963,  2006,  2027,
-    2145,  2209,  2230,  2251,  2272,  2293,  -711,    86,    88,    89,
-      90,    98,  2327,   678,   687,   693,  4859,  -711,  4859,  4859,
-      99,  -711,  4731,  4731,  2530,  -711,   710,   710,   569,   569,
-     670,   814,   814,   814,   814,   814,   814,   133,   133,   128,
-    4731,  4731,  2530,  -711,   128,  4731,   814,  4731,   814,   304,
-     695,  2811,   517,   520,  2530,  2530,  -711,   356,  -711,  -711,
-    -711,  -711,   532,   619,  4731,  2811,   -49,   526,  -711,  -711,
-    -711,   -49,   527,   356,  -711,  2588,  -711,  4731,  -711,  4731,
-    -711,  -711,    67,  -711,   681,  2530,  -711,  -711,   689,    50,
-     716,  -711,  2348,   691,   538,  -711,   705,   397,  4731,  -711,
-     105,  -711,  -711,  1384,   356,   707,   707,   407,  -711,  -711,
-     287,   733,   732,  -711,   568,   388,  -711,   558,  4219,   665,
-    -711,   570,  -711,   560,  -711,  -711,   738,   617,   741,  -711,
-    4731,   388,  -711,  -711,  4091,   536,  -711,  -711,  2811,   519,
-    5430,  -711,  -711,  2530,   727,   106,  -711,  2530,  2530,  5850,
-    2530,   674,   574,   654,   654,   654,   406,   647,   650,  -711,
-    2530,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  5243,  5243,  5243,  2530,  -711,  2530,  -711,  2530,
-    -711,  -711,   573,   814,   814,   128,   814,   814,  4731,  2939,
-    1406,   745,  -711,  -711,   334,  -711,   388,  -711,  -711,  2475,
-     107,   744,  -711,  -711,  -711,  -711,  -711,  -711,  2530,   109,
-    -711,  -711,  -711,   110,  -711,   577,  -711,   314,   314,   314,
-     314,   314,   354,  -711,   314,  -711,  -711,  2530,  2538,  -711,
-    4475,  -711,  5371,  -711,  -711,   571,  -711,  -711,  -711,   579,
-    -711,  -711,   388,   707,  -711,   665,  -711,  4219,  -711,   -50,
-     581,   582,  1196,   388,  -711,  -711,  1362,   580,   356,  -711,
-    -711,   588,  5891,  2530,  -711,  -711,   583,   584,   747,   585,
-     590,   591,  -711,   592,  4731,  1428,  4731,  2811,  -711,  -711,
-     754,  -711,   356,  -711,    26,  -711,    93,  -711,  -711,    29,
-      29,   586,   113,   737,  -711,  -711,  2530,  4603,  -711,  2530,
-    -711,   707,    64,  -711,  -711,   649,  -711,   770,  -711,  -711,
-    -711,  4731,  -711,  -711,   457,   596,  2530,  -711,  -711,  4731,
-    -711,  -711,  -711,  -711,  2530,  4731,  1471,  -711,  4731,  -711,
-    -711,  -711,   111,  -711,   597,    64,  -711,   162,   609,   611,
-    1282,  -711,  1305,  2530,  4731,  2530,  -711,  -711,  -711,  4731,
-    4731,  -711,  -711,  4731,  4731,  2530,  2530,  2530,  2530,  1328,
-    4731,  2530
+    -845,   967,  -845,  -845,  -845,  -845,   -22,    45,  -845,    94,
+     186,  3621,   199,   238,  -845,  4658,    16,    36,  3621,  -845,
+     369,   256,    56,  -845,   299,   280,   268,  -845,  -845,  -845,
+     306,  -845,  -845,   409,   311,   350,  -845,   357,   357,   119,
+     354,  -845,  -845,    53,  -845,  -845,   420,  -845,   386,  -845,
+    -845,  5758,   363,   274,   280,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,   237,  -845,  -845,   549,  -845,  -845,
+    -845,   122,   563,  -845,   440,  -845,  -845,   319,   433,   436,
+     159,   495,   622,   624,  -845,  -845,   523,   329,  -845,  -845,
+     398,   102,   163,  -845,  -845,   471,  -845,  -845,  -845,  -845,
+    -845,   215,  -845,  -845,   215,  -845,  -845,  -845,   215,  -845,
+    -845,   215,  -845,   280,  -845,   280,   280,    20,   630,  -845,
+     472,    44,  3621,   306,  5477,  -845,  -845,  -845,  -845,  -845,
+    4658,  4658,  4658,  -845,  -845,  4658,   473,   474,   477,  -845,
+    4658,  4658,  4658,   478,   484,   486,   487,   488,   494,   496,
+     497,   498,   499,   500,   501,  4658,   505,  4658,   507,   508,
+     511,  4767,  -845,  -845,  -845,   512,  -845,  -845,  -845,  -845,
+    -845,  -845,  4658,  -845,  2490,  -845,  -845,  4658,   470,  -845,
+     513,   515,  -845,   516,   522,   270,  -845,  -845,   524,   654,
+    -845,  4658,  2490,  -845,  -845,  -845,   277,  -845,   277,  -845,
+    -845,  4658,  4658,  -845,  -845,   110,   326,  -845,  -845,  -845,
+    -845,  -845,   524,  5347,  4767,  -845,  -845,  4876,  -845,   524,
+     524,   277,  2573,  -845,   527,   524,  -845,  4658,   665,  -845,
+    -845,  -845,  -845,   680,   563,  -845,  -845,   357,  -845,  -845,
+    2967,  -845,   526,  -845,    88,   524,    32,  -845,   384,    82,
+    -845,  -845,  -845,  -845,  5621,    45,    45,  -845,  -845,   687,
+     533,   691,  -845,  -845,   535,   442,   534,  -845,   535,   524,
+     442,   537,   539,   442,   534,   699,  -845,   545,   847,  -845,
+    -845,  -845,    45,   714,   564,   434,  3874,  -845,  4985,   274,
+    -845,   534,   727,   122,   122,   122,   258,  -845,  -845,  -845,
+    4658,  4658,  -845,  -845,   571,  3983,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  4658,  4658,  4658,  4658,  4658,  4658,
+    4658,   726,  5347,  -845,   470,   522,  -845,  1249,   730,   555,
+     561,  5523,  -845,  2490,   572,  1332,   875,  2490,    38,  4658,
+    4658,  4658,    48,  1353,    61,  4658,  4658,  4658,  4658,  4658,
+    4658,  4658,  4658,  4658,  4658,  4658,  4658,  1514,  4658,    68,
+    4658,  4658,  4658,  4767,  2490,  1533,   753,  1552,   278,   731,
+    4658,  1616,   733,  3294,  4658,  4658,  4658,  4658,  4658,  4658,
+    4658,  4658,  4658,  4658,  4658,  4658,  4658,  4658,  3076,  4658,
+    3403,  3512,  -845,   185,  -845,  4658,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,    69,   534,   199,  1635,  -845,  -845,   734,
+     734,  1129,  1713,  -845,  -845,   576,  -845,  -845,   736,   470,
+     739,  -845,  -845,  -845,  5523,  3765,    79,  -845,   555,  -845,
+     740,   581,   582,   439,  -845,   743,  -845,   105,   734,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,   744,   717,  -845,   106,  2490,   588,
+     591,   280,  4092,  -845,  -845,  2490,  -845,   598,  4658,    31,
+     237,   594,   598,   595,   602,   125,  -845,  -845,  -845,   609,
+     609,  4658,   109,   533,  -845,   622,  2531,  -845,  -845,  -845,
+     622,   534,   534,   622,  -845,   545,   699,  -845,  -845,   534,
+    -845,   615,  -845,  -845,  -845,  -845,  -845,   123,  -845,  -845,
+     609,   618,  -845,   534,  -845,  3874,  3185,   585,   750,    34,
+    4201,  -845,  2490,   592,   534,    80,  4331,  5955,    78,  5879,
+      13,    85,  -845,   215,  2490,  2490,   524,  -845,   619,  2490,
+     616,   778,  -845,  2490,  2490,  2490,  2490,  2490,  2490,  2490,
+    4658,   337,  1249,  2490,   706,  1732,  -845,   779,  -845,  1249,
+    -845,  5523,  5523,  5523,  5523,  5523,   760,  4658,  -845,  4658,
+    -845,   111,   115,  1751,  -845,  -845,  -845,  1796,  1815,  1834,
+    1912,  1931,  1995,  2014,  2033,  2092,  2111,  2130,  2194,  -845,
+     121,  -845,   130,   136,   149,   781,   785,   786,  4767,  4767,
+    -845,  4767,   150,  -845,  4658,  4658,  2490,  -845,   542,   542,
+     806,   806,   875,   887,   887,   887,   887,   887,   887,   164,
+     164,   185,  4658,  4658,  2490,  -845,   185,  4658,   887,  4658,
+     887,   524,   787,  2640,   627,   629,   524,  -845,  -845,  -845,
+    -845,   295,  4658,  6031,  4658,  -845,  4658,    19,   631,   337,
+    -845,  -845,  2640,    83,  5347,  -845,  -845,  -845,  -845,    19,
+     632,   524,  -845,  2573,  -845,  4658,  -845,  4658,  -845,  -845,
+    -845,   771,    42,   547,  -845,  2213,   636,  -845,   637,  -845,
+     776,  4658,  4658,   135,  -845,   242,  -845,   774,  2490,  -845,
+    -845,   535,  4658,  -845,   151,  -845,  -845,  1253,   524,   780,
+     780,   545,  -845,  -845,   476,   847,  -845,  -845,   534,   780,
+     641,  4092,   750,  -845,   645,  -845,   644,  -845,  -845,   804,
+     688,   809,  -845,  2490,  -845,  -845,  -845,   773,   215,  -845,
+     215,   653,  -845,  -845,  -845,  -845,   652,   536,  -845,   215,
+    -845,  2749,   655,   664,  -845,  -845,   122,  -845,  -845,  -845,
+    3983,  2490,  -845,   152,  -845,  2490,  2490,  2490,  1249,   779,
+     570,   760,   760,   760,   593,  -845,  2490,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  5094,  5094,  5094,  2490,
+    -845,  2490,  -845,  2490,  -845,  -845,   667,   887,   887,   185,
+     887,   887,   470,  4658,  2858,  1415,   828,  -845,  -845,   513,
+    -845,   534,  -845,  -845,  2291,   670,  -845,   671,  -845,  2310,
+    1150,   829,  -845,  -845,  1233,   672,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  2490,   153,  -845,   598,   598,   598,   598,
+     598,   522,  -845,   832,   676,  -845,  2329,  2374,  -845,  -845,
+    -845,  -845,   154,  -845,   678,  -845,  -845,  2490,  2531,  -845,
+    4440,  -845,  5203,  -845,  -845,   699,  -845,  -845,  -845,   679,
+    -845,   780,   231,  -845,   750,  -845,  4092,  -845,   291,   681,
+     683,  4658,   586,   215,   122,   122,  -845,  4658,   685,  -845,
+     454,  -845,   215,   122,  4658,  2490,   155,  -845,   842,  -845,
+    -845,  5955,   534,  -845,  1831,  2490,  -845,  -845,   832,   684,
+     686,   689,  -845,   690,  4658,  1435,  4658,  2640,  -845,  -845,
+     845,  4658,  4658,  -845,  4658,   524,  -845,   524,  -845,  -845,
+      66,    66,   693,   143,  4658,   833,  -845,   768,    60,  -845,
+     259,  -845,  -845,  -845,  2490,  4549,  -845,  2490,  -845,   231,
+    4658,  4658,  -845,  -845,  -845,   729,  -845,   851,  -845,  -845,
+    -845,   695,   696,   702,   215,  -845,   122,  2393,  -845,   703,
+    -845,  -845,   122,  5955,  -845,  2749,  -845,  4658,   534,   701,
+    2490,  -845,  -845,  -845,  -845,  2490,  4658,  1455,  -845,  4658,
+     704,  2412,  1171,   470,   697,  1192,   598,  -845,  -845,  -845,
+     157,   705,  -845,  2490,  2490,   709,   713,   716,  -845,  -845,
+     122,  4331,   784,  -845,  5955,  -845,  -845,  -845,  -845,  2490,
+    4658,  2490,  4658,  6107,  4658,  4658,   855,  -845,  -845,  -845,
+    -845,  -845,  4331,   719,  2490,  2490,  1213,  -845,  -845,  4658,
+    2490
 };
 
@@ -1544,1252 +1440,1297 @@
 static const yytype_int16 yypgoto[] =
 {
-    -711,  -711,  -711,  -711,   523,  -711,    30,  -711,   774,  -711,
-     -66,   772,  -711,  -711,    65,     6,  -711,  -711,  -430,  -711,
-    -118,  -110,  -711,  -711,   123,  -711,  -711,  -711,   373,  -711,
-     120,     1,  -711,  -711,  -711,  -711,  -711,  -480,  -711,  -711,
-    -264,   312,  -439,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,   -68,  -711,  -711,  -276,   300,   -35,   -85,   548,
-     324,  -711,  -711,  -711,   274,  -711,  -711,  -711,  -711,  -711,
-     281,  -711,  -711,  -711,  -699,  -711,  -711,  -711,   515,  -290,
-    -666,  -711,  -711,   100,  -711,   749,  -104,  -711,   -25,   -17,
-     -26,  -136,    56,  -176,  -432,  -497,  -711,  -711,  -103,  -711,
-    -711,  -711,  -204,  -711,   404,   159,   -57,    95,    -5,   -70,
-    -711,  -711,  -197,  -398,   -30,  -108,  -711,  -166,  -711,  -711,
-    -711,  -711,   -23,  -711,  -105,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,   -28,  -711,  -711,  -711,   708,   302,
-    -208,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,   118,
-    -711,  -711,  -711,  -711,  -711,   277,  -711,  -711,   114,  -711,
-    -711,  -711,  -711,  -306,   720,  -263,  -226,  -711,  -673,  -554,
-     514,   482,  -326,  -710,   308,  -711,   273,  -202,  -711,   275,
-    -416,  -711,  -711,  -711
+    -845,  -845,  -845,   -96,   830,   628,   -26,  -845,  -845,  -845,
+     399,   156,  -845,   -94,  -845,   -67,   -63,  -845,  -845,   232,
+    -845,  -845,  -845,   509,  -845,   234,    30,  -845,  -845,  -845,
+    -845,  -845,   444,  -464,  -845,  -845,  -238,   438,  -242,  -845,
+    -845,  -845,  -845,  -845,  -845,   -47,  -845,  -845,  -263,   417,
+     -27,   -50,   668,   437,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,   404,  -845,  -845,  -671,  -845,  -845,  -845,   642,  -231,
+    -656,  -845,  -845,   217,  -845,   882,  -236,  -845,    67,    70,
+     -11,   -78,    55,  -144,  -458,  -507,  -845,  -845,   -97,  -845,
+    -845,  -845,  -845,  -845,   540,  -845,     9,   279,     1,   -70,
+    -845,  -845,  -182,  -382,   365,   -20,  -128,  -845,  -845,  -845,
+      52,  -845,   -73,    43,  -845,  -630,  -845,  -515,  -514,  -844,
+    -845,  -845,  -845,  -845,  -566,  -718,  -845,  -845,  -845,  -845,
+    -294,  -845,  -845,  -845,  -845,  -845,  -185,  -845,  -845,  -845,
+    -845,  -845,  -845,  -663,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,   405,  -845,  -845,  -845,  -845,  -845,   -40,
+    -787,  -845,  -845,  -845,  -845,  -845,  -845,   -38,   190,    11,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,   191,  -845,
+    -845,  -845,  -845,   506,  -845,  -845,   288,  -384,  -845,  -845,
+    -845,   -39,   834,  -250,  -126,  -699,  -522,  -140,  -287,  -465,
+    -845,  -845,  -213,  -845,   519,  -845
 };
 
 /* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
    positive, shift that token.  If negative, reduce the rule which
-   number is the opposite.  If zero, do what YYDEFACT says.
-   If YYTABLE_NINF, syntax error.  */
-#define YYTABLE_NINF -511
+   number is the opposite.  If YYTABLE_NINF, syntax error.  */
+#define YYTABLE_NINF -542
 static const yytype_int16 yytable[] =
 {
-     189,   384,   205,   421,   338,   218,   211,   533,   120,   205,
-     500,   385,   391,   512,   504,   226,   660,   854,   230,   706,
-     281,   568,   283,   440,   145,   758,   285,   438,   760,   318,
-     596,   575,   438,   682,   448,   217,   282,   339,   213,   596,
-     591,   383,   249,   250,   213,   494,   422,   423,   596,   830,
-     257,   667,   840,   837,   736,   625,   243,   311,   445,   694,
-     238,   239,   701,   866,   261,   683,   262,   701,   278,  -361,
-     340,   838,   839,   840,   687,   493,   821,   289,   750,    17,
-     756,   590,   756,   890,   891,   756,   885,   596,   596,   596,
-     830,   596,   596,   596,   290,   291,   312,   723,   313,   314,
-     274,   596,   596,   300,   317,   267,   220,   326,   848,   882,
-     897,   205,   687,   904,   904,   268,   830,  -164,   146,   925,
-      91,  -164,   353,   354,   221,   419,   292,   263,   437,   266,
-     227,   361,   148,   437,   838,   839,   840,   926,   351,   586,
-     329,   330,   587,   588,   589,   375,   414,   498,   303,   433,
-     319,   382,   279,   408,   297,   416,   406,   407,   408,   240,
-     246,   298,   390,   241,   922,  -315,   412,   969,   499,  -164,
-     452,   384,   935,  -164,   247,   240,   240,   425,   675,   241,
-     241,   385,   510,   223,   429,   240,   224,   497,  -314,   241,
-    -361,   338,   737,   434,   487,   831,   253,   254,   435,   923,
-     495,   338,   427,   213,   546,   623,   577,   597,   382,   885,
-     338,   383,   360,   320,   362,   385,   601,   841,   482,   248,
-     496,   214,   955,   424,   339,   603,   439,   216,   668,   446,
-     549,   447,   450,   203,   339,   229,   831,   480,   841,   578,
-     501,   726,   684,   339,   258,   383,   506,   832,   729,   207,
-     509,   688,   696,   120,   264,   751,   485,   340,   745,   301,
-     884,   884,   831,   884,   771,   772,   786,   340,   787,   788,
-     789,   534,   579,   951,   505,   534,   340,   543,   790,   801,
-     762,   763,   764,   765,   766,   849,   883,   901,   970,   903,
-     905,   966,   553,   554,   210,   490,   219,   558,   251,   752,
-     796,   841,   798,   800,   304,   590,   570,   571,   572,   573,
-     659,   550,   590,   409,   410,   555,   231,   548,   409,   410,
-     236,   382,   565,   669,    91,   276,   488,   489,   590,   936,
-     417,   680,   565,   600,   286,   150,   151,   604,   605,   606,
-     607,   608,   609,   610,   611,   612,   613,   614,   615,   237,
-     755,   886,   887,   232,   244,   622,   271,   908,   761,   527,
-     233,   721,   722,   234,   913,   391,   634,   636,   637,   638,
-     639,   640,   641,   642,   643,   644,   645,   646,   647,   648,
-     649,   652,   654,   656,   658,   440,   756,   282,   211,   438,
-     438,   536,   448,   284,   537,   306,   664,   665,   282,   909,
-     910,   911,   912,   715,   716,   701,   701,   701,   701,   701,
-     893,   719,   701,   598,   599,  -164,   707,   342,   347,  -164,
-     307,   714,   309,   315,   717,   856,   857,   858,   338,   587,
-     588,   589,   617,   618,   619,   620,   621,   322,   865,   884,
-     577,   855,   735,   846,   881,   630,   323,   325,   577,   327,
-     338,   338,   338,   338,   338,   357,   802,   691,   358,   359,
-     385,   339,   385,   385,   363,   695,   796,   798,   800,   702,
-     364,   365,   438,   578,   822,   366,   713,   438,   367,   824,
-     368,   578,   590,   339,   339,   339,   339,   339,   369,   370,
-     437,   437,   371,   413,   340,   372,   373,   374,   376,   590,
-     590,   590,   590,   590,   377,   534,   579,   378,   379,   380,
-     389,   534,   534,   414,   579,   390,   340,   340,   340,   340,
-     340,   416,   417,   418,   392,    91,   393,   394,   395,   396,
-     397,   428,   398,   399,   400,   401,   402,   403,   430,   749,
-     404,   405,   406,   407,   408,   431,   479,   483,   753,   484,
-     586,   329,   330,   587,   588,   589,   586,   329,   330,   587,
-     588,   589,   491,   267,   493,   769,   276,   502,   507,   205,
-     770,   508,   391,   437,   511,   528,   286,   924,   437,   526,
-     397,   535,   398,   399,   400,   401,   402,   403,   439,   447,
-     404,   405,   406,   407,   408,   329,   330,   587,   588,   589,
-     795,   545,   797,   799,   547,   556,   382,   803,   586,   329,
-     330,   587,   588,   589,   338,   574,   802,   898,   590,   584,
-     593,   863,   594,   577,   804,   805,   385,   385,   385,   806,
-     842,   807,   627,   628,   629,   810,   632,   873,  -490,  -490,
-    -490,  -490,  -490,  -490,   672,   879,   320,   339,   819,   810,
-     676,   678,   679,   681,   685,   689,   578,   690,   686,   692,
-     703,   828,   816,   482,   704,   720,   725,   730,   731,   734,
-     934,   447,   740,   743,   223,   744,   447,   759,   826,   589,
-     340,   792,   847,   398,   399,   400,   401,   402,   403,   579,
-     793,   404,   405,   406,   407,   408,   794,   814,   502,   808,
-     815,   817,   534,   818,   409,   410,   823,   825,   878,   851,
-     754,   835,   899,   836,   872,   844,   875,   495,   558,   395,
-     396,   397,   876,   398,   399,   400,   401,   402,   403,   845,
-     852,   404,   405,   406,   407,   408,   861,   862,   864,   867,
-     868,   391,   869,   870,   871,   565,   577,  -491,   897,   902,
-     929,   737,   939,   892,   409,   410,   906,   948,   921,   920,
-     933,   953,   513,   937,   938,   940,   795,   797,   799,   932,
-     941,   942,   943,   959,   841,   958,   961,   967,   971,   578,
-     925,   486,   211,   895,    16,   626,   144,  -247,   952,  -247,
-    -247,  -247,  -247,  -247,   950,  -247,  -247,  -247,  -247,  -247,
-    -247,   670,   724,  -247,  -247,  -247,  -247,  -247,   827,   829,
-     705,   718,   579,   253,   254,   514,   492,   697,   727,   544,
-     662,   860,   713,   914,   916,   256,   919,  -511,  -511,  -511,
-    -511,  -511,  -511,   915,   820,   404,   405,   406,   407,   408,
-     947,   534,   515,   877,   516,   517,   518,   968,   930,   519,
-     520,   352,   521,   522,   972,   409,   410,   741,   178,   179,
-     345,   592,   874,   624,   880,   742,   767,     0,   944,   768,
-     946,   810,     0,   351,   181,   182,     0,     0,   183,   184,
-     185,   186,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,   390,   187,     0,     0,   409,   410,   949,     0,     0,
-       0,     0,     0,     0,     0,   960,     0,     0,     0,     0,
-       0,     0,     0,   962,     0,     0,     0,     0,     0,   963,
-       0,     0,   965,     2,     3,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   975,     0,
-       0,     0,     0,   976,   977,     0,     0,   978,   979,     0,
-     -23,     0,   -23,     0,   981,   -23,   -23,   -23,   -23,     4,
-       5,   -23,     0,     0,   -23,   -23,   -23,  -247,  -247,     0,
-       0,   -23,   -23,     0,     0,     0,     6,     7,     0,     0,
-       0,     0,     0,     0,     0,     0,   -23,     0,     0,     0,
-     -23,   -23,     0,     0,     0,   -23,     0,     0,     0,   409,
-     410,   -23,     0,   -23,   -23,     0,   -23,     0,   -23,   -23,
-     -23,   -23,   -23,     0,   -23,   -23,   -23,   -23,   -23,   -23,
-     -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,
-       0,     0,   -23,   -23,   -23,     0,   -23,   -23,   -23,     0,
-     -23,   -23,   -23,     0,     0,   -23,     0,   -23,     0,     0,
-     -23,   -23,   -23,   -23,     0,     0,   -23,   -23,   -23,     0,
-       0,     0,     0,     0,   -23,     0,     0,     8,   -23,   -23,
-     -23,   -23,   -23,   -23,   -23,     0,   -23,   -23,   -23,   -23,
-     -23,     0,     0,   -23,     0,     0,     0,     0,     0,     0,
-     -23,   -23,   -23,     0,     0,     0,     0,     0,     0,   -23,
-       9,  -510,     0,  -510,     0,  -510,  -510,  -510,  -510,  -510,
-      10,  -510,  -510,  -510,  -510,  -510,  -510,     0,     0,  -510,
-    -510,  -510,  -510,  -510,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   152,   153,     0,
-       0,     0,   154,   155,   156,   157,     0,     0,     0,     0,
-       0,     0,     0,     0,   158,   159,   160,   161,   162,   163,
-     164,     0,   165,   166,   167,     0,     0,   168,   169,   170,
-       0,   171,   172,   173,   174,   175,   674,   176,   392,     0,
-     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
-     402,   403,     0,     0,   404,   405,   406,   407,   408,   931,
-       0,   392,     0,   393,   394,   395,   396,   397,     0,   398,
-     399,   400,   401,   402,   403,     0,     0,   404,   405,   406,
-     407,   408,     0,     0,     0,     0,     0,     0,     0,     0,
+     174,   539,    93,   402,   192,   293,   434,   174,   294,   474,
+     641,   775,   295,   642,   506,   296,   243,   366,   690,   684,
+     414,   735,   736,   828,   684,   300,   494,   324,   372,   265,
+     498,   270,   271,   367,   686,   203,   273,  -171,   504,   874,
+     226,   579,   766,   767,    96,   846,   323,   198,   882,   257,
+     258,   579,    93,   268,   325,   534,   764,   764,   764,   203,
+     277,   847,   848,   849,   579,  -171,   885,   221,   222,   917,
+     366,   579,   646,   432,   430,   297,   607,   298,   299,   575,
+    -430,   859,   664,   365,   899,   329,   367,   849,   373,   374,
+     375,   376,   377,   378,    96,   379,   380,   381,   382,   383,
+     384,   332,   385,   386,   387,   388,   389,   729,   671,   675,
+     477,   174,   493,   203,   579,   419,   324,   984,   579,   333,
+     335,   336,   419,   285,   579,   750,   715,   483,   203,   540,
+     343,   126,  1021,   579,  -426,   323,   365,   223,   203,   579,
+     831,   224,   301,   325,   357,   307,   251,   194,   479,  -429,
+     364,   410,   579,   579,   868,   914,   675,   948,   985,  -425,
+     948,   371,   847,   848,   849,  -171,   393,   194,   648,   741,
+     484,   485,   229,   971,   438,   751,  1042,   223,   575,   170,
+     406,   224,   195,   230,   288,   387,   388,   389,   302,   404,
+     411,   412,   753,   742,  -171,   342,   480,   344,  -106,   394,
+    1026,   580,   197,   364,   308,   128,   364,   417,   389,   850,
+     959,   584,   359,  1000,   425,   917,   468,   204,   433,   605,
+     860,   436,  -430,   606,   586,   324,   466,   486,   963,   475,
+     564,   601,   647,   850,   324,   367,   960,   980,   495,     4,
+     730,   680,   665,   500,   323,   496,   503,   390,   391,   563,
+     478,   836,   325,   323,   716,    93,   130,   565,   916,   916,
+     916,   325,   252,   859,   286,   709,   710,   471,   672,   676,
+     499,   413,   699,   713,   777,   475,  -426,   532,   778,   170,
+     859,   609,   251,   561,   792,   365,   204,   719,   253,   544,
+     545,  -429,   576,   793,   549,   722,   413,    96,   728,   794,
+     694,  -425,   540,   553,   554,   555,   556,   557,   558,   559,
+     850,   575,   795,   805,   869,   915,   938,   949,   986,   266,
+    1037,   800,   802,   425,   804,   289,   575,   324,   390,   391,
+     583,   919,   920,   921,   587,   588,   589,   590,   591,   592,
+     593,   594,   595,   596,   597,   598,   323,   223,   131,   390,
+     391,   224,   371,   961,   325,   571,   311,   312,   572,   573,
+     574,   188,   616,   618,   619,   620,   621,   622,   623,   624,
+     625,   626,   627,   628,   629,   630,   631,   634,   636,   638,
+     640,    69,   939,   199,   192,   659,   372,   481,   684,   684,
+     684,   684,   684,   990,   581,   582,   697,   244,   252,   245,
+     191,   278,   860,   828,   610,   861,   482,   239,   764,   575,
+     407,   489,   490,   600,   663,   602,   603,   604,   202,   860,
+     415,   416,  1009,   400,   253,   612,   717,   837,   822,   279,
+     212,   923,   395,   679,   240,   241,   763,   408,   520,   264,
+     209,   235,   236,   769,   832,   701,   210,   756,   875,   989,
+     708,   965,   937,   711,  -156,   823,   839,   966,  -156,   208,
+     223,   475,   911,   866,   224,   564,   775,   685,   213,   255,
+     806,   256,   564,   219,   324,   324,   324,   324,   324,   259,
+     698,   260,   881,   916,   563,   707,   170,   309,   194,   274,
+     884,   563,   565,   323,   323,   323,   323,   323,   269,   565,
+     762,   325,   325,   325,   325,   325,   735,   736,   858,   800,
+     802,   804,   220,  -156,   475,   475,   227,  -156,   372,   371,
+     575,   575,   575,   575,   575,   733,   203,   735,   736,   280,
+     200,   201,   770,   771,   772,   773,   774,   746,    93,   979,
+      93,  -156,  1036,   231,   812,  -156,   232,   757,   684,   761,
+     376,   377,   378,   249,   379,   380,   381,   382,   383,   384,
+     419,   385,   386,   387,   388,   389,   733,   324,   776,   215,
+     216,   217,   419,   571,   311,   312,   572,   573,   574,  -541,
+    -541,  -541,  -541,  -541,  -541,   929,   323,   254,   139,   311,
+     312,   572,   573,   574,   325,   524,   525,   799,   801,   263,
+     803,   398,   668,   364,   807,   940,   941,   942,   943,   983,
+     876,   877,   878,   851,   572,   573,   574,   133,   134,   746,
+     898,   808,   809,   972,   973,   203,   810,   272,   811,   310,
+     327,   292,   815,   304,   305,   339,   340,   928,   394,   341,
+     345,   824,   894,   829,   895,   830,   346,   821,   347,   348,
+     349,   834,   806,   903,    93,   964,   350,   405,   351,   352,
+     353,   354,   355,   356,   843,   425,   468,   358,   469,   360,
+     361,   564,   841,   362,   370,   395,   988,   397,   398,   162,
+     856,   857,   399,   470,   170,   163,   164,   465,  1024,   476,
+     563,   867,   491,   259,   493,   266,   496,   501,   565,   502,
+     166,   167,   505,   168,   169,   274,   390,   391,   171,   871,
+     475,   373,   374,   375,   376,   377,   378,   521,   379,   380,
+     381,   382,   383,   384,   523,   385,   386,   387,   388,   389,
+     535,   560,   547,   569,   611,   577,   614,   651,   654,   674,
+     905,   656,   657,   609,   666,   667,   669,   673,   723,   549,
+     677,   678,  1027,   724,   688,   727,   608,   691,  -237,  -237,
+    -237,  -237,  -237,  -237,   692,  -237,  -237,  -237,  -237,  -237,
+    -237,   695,  -237,  -237,  -237,  -237,  -237,   714,   718,   759,
+     758,   760,   768,   574,   796,   799,   801,   803,   797,   798,
+     819,   813,   820,   845,   833,   840,   853,   976,   855,   478,
+     864,   872,   192,   925,   883,   886,   982,   887,   888,   891,
+     889,   372,   890,   896,   897,   909,   378,   564,   379,   380,
+     381,   382,   383,   384,   910,   385,   386,   387,   388,   389,
+     922,   927,   931,   932,   935,   936,   563,   944,  1003,   945,
+     950,   969,   958,   730,   565,   978,   987,   991,   999,   992,
+    1007,  1015,   993,   994,  1016,  1006,  1018,   707,  1017,   954,
+     850,   957,  1019,  1023,  1028,   302,  1043,  1032,  1038,  1039,
+     390,   391,   507,   965,   394,   475,  1041,  1047,  1020,  1048,
+     333,   234,   488,  1010,   693,  1008,   977,   379,   380,   381,
+     382,   383,   384,   905,   385,   386,   387,   388,   389,  -542,
+    -542,  -542,  -542,  -542,  -542,   842,   385,   386,   387,   388,
+     389,   844,    93,   995,   649,   997,   815,  -237,  -237,   689,
+     333,  1001,   712,  1002,   687,   235,   236,   508,   492,   720,
+     700,   533,   880,  1005,   238,   952,   998,   644,    93,  1012,
+     953,   835,   970,  1040,   371,  1025,   754,   912,  1004,  1013,
+    1014,   913,   838,   509,   670,   510,   511,   512,   330,     0,
+     513,   514,     0,   515,   516,     0,     0,     2,     3,     0,
+     390,   391,     0,     0,   905,     0,   905,     0,     0,     0,
+       0,     0,     0,     0,    93,  1029,     0,     0,  1031,     0,
+       0,     4,     5,     0,     0,     6,   -21,     7,   -21,     8,
+       0,     0,     9,     0,     0,     0,     0,     0,     0,     0,
+     733,     0,    10,     0,     0,     0,     0,     0,     0,  1044,
+       0,   733,     0,  1045,  1046,    93,     0,     0,    11,     0,
+       0,   733,    12,    13,    93,     0,     0,    14,  1050,   390,
+     391,     0,     0,    15,     0,    16,    17,     0,    18,     0,
+       0,   390,   391,    19,    20,    21,    22,    23,     0,    24,
+      25,     0,     0,    26,    27,    28,    29,    30,    31,    32,
+      33,    34,    35,    36,     0,    37,     0,    38,    39,     0,
+       0,    40,    41,    42,     0,    43,     0,    44,     0,     0,
+      45,    46,     0,     0,    47,    48,    49,     0,     0,     0,
+       0,     0,     0,     0,    50,     0,     0,    51,    52,    53,
+      54,    55,    56,    57,    58,    59,    60,    61,    62,    63,
+       0,     0,    64,     0,     0,    65,    66,    67,    68,     0,
+       0,     0,   652,    69,   373,   374,   375,   376,   377,   378,
+       0,   379,   380,   381,   382,   383,   384,     0,   385,   386,
+     387,   388,   389,   934,     0,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,  1034,     0,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,  1035,     0,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,  1049,     0,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   926,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   870,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,     0,     0,     0,
+       0,     0,   135,   136,     0,     0,     0,     0,   137,   138,
+     139,   140,   141,   390,   391,     0,     0,     0,     0,     0,
+       0,     0,     0,   142,   143,   144,   145,   146,   147,   148,
+       0,   149,   150,   151,   390,   391,   152,   153,   154,     0,
+     155,   156,   157,   158,   159,     0,   160,     0,     0,     0,
+       0,     0,     0,     0,     0,   390,   391,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   390,   391,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   390,   391,     0,
+       0,   162,     0,     0,     0,     0,     0,   163,   164,     0,
+       0,     0,     0,   165,     0,     0,   613,   390,   391,     0,
+       0,     0,   166,   167,     0,   168,   169,     0,     0,   170,
+     171,   562,     0,     0,     0,     0,     0,   390,   391,   926,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,   996,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,  1030,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     178,   179,     0,     0,     0,     0,   180,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   181,   182,     0,     0,
-     183,   184,   185,   186,     0,     0,     0,    91,     0,     0,
-       0,     0,     0,     0,   187,     0,     0,   576,     0,     0,
-       0,     0,     0,  -510,  -510,   973,     0,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,     0,     0,   404,   405,   406,   407,   408,   974,     0,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,   980,     0,   392,     0,   393,   394,   395,   396,   397,
-       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
-     405,   406,   407,   408,     0,     0,     0,     0,   409,   410,
-       0,     0,     0,     0,     0,     0,   896,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,   409,   410,   404,   405,   406,   407,   408,   850,   392,
-       0,   393,   394,   395,   396,   397,     0,   398,   399,   400,
-     401,   402,   403,     0,     0,   404,   405,   406,   407,   408,
-     896,   392,     0,   393,   394,   395,   396,   397,     0,   398,
-     399,   400,   401,   402,   403,     0,     0,   404,   405,   406,
-     407,   408,   945,   392,     0,   393,   394,   395,   396,   397,
-       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
-     405,   406,   407,   408,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   409,   410,     0,
-       0,     0,     0,     0,     0,   964,   392,     0,   393,   394,
-     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
-     409,   410,   404,   405,   406,   407,   408,     0,     0,   392,
-       0,   393,   394,   395,   396,   397,     0,   398,   399,   400,
-     401,   402,   403,   409,   410,   404,   405,   406,   407,   408,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,   631,     0,     0,     0,     0,   409,   410,     0,
-       0,     0,     0,     0,     0,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,   409,
-     410,   404,   405,   406,   407,   408,     0,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,   409,   410,   404,   405,   406,   407,   408,     0,  -250,
-       0,  -250,  -250,  -250,  -250,  -250,     0,  -250,  -250,  -250,
-    -250,  -250,  -250,   409,   410,  -250,  -250,  -250,  -250,  -250,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,   409,   410,   404,   405,
-     406,   407,   408,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   436,     0,     0,     0,     0,   409,
-     410,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,   595,     0,     0,     0,     0,
-     409,   410,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
-     406,   407,   408,     0,     0,     0,     0,     0,     0,     0,
-     602,     0,     0,     0,     0,   409,   410,     0,     0,     0,
+       0,     0,     0,     0,     0,   578,   390,   391,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   616,     0,     0,     0,     0,   409,   410,     0,
+       0,     0,     0,     0,     0,     0,   585,   390,   391,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,  -239,  -239,
+    -239,  -239,  -239,  -239,     0,  -239,  -239,  -239,  -239,  -239,
+    -239,     0,  -239,  -239,  -239,  -239,  -239,  -238,  -238,  -238,
+    -238,  -238,  -238,     0,  -238,  -238,  -238,  -238,  -238,  -238,
+       0,  -238,  -238,  -238,  -238,  -238,     0,     0,     0,   390,
+     391,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   390,
+     391,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   390,
+     391,   373,   374,   375,   376,   377,   378,     0,   379,   380,
+     381,   382,   383,   384,     0,   385,   386,   387,   388,   389,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,  -250,     0,     0,     0,     0,  -250,
-    -250,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,   631,     0,     0,     0,     0,
-     409,   410,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   666,     0,     0,
-       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
-     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
-     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
-       0,   404,   405,   406,   407,   408,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   671,     0,     0,
-       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
-     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
-     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
-       0,   404,   405,   406,   407,   408,   392,     0,   393,   394,
-     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
-       0,     0,   404,   405,   406,   407,   408,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,     0,     0,   404,   405,   406,   407,   408,   392,     0,
-     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
-     402,   403,     0,     0,   404,   405,   406,   407,   408,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   673,
-       0,     0,     0,     0,   409,   410,     0,     0,     0,   418,
-       0,   392,     0,   393,   394,   395,   396,   397,     0,   398,
-     399,   400,   401,   402,   403,   409,   410,   404,   405,   406,
-     407,   408,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
-     406,   407,   408,     0,     0,     0,     0,     0,     0,   773,
-       0,     0,     0,     0,   409,   410,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   599,   390,   391,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     774,     0,     0,     0,     0,   409,   410,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,  -239,  -239,  -239,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,   775,     0,     0,     0,     0,   409,   410,     0,     0,
+       0,     0,     0,     0,     0,  -238,  -238,  -238,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,     0,     0,     0,     0,   613,
+     390,   391,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   650,   390,
+     391,   373,   374,   375,   376,   377,   378,     0,   379,   380,
+     381,   382,   383,   384,     0,   385,   386,   387,   388,   389,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,     0,     0,
+       0,     0,     0,     0,   135,   136,     0,     0,     0,     0,
+     137,   138,   139,   140,   141,     0,   653,   390,   391,     0,
+       0,     0,     0,     0,     0,   142,   143,   144,   145,   146,
+     147,   148,   399,   149,   150,   151,   390,   391,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
+       0,     0,     0,     0,   779,   390,   391,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,     0,     0,     0,     0,   780,
+     390,   391,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,     0,     0,   165,     0,     0,   781,   390,
+     391,     0,     0,     0,   166,   167,     0,   168,   169,     0,
+       0,   918,   171,   562,     0,     0,     0,   782,   390,   391,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   776,     0,     0,     0,     0,   409,   410,     0,
+       0,     0,     0,     0,     0,   783,   390,   391,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,   777,     0,     0,     0,     0,   409,   410,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   778,     0,     0,     0,
-       0,   409,   410,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   779,     0,     0,
-       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
-     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
-     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
-       0,   404,   405,   406,   407,   408,   392,     0,   393,   394,
-     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
-       0,     0,   404,   405,   406,   407,   408,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,     0,     0,   404,   405,   406,   407,   408,   392,     0,
-     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
-     402,   403,     0,     0,   404,   405,   406,   407,   408,     0,
-       0,     0,     0,     0,     0,   780,     0,     0,     0,     0,
-     409,   410,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
-     406,   407,   408,   392,     0,   393,   394,   395,   396,   397,
-       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
-     405,   406,   407,   408,     0,     0,     0,     0,     0,    22,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   781,
-       0,     0,     0,     0,   409,   410,     0,     0,     0,     0,
-       0,     0,     0,     0,    28,     0,     0,     0,     0,     0,
-     782,     0,     0,     0,     0,   409,   410,     0,     0,    32,
-       0,     0,     0,     0,    35,   348,     0,     0,     0,    39,
-      40,   783,     0,     0,     0,     0,   409,   410,     0,   349,
-      49,    50,    51,    52,    53,    54,   350,     0,     0,     0,
-       0,     0,   784,     0,     0,     0,     0,   409,   410,    64,
-       0,     0,     0,     0,     0,    67,     0,     0,     0,     0,
-       0,     0,     0,   785,    72,     0,    74,     0,   409,   410,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,     0,     0,     0,     0,     0,   791,     0,     0,
-      91,     0,   409,   410,     0,     0,     0,    92,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   843,     0,
-       0,     0,     0,   409,   410,   392,     0,   393,   394,   395,
-     396,   397,   708,   398,   399,   400,   401,   402,   403,     0,
-     149,   404,   405,   406,   407,   408,     0,     0,     0,   150,
-     151,   709,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   152,   153,     0,
-       0,     0,   154,   155,   156,   157,     0,     0,     0,     0,
-       0,     0,     0,     0,   158,   159,   160,   161,   162,   163,
-     164,     0,   165,   166,   167,     0,     0,   168,   169,   170,
-       0,   171,   172,   173,   174,   175,     0,   176,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   453,     0,
-       0,     0,   454,   455,   456,   457,     0,     0,     0,     0,
-       0,     0,     0,     0,   458,   459,   460,   461,   462,   463,
-     464,     0,   465,   466,   467,   900,     0,   468,   469,   470,
-     409,   410,   471,   472,   473,   474,     0,   475,     0,   177,
-       0,     0,     0,     0,     0,     0,     0,     0,   149,     0,
-     178,   179,     0,     0,     0,     0,   180,   150,   151,     0,
-       0,     0,     0,     0,     0,     0,   181,   182,     0,     0,
-     183,   184,   185,   186,     0,   152,   153,    91,     0,     0,
-     154,   155,   156,   157,   187,   409,   410,   188,     0,     0,
-       0,     0,   158,   159,   160,   161,   162,   163,   164,     0,
-     165,   166,   167,     0,     0,   168,   169,   170,     0,   171,
-     172,   173,   174,   175,     0,   176,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   476,     0,     0,
+       0,     0,     0,     0,   784,   390,   391,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,     0,     0,     0,     0,   785,   390,
+     391,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   786,   390,   391,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   787,   390,   391,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   788,   390,   391,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   789,   390,   391,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   790,   390,   391,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,   373,   374,   375,   376,   377,   378,
+       0,   379,   380,   381,   382,   383,   384,     0,   385,   386,
+     387,   388,   389,     0,     0,     0,     0,   791,   390,   391,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   852,   390,   391,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   930,   390,   391,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   933,   390,   391,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   946,   390,   391,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   702,     0,   947,   390,   391,
+       0,     0,   132,     0,     0,     0,     0,     0,     0,     0,
+     133,   134,   703,     0,     0,     0,  1022,   390,   391,     0,
+       0,     0,     0,     0,   135,   136,     0,     0,     0,     0,
+     137,   138,   139,   140,   141,  1033,   390,   391,     0,     0,
+       0,     0,     0,     0,     0,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,   439,   160,     0,
+       0,     0,   440,   441,     0,   442,   443,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   444,   445,   446,
+     447,   448,   449,   450,     0,   451,   452,   453,     0,     0,
+     454,   455,   456,     0,   814,   457,   458,   459,   460,     0,
+     461,   132,     0,     0,   390,   391,   161,     0,     0,   133,
+     134,     0,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,   135,   136,   165,     0,     0,     0,   137,
+     138,   139,   140,   141,   166,   167,     0,   168,   169,     0,
+       0,   170,   171,   172,   142,   143,   144,   145,   146,   147,
+     148,     0,   149,   150,   151,     0,     0,   152,   153,   154,
+       0,   155,   156,   157,   158,   159,     0,   160,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   462,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   904,     0,     0,     0,     0,     0,     0,
+     132,     0,     0,     0,     0,   161,     0,     0,   133,   134,
+       0,     0,   162,     0,     0,     0,     0,     0,   163,   164,
+       0,     0,   135,   136,   165,     0,     0,     0,   137,   138,
+     139,   140,   141,   166,   167,     0,   168,   169,     0,     0,
+     170,   171,   172,   142,   143,   144,   145,   146,   147,   148,
+       0,   149,   150,   151,     0,     0,   152,   153,   154,     0,
+     155,   156,   157,   158,   159,     0,   160,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   177,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   178,   179,
-       0,     0,     0,     0,   180,   809,     0,     0,     0,     0,
-       0,     0,     0,   149,   181,   182,     0,     0,   183,   184,
-     185,   186,   150,   151,     0,    91,     0,     0,     0,     0,
-       0,     0,   187,     0,     0,   188,     0,     0,     0,     0,
-     152,   153,     0,   204,     0,   154,   155,   156,   157,     0,
-       0,     0,     0,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   924,     0,     0,     0,     0,     0,     0,   132,
+       0,     0,     0,     0,   161,     0,     0,   133,   134,     0,
+       0,   162,     0,     0,     0,     0,     0,   163,   164,     0,
+       0,   135,   136,   165,     0,     0,     0,   137,   138,   139,
+     140,   141,   166,   167,     0,   168,   169,     0,     0,   170,
+     171,   172,   142,   143,   144,   145,   146,   147,   148,     0,
+     149,   150,   151,     0,     0,   152,   153,   154,     0,   155,
+     156,   157,   158,   159,     0,   160,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   472,     0,     0,     0,     0,     0,   132,     0,
+       0,     0,     0,   161,     0,     0,   133,   134,   473,     0,
+     162,     0,     0,     0,     0,     0,   163,   164,     0,     0,
+     135,   136,   165,     0,     0,     0,   137,   138,   139,   140,
+     141,   166,   167,     0,   168,   169,     0,     0,   170,   171,
+     172,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,     0,     0,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,   632,     0,     0,     0,     0,     0,   132,     0,     0,
+       0,     0,   161,     0,     0,   133,   134,     0,   633,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,   135,
+     136,   165,     0,     0,     0,   137,   138,   139,   140,   141,
+     166,   167,     0,   168,   169,     0,     0,   170,   171,   172,
+     142,   143,   144,   145,   146,   147,   148,     0,   149,   150,
+     151,     0,     0,   152,   153,   154,     0,   155,   156,   157,
+     158,   159,     0,   160,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     721,     0,     0,     0,     0,     0,   132,     0,     0,     0,
+       0,   161,     0,     0,   133,   134,   473,     0,   162,     0,
+       0,     0,     0,     0,   163,   164,     0,     0,   135,   136,
+     165,     0,     0,     0,   137,   138,   139,   140,   141,   166,
+     167,     0,   168,   169,     0,     0,   170,   171,   172,   142,
+     143,   144,   145,   146,   147,   148,     0,   149,   150,   151,
+       0,     0,   152,   153,   154,     0,   155,   156,   157,   158,
+     159,     0,   160,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   615,
+       0,     0,     0,     0,     0,   132,     0,     0,     0,     0,
+     161,     0,     0,   133,   134,     0,     0,   162,     0,     0,
+       0,     0,     0,   163,   164,     0,     0,   135,   136,   165,
+       0,     0,     0,   137,   138,   139,   140,   141,   166,   167,
+       0,   168,   169,     0,     0,   170,   171,   172,   142,   143,
+     144,   145,   146,   147,   148,     0,   149,   150,   151,     0,
+       0,   152,   153,   154,     0,   155,   156,   157,   158,   159,
+       0,   160,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   637,     0,
+       0,     0,     0,     0,   132,     0,     0,     0,     0,   161,
+       0,     0,   133,   134,     0,     0,   162,     0,     0,     0,
+       0,     0,   163,   164,     0,     0,   135,   136,   165,     0,
+       0,     0,   137,   138,   139,   140,   141,   166,   167,     0,
+     168,   169,     0,     0,   170,   171,   172,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   639,     0,     0,
+       0,     0,     0,   132,     0,     0,     0,     0,   161,     0,
+       0,   133,   134,     0,     0,   162,     0,     0,     0,     0,
+       0,   163,   164,     0,     0,   135,   136,   165,     0,     0,
+       0,   137,   138,   139,   140,   141,   166,   167,     0,   168,
+     169,     0,     0,   170,   171,   172,   142,   143,   144,   145,
+     146,   147,   148,     0,   149,   150,   151,     0,     0,   152,
+     153,   154,     0,   155,   156,   157,   158,   159,     0,   160,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,   894,     0,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
+       0,     0,   132,     0,     0,     0,     0,   161,     0,     0,
+     133,   134,     0,     0,   162,     0,     0,     0,     0,     0,
+     163,   164,     0,     0,   135,   136,   165,     0,     0,     0,
+     137,   138,   139,   140,   141,   166,   167,     0,   168,   169,
+       0,     0,   170,   171,   172,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   161,     0,     0,     0,
+       0,     0,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,     0,     0,   165,     0,     0,     0,     0,
+       0,     0,     0,     0,   166,   167,   132,   168,   169,     0,
+       0,   170,   171,   172,   133,   134,   660,   173,   661,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   135,   136,
+       0,     0,     0,     0,   137,   138,   139,   140,   141,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   142,
+     143,   144,   145,   146,   147,   148,     0,   149,   150,   151,
+       0,     0,   152,   153,   154,     0,   155,   156,   157,   158,
+     159,     0,   160,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,   531,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-     532,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   132,     0,     0,     0,     0,
+     161,     0,     0,   133,   134,   473,     0,   162,     0,     0,
+       0,     0,     0,   163,   164,     0,     0,   135,   136,   165,
+       0,     0,     0,   137,   138,   139,   140,   141,   166,   167,
+       0,   168,   169,     0,     0,   170,   171,   662,   142,   143,
+     144,   145,   146,   147,   148,     0,   149,   150,   151,     0,
+       0,   152,   153,   154,     0,   155,   156,   157,   158,   159,
+       0,   160,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   132,     0,     0,     0,     0,   161,
+       0,     0,   133,   134,   548,     0,   162,     0,     0,     0,
+       0,     0,   163,   164,     0,     0,   135,   136,   165,     0,
+       0,     0,   137,   138,   139,   140,   141,   166,   167,     0,
+     168,   169,     0,     0,   526,   171,   172,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   132,     0,     0,     0,     0,   161,     0,
+       0,   133,   134,   473,     0,   162,     0,     0,     0,     0,
+       0,   163,   164,     0,     0,   135,   136,   165,     0,     0,
+       0,   137,   138,   139,   140,   141,   166,   167,     0,   168,
+     169,     0,     0,   170,   171,   172,   142,   143,   144,   145,
+     146,   147,   148,     0,   149,   150,   151,     0,     0,   152,
+     153,   154,     0,   155,   156,   157,   158,   159,     0,   160,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-     650,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,     0,   651,
-       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
+       0,     0,   132,     0,     0,     0,     0,   161,     0,     0,
+     133,   134,   726,     0,   162,     0,     0,     0,     0,     0,
+     163,   164,     0,     0,   135,   136,   165,     0,     0,     0,
+     137,   138,   139,   140,   141,   166,   167,     0,   168,   169,
+       0,     0,   170,   171,   172,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,   728,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,   532,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   188,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   161,     0,     0,     0,
+       0,     0,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,   132,     0,     0,   165,     0,     0,     0,     0,
+     133,   134,     0,     0,   166,   167,     0,   168,   169,     0,
+       0,   170,   171,   172,   135,   136,     9,     0,     0,     0,
+     137,   138,   139,   140,   141,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,   633,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,    91,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,   132,     0,     0,     0,     0,   161,     0,     0,   133,
+     134,   703,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,   135,   136,   165,     0,     0,     0,   137,
+     138,   139,   140,   141,   166,   167,     0,   168,   169,     0,
+       0,   170,   171,   172,   142,   143,   144,   145,   146,   147,
+     148,     0,   149,   150,   151,     0,     0,   152,   153,   154,
+       0,   155,   156,   157,   158,   159,     0,   160,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,     0,   655,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
+     132,     0,     0,     0,     0,   161,     0,     0,   133,   134,
+    1011,     0,   162,     0,     0,     0,     0,     0,   163,   164,
+       0,     0,   135,   136,   165,     0,     0,     0,   137,   138,
+     139,   140,   141,   166,   167,     0,   168,   169,     0,     0,
+     170,   171,   172,   142,   143,   144,   145,   146,   147,   148,
+       0,   149,   150,   151,     0,     0,   152,   153,   154,     0,
+     155,   156,   157,   158,   159,     0,   160,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   132,
+       0,     0,     0,     0,   161,     0,     0,   133,   134,     0,
+       0,   162,     0,     0,     0,     0,     0,   163,   164,     0,
+       0,   135,   136,   165,     0,     0,     0,   137,   138,   139,
+     140,   141,   166,   167,     0,   168,   169,     0,     0,   170,
+     171,   172,   142,   143,   144,   145,   146,   147,   148,     0,
+     149,   150,   151,     0,     0,   152,   153,   154,     0,   155,
+     156,   157,   158,   159,     0,   160,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   132,     0,
+       0,     0,     0,   161,     0,     0,   133,   134,     0,     0,
+     162,     0,     0,     0,     0,     0,   163,   164,     0,     0,
+     135,   136,   165,     0,     0,     0,   137,   138,   139,   140,
+     141,   166,   167,     0,   168,   169,     0,     0,   170,   171,
+     172,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,     0,     0,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   132,     0,     0,
+       0,     0,   161,     0,     0,   133,   134,     0,     0,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,   135,
+     136,   165,     0,     0,     0,   137,   138,   139,   140,   141,
+     166,   167,     0,   168,   169,     0,     0,   170,   171,   363,
+     142,   143,   144,   145,   146,   147,   148,     0,   149,   150,
+     151,     0,     0,   152,   153,   154,     0,   155,   156,   157,
+     158,   159,     0,   160,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   132,     0,     0,     0,
+       0,   161,     0,     0,   133,   134,     0,     0,   162,     0,
+       0,     0,     0,     0,   163,   164,     0,     0,   135,   136,
+     165,     0,     0,     0,   137,   138,   139,   140,   141,   166,
+     167,     0,   168,   169,     0,     0,   170,   431,   172,   142,
+     143,   144,   145,   146,   147,   148,     0,   149,   150,   151,
+       0,     0,   152,   153,   154,     0,   155,   156,   157,   158,
+     159,     0,   160,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   132,     0,     0,     0,     0,
+     161,     0,     0,   133,   134,     0,     0,   162,     0,     0,
+       0,     0,     0,   163,   164,     0,     0,   135,   136,   165,
+       0,     0,     0,   137,   138,   139,   140,   141,   166,   167,
+       0,   168,   169,     0,     0,   170,   529,   530,   142,   143,
+     144,   145,   146,   147,   148,     0,   149,   150,   151,     0,
+       0,   152,   153,   154,     0,   155,   156,   157,   158,   159,
+       0,   160,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   132,     0,     0,     0,     0,   161,
+       0,     0,   133,   134,     0,     0,   162,     0,     0,     0,
+       0,     0,   163,   164,     0,     0,   135,   136,   165,     0,
+       0,     0,   137,   138,   139,   140,   141,   166,   167,     0,
+     168,   169,     0,     0,   918,   171,   363,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   161,     0,
+       0,     0,     0,     0,     0,   162,     0,     0,     0,     0,
+       0,   163,   164,     0,     0,     0,     0,   165,     0,     0,
+       0,     0,     0,     0,     0,     0,   166,   167,     0,   168,
+     169,     0,     0,   170,   171,   955,   311,   312,   422,     0,
+     423,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     135,   136,     0,     0,     0,     0,   137,   138,   139,   140,
+     141,     0,     0,   314,   315,   316,   317,   318,     0,   319,
+     320,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,     0,     0,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,     0,
+       0,   165,     0,     0,     0,     0,   311,   312,   313,     0,
+     166,   167,     0,   168,   169,     0,     0,   321,   171,   424,
+     135,   136,     0,     0,     0,     0,   137,   138,   139,   140,
+     141,     0,     0,   314,   315,   316,   317,   318,     0,   319,
+     320,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,   311,   312,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,   135,   136,     0,     0,
+       0,     0,   137,   138,   139,   140,   141,     0,     0,   314,
+     315,   316,   317,   318,     0,   319,   320,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,     0,
+       0,   165,     0,     0,     0,     0,     0,     0,     0,     0,
+     166,   167,     0,   168,   169,     0,     0,   321,   171,   322,
+       0,     0,     0,     0,     0,     0,     5,     0,     0,     6,
+       0,     7,     0,     8,     0,   162,     9,     0,     0,     0,
+       0,   163,   164,     0,     0,     0,    10,   165,     0,     0,
+       0,     0,     0,     0,     0,     0,   166,   167,     0,   168,
+     169,     0,    11,   321,   171,   424,    12,    13,     0,     0,
+       0,    14,     0,     0,     0,     0,     0,    15,     0,    16,
+      17,     0,    18,     0,     0,     0,     0,    19,    20,    21,
+      22,    23,     0,    24,    25,     0,     0,    26,    27,    28,
+      29,    30,    31,    32,    33,    34,    35,    36,     0,    37,
+       0,    38,    39,     0,     0,    40,    41,    42,     0,    43,
+       0,    44,     0,     0,    45,    46,     0,     0,    47,    48,
+      49,     0,     0,     0,     0,     0,     0,     0,    50,     0,
+       0,     0,    52,    53,    54,    55,    56,    57,    58,    59,
+      60,    61,    62,    63,     0,     0,    64,     0,     0,    65,
+      66,    67,    68,     5,     0,     0,     6,   487,     7,     0,
+       8,     0,     0,     9,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,    10,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,    11,
+       0,     0,     0,    12,    13,     0,     0,     0,    14,     0,
+       0,     0,     0,     0,    15,     0,    16,    17,     0,    18,
+       0,     0,     0,     0,    19,    20,    21,    22,    23,     0,
+      24,    25,     0,     0,    26,    27,    28,    29,    30,    31,
+      32,    33,    34,    35,    36,     0,    37,     0,    38,    39,
+       0,     0,    40,    41,    42,     0,    43,     0,    44,     0,
+       0,    45,    46,     0,     0,    47,    48,    49,     0,     0,
+       0,     0,     0,     0,     0,    50,     0,     0,     0,    52,
+      53,    54,    55,    56,    57,    58,    59,    60,    61,    62,
+      63,     8,     0,    64,     9,     0,    65,    66,    67,    68,
+       0,     0,     0,     0,    10,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,   657,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-       0,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
+      11,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,    15,     0,     0,     0,     0,
+      18,     0,   746,     0,     0,    19,    20,    21,    22,    23,
+       0,     0,    25,     0,     0,    26,    27,    28,    29,    30,
+      31,    32,    33,    34,    35,     0,     0,     8,     0,     0,
+       9,     0,     0,     0,    41,     0,     0,     0,     0,    44,
+      10,     0,     0,     0,     0,     0,    47,     0,    49,     0,
+       0,     0,     0,     0,     0,     0,    11,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,    59,    60,    61,
+      62,    15,     0,     0,     0,     0,    18,     0,     0,    67,
+      68,    19,    20,    21,    22,    23,     0,     0,    25,     0,
+       0,    26,    27,    28,    29,    30,    31,    32,    33,    34,
+      35,     0,     0,     0,     0,     0,   825,     0,     0,     0,
+      41,     0,     0,     0,     0,    44,     0,     0,     0,     0,
+       0,     0,    47,     0,    49,     0,     0,     0,     0,     0,
+       0,     0,    11,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,    59,    60,    61,    62,    15,     0,     0,
+       0,     0,    18,   826,     0,    67,    68,    19,    20,   827,
+       0,    23,     0,     0,    25,     0,     0,    26,    27,    28,
+      29,    30,    31,    32,    33,    34,    35,     0,     0,     0,
+       0,     0,   825,     0,     0,     0,    41,     0,     0,     0,
+       0,    44,     0,     0,     0,     0,     0,     0,    47,     0,
+      49,     0,     0,     0,     0,     0,     0,     0,    11,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,    59,
+      60,    61,    62,    15,     0,     0,     0,     0,    18,     0,
+       0,   170,    68,    19,    20,   827,     0,    23,     0,     0,
+      25,     0,     0,    26,    27,    28,    29,    30,    31,    32,
+      33,    34,    35,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,    41,     0,     0,     0,     0,    44,     0,     0,
+       0,     0,     0,     0,    47,     0,    49,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,   746,     0,
-     747,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,   532,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   748,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,   557,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,   538,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,     0,     0,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,   532,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,     0,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-     733,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,   709,     0,
-       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,   954,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   188,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,    91,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,     0,     0,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,     0,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-       0,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   381,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,     0,     0,
-       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   444,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,     0,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   541,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,   888,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   381,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,   329,   330,   562,     0,   563,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   152,
-     153,     0,     0,     0,   154,   155,   156,   157,     0,     0,
-     332,   333,   334,     0,     0,   335,   158,   159,   160,   161,
-     162,   163,   164,     0,   165,   166,   167,     0,     0,   168,
-     169,   170,   177,   171,   172,   173,   174,   175,     0,   176,
-       0,     0,     0,   178,   179,     0,     0,     0,     0,   180,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,     0,     0,
-      91,     0,     0,     0,     0,     0,     0,   187,     0,     0,
-     917,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   178,   179,     0,     0,     0,     0,   180,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   181,   182,
-       0,     0,   183,   184,   185,   186,   329,   330,   331,   336,
-       0,     0,     0,     0,     0,     0,   187,     0,     0,   564,
-       0,     0,     0,     0,   152,   153,     0,     0,     0,   154,
-     155,   156,   157,     0,     0,   332,   333,   334,     0,     0,
-     335,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,   329,   330,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-     152,   153,     0,     0,     0,   154,   155,   156,   157,     0,
-       0,   332,   333,   334,     0,     0,   335,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   178,   179,     0,
-       0,     0,     0,   180,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,     0,     0,   336,     0,     0,     0,     0,     0,
-       0,   187,     0,    19,   337,     0,    20,   -28,    21,   -28,
-       0,     0,    22,   178,   179,    23,    24,    25,     0,   180,
-       0,     0,    26,    27,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,    28,     0,     0,
-     336,    29,    30,     0,     0,     0,    31,   187,     0,     0,
-     564,     0,    32,     0,    33,    34,     0,    35,     0,    36,
-      37,    38,    39,    40,     0,    41,    42,    43,    44,    45,
-      46,    47,    48,    49,    50,    51,    52,    53,    54,    55,
-      56,     0,     0,    57,    58,    59,     0,    60,    61,    62,
-       0,    63,    64,    65,     0,     0,    66,     0,    67,     0,
-       0,    68,    69,    70,    71,     0,     0,    72,    73,    74,
-       0,     0,     0,     0,     0,    75,     0,     0,     0,    76,
-      77,    78,    79,    80,    81,    82,     0,    83,    84,    85,
-      86,    87,     0,     0,    88,     0,     0,     0,     0,   152,
-     153,    89,    90,    91,   154,   155,   156,   157,     0,     0,
-      92,     0,     0,     0,     0,     0,   158,   159,   160,   161,
-     162,   163,   164,     0,   165,   166,   167,     0,     0,   168,
-     169,   170,     0,   171,   172,   173,   174,   175,     0,   176,
-     152,   153,     0,     0,     0,   154,   155,   156,   157,     0,
-       0,     0,     0,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   178,   179,     0,     0,     0,     0,   180,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   181,   182,
-       0,     0,   183,   184,   185,   186,     0,     0,     0,    91,
-       0,     0,     0,     0,     0,     0,   187,     0,     0,   576,
-       0,     0,     0,   178,   179,     0,     0,     0,     0,   180,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,     0,     0,
-     888,     0,     0,     0,     0,     0,     0,   187,     0,     0,
-     576
+       0,     0,     0,     0,     0,    59,    60,    61,    62,     0,
+       0,     0,     0,     0,     0,     0,     0,   170,    68
 };
+
+#define yypact_value_is_default(Yystate) \
+  (!!((Yystate) == (-845)))
+
+#define yytable_value_is_error(Yytable_value) \
+  (!!((Yytable_value) == (-542)))
 
 static const yytype_int16 yycheck[] =
 {
-      26,   177,    28,   200,   140,    35,    32,   297,    13,    35,
-     274,   177,   188,   289,   278,    41,   414,   716,    46,   499,
-     105,   327,   107,   231,    18,   579,   111,   231,   582,     5,
-       3,   337,   236,   449,   236,    34,     3,   140,     4,     3,
-     346,   177,    70,    71,     4,    24,     3,     4,     3,    23,
-      78,     3,    23,     3,    31,   381,    61,   123,   234,   489,
-      59,    60,   494,   729,    33,     3,    35,   499,   103,     5,
-     140,    21,    22,    23,     3,     3,   125,   112,     3,   177,
-     577,   344,   579,   793,   794,   582,   759,     3,     3,     3,
-      23,     3,     3,     3,     3,     4,   124,   527,   126,   127,
-       3,     3,     3,    23,   130,   169,   169,   137,     3,     3,
-       3,   137,     3,     3,     3,   179,    23,    20,   169,   169,
-     169,    24,   148,   149,   187,   158,    35,    97,   231,    99,
-     169,   157,   179,   236,    21,    22,    23,   187,   143,    20,
-      21,    22,    23,    24,    25,   171,   179,     3,    23,   217,
-     126,   177,     3,    25,   169,   179,    23,    24,    25,    20,
-     123,   176,   188,    24,   863,   189,   192,     5,    24,    20,
-     238,   347,   882,    24,   137,    20,    20,   203,   179,    24,
-      24,   347,   286,   176,   210,    20,   179,   272,   189,    24,
-     126,   327,   169,   219,   260,   169,    80,    81,   224,   865,
-     179,   337,   207,     4,   308,   381,   342,   180,   234,   882,
-     346,   347,   156,   189,   158,   381,   180,   188,   244,   127,
-     187,   187,   921,   180,   327,   180,   231,   187,   180,   234,
-     315,   236,   237,   179,   337,   169,   169,   242,   188,   342,
-     275,   531,   180,   346,    27,   381,   281,   180,   538,   179,
-     285,   180,   180,   258,   158,   180,   255,   327,   564,   179,
-     757,   758,   169,   760,   180,   180,   180,   337,   180,   180,
-     180,   297,   342,   180,   279,   301,   346,   303,   180,   180,
-     586,   587,   588,   589,   590,   180,   180,   180,   126,   180,
-     180,   180,   318,   319,   179,   265,   179,   323,   169,   180,
-     626,   188,   628,   629,   179,   568,   332,   333,   334,   335,
-     413,   316,   575,   185,   186,   320,   179,   311,   185,   186,
-     179,   347,   327,   427,   169,   169,   261,   262,   591,   883,
-     179,   180,   337,   359,   169,    21,    22,   363,   364,   365,
-     366,   367,   368,   369,   370,   371,   372,   373,   374,   179,
-     576,   767,   768,   169,   179,   381,   169,   837,   584,   294,
-     176,     3,     4,   179,   844,   541,   392,   393,   394,   395,
-     396,   397,   398,   399,   400,   401,   402,   403,   404,   405,
-     406,   407,   408,   409,   410,   593,   883,     3,   414,   593,
-     594,   176,   594,     3,   179,    23,   422,   423,     3,   838,
-     839,   840,   841,   507,   508,   837,   838,   839,   840,   841,
-     808,   515,   844,   357,   358,    20,   501,   140,   141,    24,
-       4,   506,   169,   176,   509,   138,   139,   140,   564,    23,
-      24,    25,   376,   377,   378,   379,   380,     3,   728,   936,
-     576,   717,   546,   707,   750,   389,   179,   169,   584,   179,
-     586,   587,   588,   589,   590,   179,   632,   485,   179,   179,
-     626,   564,   628,   629,   179,   491,   792,   793,   794,   495,
-     179,   179,   676,   576,   676,   179,   502,   681,   179,   681,
-     179,   584,   745,   586,   587,   588,   589,   590,   179,   179,
-     593,   594,   179,   189,   564,   179,   179,   179,   179,   762,
-     763,   764,   765,   766,   179,   531,   576,   179,   179,   179,
-     179,   537,   538,   179,   584,   541,   586,   587,   588,   589,
-     590,   179,   179,   169,     5,   169,     7,     8,     9,    10,
-      11,     3,    13,    14,    15,    16,    17,    18,     4,   565,
-      21,    22,    23,    24,    25,   169,   169,     3,   574,     3,
-      20,    21,    22,    23,    24,    25,    20,    21,    22,    23,
-      24,    25,     5,   169,     3,   595,   169,   179,   169,   595,
-     596,   169,   748,   676,     3,     3,   169,   867,   681,     4,
-      11,   180,    13,    14,    15,    16,    17,    18,   593,   594,
-      21,    22,    23,    24,    25,    21,    22,    23,    24,    25,
-     626,   176,   628,   629,     3,   176,   632,   633,    20,    21,
-      22,    23,    24,    25,   750,     5,   792,   814,   881,     3,
-     179,   725,   179,   759,   650,   651,   792,   793,   794,   655,
-     700,   657,   132,     3,     3,   661,     3,   741,    20,    21,
-      22,    23,    24,    25,     3,   749,   189,   750,   674,   675,
-       3,   180,   180,     3,     3,   179,   759,   169,    24,   179,
-     169,   687,   667,   689,   169,   179,   169,   180,     3,   180,
-     878,   676,     5,   180,   176,     3,   681,     3,   683,    25,
-     750,     3,   708,    13,    14,    15,    16,    17,    18,   759,
-       3,    21,    22,    23,    24,    25,     3,   180,   179,     4,
-     180,   169,   728,    84,   185,   186,   180,   180,   189,   714,
-     180,    30,   816,    24,   740,    24,   180,   179,   744,     9,
-      10,    11,   748,    13,    14,    15,    16,    17,    18,    24,
-      23,    21,    22,    23,    24,    25,     4,   169,   180,   169,
-     180,   917,     4,   126,     3,   750,   882,    20,     3,     5,
-     169,   169,     5,   180,   185,   186,   179,     3,   862,   180,
-     180,    24,    29,   180,   180,   180,   792,   793,   794,   873,
-     180,   180,   180,     3,   188,   126,   180,   180,   169,   882,
-     169,   258,   808,   809,    10,     3,    14,     5,   906,     7,
-       8,     9,    10,    11,   904,    13,    14,    15,    16,    17,
-      18,   428,   528,    21,    22,    23,    24,    25,   685,   689,
-     498,   511,   882,    80,    81,    82,   268,   493,   537,   304,
-     416,   721,   848,   848,   850,    76,   852,    13,    14,    15,
-      16,    17,    18,   850,   675,    21,    22,    23,    24,    25,
-     897,   867,   109,   748,   111,   112,   113,   955,   871,   116,
-     117,   143,   119,   120,   959,   185,   186,   555,   142,   143,
-     140,   347,   744,   381,   750,   557,   593,    -1,   894,   594,
-     896,   897,    -1,   878,   158,   159,    -1,    -1,   162,   163,
+      11,   295,     1,   185,    15,   101,   219,    18,   104,   240,
+     394,   577,   108,   395,   277,   111,    54,   161,   482,   477,
+     205,   536,   536,   653,   482,     5,   264,   124,   172,    79,
+     268,    81,    82,   161,     3,     3,    86,     3,   274,   710,
+      39,     3,   564,   565,     1,     3,   124,    17,   719,    75,
+      76,     3,    51,    80,   124,   291,   563,   564,   565,     3,
+      87,    19,    20,    21,     3,    31,   722,    37,    38,   768,
+     214,     3,     3,   217,   214,   113,   363,   115,   116,   329,
+      24,    21,     3,   161,   747,   124,   214,    21,     5,     6,
+       7,     8,     9,    10,    51,    12,    13,    14,    15,    16,
+      17,   127,    19,    20,    21,    22,    23,    27,     3,     3,
+      22,   122,     3,     3,     3,   212,   213,   904,     3,   130,
+     131,   132,   219,    21,     3,   112,     3,    45,     3,    44,
+     141,   153,   976,     3,    24,   213,   214,    18,     3,     3,
+     121,    22,   122,   213,   155,   101,    24,   131,   245,    24,
+     161,   198,     3,     3,     3,     3,     3,     3,     3,    24,
+       3,   172,    19,    20,    21,   131,   177,   131,   404,    91,
+      88,    89,   119,   891,   221,   162,  1020,    18,   428,   160,
+     191,    22,   166,   130,    21,    21,    22,    23,   168,   188,
+     201,   202,   107,   115,   160,   140,   246,   142,   166,   168,
+     987,   163,   166,   214,   160,   160,   217,   206,    23,   167,
+     881,   163,   157,   931,   213,   914,   227,   161,   217,   363,
+     160,   220,   166,   363,   163,   322,   225,   253,   884,   240,
+     327,   163,   163,   167,   331,   363,     5,   900,   265,    24,
+     160,   472,   163,   270,   322,   162,   273,   164,   165,   327,
+     162,   168,   322,   331,   131,   254,   162,   327,   765,   766,
+     767,   331,   140,    21,   162,   501,   502,   237,   163,   163,
+     269,   161,   163,   509,   163,   286,   166,   288,   163,   160,
+      21,     3,    24,   322,   163,   363,   161,   523,   166,   300,
+     301,   166,   331,   163,   305,   526,   161,   254,   534,   163,
+     485,   166,    44,   314,   315,   316,   317,   318,   319,   320,
+     167,   561,   163,   163,   163,   163,   163,   163,   163,   160,
+     163,   608,   609,   322,   611,   162,   576,   424,   164,   165,
+     341,   796,   797,   798,   345,   346,   347,   348,   349,   350,
+     351,   352,   353,   354,   355,   356,   424,    18,   162,   164,
+     165,    22,   363,   122,   424,    18,    19,    20,    21,    22,
+      23,   162,   373,   374,   375,   376,   377,   378,   379,   380,
+     381,   382,   383,   384,   385,   386,   387,   388,   389,   390,
+     391,   166,   846,    18,   395,   424,   530,     3,   846,   847,
+     848,   849,   850,   915,   339,   340,   490,   160,   140,   162,
+     162,     3,   160,  1033,   126,   163,    22,   133,   915,   659,
+     133,   255,   256,   358,   425,   360,   361,   362,   162,   160,
+      94,    95,   163,   153,   166,   370,   520,   663,   133,    31,
+     162,   813,   162,   471,   160,   161,   562,   160,   282,     3,
+     160,    78,    79,   569,   657,   495,   166,   543,   711,   914,
+     500,   160,   836,   503,    18,   160,   669,   166,    22,   160,
+      18,   472,   756,   701,    22,   562,  1032,   478,   162,    29,
+     614,    31,   569,   162,   571,   572,   573,   574,   575,   160,
+     491,   162,   718,   990,   562,   496,   160,   122,   131,   160,
+     721,   569,   562,   571,   572,   573,   574,   575,     3,   569,
+     163,   571,   572,   573,   574,   575,  1021,  1021,   693,   796,
+     797,   798,   162,    18,   525,   526,   162,    22,   662,   530,
+     770,   771,   772,   773,   774,   536,     3,  1042,  1042,   131,
+     161,   162,   571,   572,   573,   574,   575,    83,   537,    85,
+     539,    18,  1006,   123,   641,    22,   160,   546,  1006,   560,
+       8,     9,    10,     4,    12,    13,    14,    15,    16,    17,
+     657,    19,    20,    21,    22,    23,   577,   664,   579,   160,
+     161,   162,   669,    18,    19,    20,    21,    22,    23,    18,
+      19,    20,    21,    22,    23,   821,   664,    24,    41,    19,
+      20,    21,    22,    23,   664,   161,   162,   608,   609,   166,
+     611,   162,   163,   614,   615,   847,   848,   849,   850,   903,
+     134,   135,   136,   683,    21,    22,    23,    19,    20,    83,
+      84,   632,   633,    37,    38,     3,   637,     3,   639,   123,
+     124,   160,   643,     3,   162,   162,   162,   819,   168,   162,
+     162,   652,   738,   654,   740,   656,   162,   646,   162,   162,
+     162,   662,   796,   749,   653,   886,   162,     3,   162,   162,
+     162,   162,   162,   162,   675,   664,   677,   162,     3,   162,
+     162,   768,   671,   162,   162,   162,   912,   162,   162,   132,
+     691,   692,   160,     3,   160,   138,   139,   160,   982,   163,
+     768,   702,     5,   160,     3,   160,   162,   160,   768,   160,
+     153,   154,     3,   156,   157,   160,   164,   165,   161,   708,
+     721,     5,     6,     7,     8,     9,    10,     3,    12,    13,
+      14,    15,    16,    17,   160,    19,    20,    21,    22,    23,
+       3,     5,   161,     3,     3,   163,     3,     3,   162,    22,
+     751,     5,     3,     3,   163,   163,     3,     3,   163,   760,
+     162,   160,   988,     3,   160,   163,     3,   162,     5,     6,
+       7,     8,     9,    10,   162,    12,    13,    14,    15,    16,
+      17,   162,    19,    20,    21,    22,    23,   162,   160,   163,
+     161,     3,     3,    23,     3,   796,   797,   798,     3,     3,
+     163,     4,   163,    22,   163,   163,   160,   893,    22,   162,
+      26,    21,   813,   814,   163,   160,   902,   163,     4,    36,
+     122,   955,     3,   160,   162,   160,    10,   914,    12,    13,
+      14,    15,    16,    17,   160,    19,    20,    21,    22,    23,
+     163,     3,   162,   162,     5,   163,   914,     5,   935,   163,
+     162,   160,   163,   160,   914,   160,     4,   163,     3,   163,
+      82,   122,   163,   163,     3,    22,   160,   868,   163,   870,
+     167,   872,   160,   160,   163,   168,    82,   163,   163,   160,
+     164,   165,    25,   160,   168,   886,   160,    22,   974,   160,
+     891,    51,   254,   950,   485,   948,   897,    12,    13,    14,
+      15,    16,    17,   904,    19,    20,    21,    22,    23,    12,
+      13,    14,    15,    16,    17,   673,    19,    20,    21,    22,
+      23,   677,   911,   924,   405,   926,   927,   164,   165,   481,
+     931,   932,   505,   934,   480,    78,    79,    80,   260,   525,
+     493,   289,   715,   944,    52,   868,   927,   397,   937,   959,
+     870,   662,   890,  1016,   955,   985,   541,   757,   937,   960,
+     961,   760,   664,   106,   435,   108,   109,   110,   124,    -1,
+     113,   114,    -1,   116,   117,    -1,    -1,     0,     1,    -1,
+     164,   165,    -1,    -1,   985,    -1,   987,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   983,   996,    -1,    -1,   999,    -1,
+      -1,    24,    25,    -1,    -1,    28,    29,    30,    31,    32,
+      -1,    -1,    35,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+    1021,    -1,    45,    -1,    -1,    -1,    -1,    -1,    -1,  1030,
+      -1,  1032,    -1,  1034,  1035,  1024,    -1,    -1,    61,    -1,
+      -1,  1042,    65,    66,  1033,    -1,    -1,    70,  1049,   164,
+     165,    -1,    -1,    76,    -1,    78,    79,    -1,    81,    -1,
+      -1,   164,   165,    86,    87,    88,    89,    90,    -1,    92,
+      93,    -1,    -1,    96,    97,    98,    99,   100,   101,   102,
+     103,   104,   105,   106,    -1,   108,    -1,   110,   111,    -1,
+      -1,   114,   115,   116,    -1,   118,    -1,   120,    -1,    -1,
+     123,   124,    -1,    -1,   127,   128,   129,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   137,    -1,    -1,   140,   141,   142,
+     143,   144,   145,   146,   147,   148,   149,   150,   151,   152,
+      -1,    -1,   155,    -1,    -1,   158,   159,   160,   161,    -1,
+      -1,    -1,     3,   166,     5,     6,     7,     8,     9,    10,
+      -1,    12,    13,    14,    15,    16,    17,    -1,    19,    20,
+      21,    22,    23,     3,    -1,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,     3,    -1,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,     3,    -1,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     3,    -1,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     4,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     4,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    33,    34,    -1,    -1,    -1,    -1,    39,    40,
+      41,    42,    43,   164,   165,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    54,    55,    56,    57,    58,    59,    60,
+      -1,    62,    63,    64,   164,   165,    67,    68,    69,    -1,
+      71,    72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   164,   165,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,   164,   165,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,   164,   165,    -1,
+      -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,
+      -1,    -1,    -1,   144,    -1,    -1,   163,   164,   165,    -1,
+      -1,    -1,   153,   154,    -1,   156,   157,    -1,    -1,   160,
+     161,   162,    -1,    -1,    -1,    -1,    -1,   164,   165,     4,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     4,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     4,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,   164,
+     165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   164,
+     165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   164,
+     165,     5,     6,     7,     8,     9,    10,    -1,    12,    13,
+      14,    15,    16,    17,    -1,    19,    20,    21,    22,    23,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,    -1,    -1,    -1,    -1,   163,
      164,   165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   917,   176,    -1,    -1,   185,   186,   902,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   931,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   939,    -1,    -1,    -1,    -1,    -1,   945,
-      -1,    -1,   948,     0,     1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   964,    -1,
-      -1,    -1,    -1,   969,   970,    -1,    -1,   973,   974,    -1,
-      27,    -1,    29,    -1,   980,    32,    33,    34,    35,    36,
-      37,    38,    -1,    -1,    41,    42,    43,   185,   186,    -1,
-      -1,    48,    49,    -1,    -1,    -1,    53,    54,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    63,    -1,    -1,    -1,
-      67,    68,    -1,    -1,    -1,    72,    -1,    -1,    -1,   185,
-     186,    78,    -1,    80,    81,    -1,    83,    -1,    85,    86,
-      87,    88,    89,    -1,    91,    92,    93,    94,    95,    96,
-      97,    98,    99,   100,   101,   102,   103,   104,   105,   106,
-      -1,    -1,   109,   110,   111,    -1,   113,   114,   115,    -1,
-     117,   118,   119,    -1,    -1,   122,    -1,   124,    -1,    -1,
-     127,   128,   129,   130,    -1,    -1,   133,   134,   135,    -1,
-      -1,    -1,    -1,    -1,   141,    -1,    -1,   144,   145,   146,
-     147,   148,   149,   150,   151,    -1,   153,   154,   155,   156,
-     157,    -1,    -1,   160,    -1,    -1,    -1,    -1,    -1,    -1,
-     167,   168,   169,    -1,    -1,    -1,    -1,    -1,    -1,   176,
-     177,     3,    -1,     5,    -1,     7,     8,     9,    10,    11,
-     187,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,    40,    -1,
-      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
-      62,    -1,    64,    65,    66,    -1,    -1,    69,    70,    71,
-      -1,    73,    74,    75,    76,    77,     3,    79,     5,    -1,
-       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
-      17,    18,    -1,    -1,    21,    22,    23,    24,    25,     3,
-      -1,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
-      14,    15,    16,    17,    18,    -1,    -1,    21,    22,    23,
-      24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   163,   164,
+     165,     5,     6,     7,     8,     9,    10,    -1,    12,    13,
+      14,    15,    16,    17,    -1,    19,    20,    21,    22,    23,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,    -1,    -1,
+      -1,    -1,    -1,    -1,    33,    34,    -1,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,    -1,   163,   164,   165,    -1,
+      -1,    -1,    -1,    -1,    -1,    54,    55,    56,    57,    58,
+      59,    60,   160,    62,    63,    64,   164,   165,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,    -1,    -1,    -1,    -1,   163,
+     164,   165,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    -1,    -1,   144,    -1,    -1,   163,   164,
+     165,    -1,    -1,    -1,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    -1,    -1,    -1,   163,   164,   165,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     142,   143,    -1,    -1,    -1,    -1,   148,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,
-     162,   163,   164,   165,    -1,    -1,    -1,   169,    -1,    -1,
-      -1,    -1,    -1,    -1,   176,    -1,    -1,   179,    -1,    -1,
-      -1,    -1,    -1,   185,   186,     3,    -1,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,    -1,    -1,    21,    22,    23,    24,    25,     3,    -1,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,     3,    -1,     5,    -1,     7,     8,     9,    10,    11,
-      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,   185,   186,
-      -1,    -1,    -1,    -1,    -1,    -1,     4,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,   185,   186,    21,    22,    23,    24,    25,     4,     5,
-      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
-      16,    17,    18,    -1,    -1,    21,    22,    23,    24,    25,
-       4,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
-      14,    15,    16,    17,    18,    -1,    -1,    21,    22,    23,
-      24,    25,     4,     5,    -1,     7,     8,     9,    10,    11,
-      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   185,   186,    -1,
-      -1,    -1,    -1,    -1,    -1,     4,     5,    -1,     7,     8,
-       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
-     185,   186,    21,    22,    23,    24,    25,    -1,    -1,     5,
-      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
-      16,    17,    18,   185,   186,    21,    22,    23,    24,    25,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
-      -1,    -1,    -1,    -1,    -1,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,   185,
-     186,    21,    22,    23,    24,    25,    -1,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,   185,   186,    21,    22,    23,    24,    25,    -1,     5,
-      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
-      16,    17,    18,   185,   186,    21,    22,    23,    24,    25,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,   185,   186,    21,    22,
-      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,
-     186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
-     185,   186,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
-      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,    -1,    -1,    -1,    -1,   163,   164,
+     165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,
-     186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
-     185,   186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
-      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
-      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
-      -1,    21,    22,    23,    24,    25,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
-      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
-      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
-      -1,    21,    22,    23,    24,    25,     5,    -1,     7,     8,
-       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
-      -1,    -1,    21,    22,    23,    24,    25,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,    -1,    -1,    21,    22,    23,    24,    25,     5,    -1,
-       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
-      17,    18,    -1,    -1,    21,    22,    23,    24,    25,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,
-      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,   169,
-      -1,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
-      14,    15,    16,    17,    18,   185,   186,    21,    22,    23,
-      24,    25,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
-      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,   180,
-      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
+      -1,    -1,    -1,   163,   164,   165,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,     5,     6,     7,     8,     9,    10,
+      -1,    12,    13,    14,    15,    16,    17,    -1,    19,    20,
+      21,    22,    23,    -1,    -1,    -1,    -1,   163,   164,   165,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,
-      -1,   185,   186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
-      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
-      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
-      -1,    21,    22,    23,    24,    25,     5,    -1,     7,     8,
-       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
-      -1,    -1,    21,    22,    23,    24,    25,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,    -1,    -1,    21,    22,    23,    24,    25,     5,    -1,
-       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
-      17,    18,    -1,    -1,    21,    22,    23,    24,    25,    -1,
-      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
-     185,   186,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
-      23,    24,    25,     5,    -1,     7,     8,     9,    10,    11,
-      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    38,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,
-      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    63,    -1,    -1,    -1,    -1,    -1,
-     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    78,
-      -1,    -1,    -1,    -1,    83,    84,    -1,    -1,    -1,    88,
-      89,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,    98,
-      99,   100,   101,   102,   103,   104,   105,    -1,    -1,    -1,
-      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,   118,
-      -1,    -1,    -1,    -1,    -1,   124,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   180,   133,    -1,   135,    -1,   185,   186,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-     169,    -1,   185,   186,    -1,    -1,    -1,   176,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,
-      -1,    -1,    -1,   185,   186,     5,    -1,     7,     8,     9,
-      10,    11,     4,    13,    14,    15,    16,    17,    18,    -1,
-      12,    21,    22,    23,    24,    25,    -1,    -1,    -1,    21,
-      22,    23,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,    40,    -1,
-      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
-      62,    -1,    64,    65,    66,    -1,    -1,    69,    70,    71,
-      -1,    73,    74,    75,    76,    77,    -1,    79,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    40,    -1,
-      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
-      62,    -1,    64,    65,    66,   180,    -1,    69,    70,    71,
-     185,   186,    74,    75,    76,    77,    -1,    79,    -1,   131,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,
-     142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,
-     162,   163,   164,   165,    -1,    39,    40,   169,    -1,    -1,
-      44,    45,    46,    47,   176,   185,   186,   179,    -1,    -1,
-      -1,    -1,    56,    57,    58,    59,    60,    61,    62,    -1,
-      64,    65,    66,    -1,    -1,    69,    70,    71,    -1,    73,
-      74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   169,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   163,   164,   165,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   163,   164,   165,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,     4,    -1,   163,   164,   165,
+      -1,    -1,    11,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      19,    20,    21,    -1,    -1,    -1,   163,   164,   165,    -1,
+      -1,    -1,    -1,    -1,    33,    34,    -1,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,   163,   164,   165,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    34,    77,    -1,
+      -1,    -1,    39,    40,    -1,    42,    43,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,     4,    72,    73,    74,    75,    -1,
+      77,    11,    -1,    -1,   164,   165,   125,    -1,    -1,    19,
+      20,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,
+      40,    41,    42,    43,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    54,    55,    56,    57,    58,    59,
+      60,    -1,    62,    63,    64,    -1,    -1,    67,    68,    69,
+      -1,    71,    72,    73,    74,    75,    -1,    77,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   160,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,     4,    -1,    -1,    -1,    -1,    -1,    -1,
+      11,    -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,
+      -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,
+      -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,
+      41,    42,    43,   153,   154,    -1,   156,   157,    -1,    -1,
+     160,   161,   162,    54,    55,    56,    57,    58,    59,    60,
+      -1,    62,    63,    64,    -1,    -1,    67,    68,    69,    -1,
+      71,    72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   142,   143,
-      -1,    -1,    -1,    -1,   148,     4,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,   158,   159,    -1,    -1,   162,   163,
-     164,   165,    21,    22,    -1,   169,    -1,    -1,    -1,    -1,
-      -1,    -1,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,
-      39,    40,    -1,   187,    -1,    44,    45,    46,    47,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,     4,    -1,    -1,    -1,    -1,    -1,    -1,    11,
+      -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,    -1,
+      -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,
+      -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,    41,
+      42,    43,   153,   154,    -1,   156,   157,    -1,    -1,   160,
+     161,   162,    54,    55,    56,    57,    58,    59,    60,    -1,
+      62,    63,    64,    -1,    -1,    67,    68,    69,    -1,    71,
+      72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,     5,    -1,    -1,    -1,    -1,    -1,    11,    -1,
+      -1,    -1,    -1,   125,    -1,    -1,    19,    20,    21,    -1,
+     132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,
+      33,    34,   144,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,   153,   154,    -1,   156,   157,    -1,    -1,   160,   161,
+     162,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    -1,    -1,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,     5,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,
+      -1,    -1,   125,    -1,    -1,    19,    20,    -1,    22,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,
+      34,   144,    -1,    -1,    -1,    39,    40,    41,    42,    43,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      54,    55,    56,    57,    58,    59,    60,    -1,    62,    63,
+      64,    -1,    -1,    67,    68,    69,    -1,    71,    72,    73,
+      74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+       5,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,
+      -1,   125,    -1,    -1,    19,    20,    21,    -1,   132,    -1,
+      -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,
+     144,    -1,    -1,    -1,    39,    40,    41,    42,    43,   153,
+     154,    -1,   156,   157,    -1,    -1,   160,   161,   162,    54,
+      55,    56,    57,    58,    59,    60,    -1,    62,    63,    64,
+      -1,    -1,    67,    68,    69,    -1,    71,    72,    73,    74,
+      75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,     5,
+      -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,
+     125,    -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,
+      -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,
+      -1,    -1,    -1,    39,    40,    41,    42,    43,   153,   154,
+      -1,   156,   157,    -1,    -1,   160,   161,   162,    54,    55,
+      56,    57,    58,    59,    60,    -1,    62,    63,    64,    -1,
+      -1,    67,    68,    69,    -1,    71,    72,    73,    74,    75,
+      -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,     5,    -1,
+      -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,
+      -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,    -1,
+      -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,   153,   154,    -1,
+     156,   157,    -1,    -1,   160,   161,   162,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,     5,    -1,    -1,
+      -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,
+      -1,    19,    20,    -1,    -1,   132,    -1,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,
+      -1,    39,    40,    41,    42,    43,   153,   154,    -1,   156,
+     157,    -1,    -1,   160,   161,   162,    54,    55,    56,    57,
+      58,    59,    60,    -1,    62,    63,    64,    -1,    -1,    67,
+      68,    69,    -1,    71,    72,    73,    74,    75,    -1,    77,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,     4,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
+      -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,    -1,
+      19,    20,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,
+     138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,   153,   154,    -1,   156,   157,
+      -1,    -1,   160,   161,   162,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   125,    -1,    -1,    -1,
+      -1,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    -1,    -1,   144,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   153,   154,    11,   156,   157,    -1,
+      -1,   160,   161,   162,    19,    20,    21,   166,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    33,    34,
+      -1,    -1,    -1,    -1,    39,    40,    41,    42,    43,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    54,
+      55,    56,    57,    58,    59,    60,    -1,    62,    63,    64,
+      -1,    -1,    67,    68,    69,    -1,    71,    72,    73,    74,
+      75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,     5,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      23,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,
+     125,    -1,    -1,    19,    20,    21,    -1,   132,    -1,    -1,
+      -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,
+      -1,    -1,    -1,    39,    40,    41,    42,    43,   153,   154,
+      -1,   156,   157,    -1,    -1,   160,   161,   162,    54,    55,
+      56,    57,    58,    59,    60,    -1,    62,    63,    64,    -1,
+      -1,    67,    68,    69,    -1,    71,    72,    73,    74,    75,
+      -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,
+      -1,    -1,    19,    20,    21,    -1,   132,    -1,    -1,    -1,
+      -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,   153,   154,    -1,
+     156,   157,    -1,    -1,   160,   161,   162,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,
+      -1,    19,    20,    21,    -1,   132,    -1,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,
+      -1,    39,    40,    41,    42,    43,   153,   154,    -1,   156,
+     157,    -1,    -1,   160,   161,   162,    54,    55,    56,    57,
+      58,    59,    60,    -1,    62,    63,    64,    -1,    -1,    67,
+      68,    69,    -1,    71,    72,    73,    74,    75,    -1,    77,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-       5,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,    24,
-      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,    -1,
+      19,    20,    21,    -1,   132,    -1,    -1,    -1,    -1,    -1,
+     138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,   153,   154,    -1,   156,   157,
+      -1,    -1,   160,   161,   162,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,     5,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   125,    -1,    -1,    -1,
+      -1,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    11,    -1,    -1,   144,    -1,    -1,    -1,    -1,
+      19,    20,    -1,    -1,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    33,    34,    35,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,     5,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    11,    -1,    -1,    -1,    -1,   125,    -1,    -1,    19,
+      20,    21,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,
+      40,    41,    42,    43,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    54,    55,    56,    57,    58,    59,
+      60,    -1,    62,    63,    64,    -1,    -1,    67,    68,    69,
+      -1,    71,    72,    73,    74,    75,    -1,    77,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,    -1,     5,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
+      11,    -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,
+      21,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,
+      -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,
+      41,    42,    43,   153,   154,    -1,   156,   157,    -1,    -1,
+     160,   161,   162,    54,    55,    56,    57,    58,    59,    60,
+      -1,    62,    63,    64,    -1,    -1,    67,    68,    69,    -1,
+      71,    72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    11,
+      -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,    -1,
+      -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,
+      -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,    41,
+      42,    43,   153,   154,    -1,   156,   157,    -1,    -1,   160,
+     161,   162,    54,    55,    56,    57,    58,    59,    60,    -1,
+      62,    63,    64,    -1,    -1,    67,    68,    69,    -1,    71,
+      72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    11,    -1,
+      -1,    -1,    -1,   125,    -1,    -1,    19,    20,    -1,    -1,
+     132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,
+      33,    34,   144,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,   153,   154,    -1,   156,   157,    -1,    -1,   160,   161,
+     162,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    -1,    -1,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,
+      -1,    -1,   125,    -1,    -1,    19,    20,    -1,    -1,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,
+      34,   144,    -1,    -1,    -1,    39,    40,    41,    42,    43,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      54,    55,    56,    57,    58,    59,    60,    -1,    62,    63,
+      64,    -1,    -1,    67,    68,    69,    -1,    71,    72,    73,
+      74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,
+      -1,   125,    -1,    -1,    19,    20,    -1,    -1,   132,    -1,
+      -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,
+     144,    -1,    -1,    -1,    39,    40,    41,    42,    43,   153,
+     154,    -1,   156,   157,    -1,    -1,   160,   161,   162,    54,
+      55,    56,    57,    58,    59,    60,    -1,    62,    63,    64,
+      -1,    -1,    67,    68,    69,    -1,    71,    72,    73,    74,
+      75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,
+     125,    -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,
+      -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,
+      -1,    -1,    -1,    39,    40,    41,    42,    43,   153,   154,
+      -1,   156,   157,    -1,    -1,   160,   161,   162,    54,    55,
+      56,    57,    58,    59,    60,    -1,    62,    63,    64,    -1,
+      -1,    67,    68,    69,    -1,    71,    72,    73,    74,    75,
+      -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,
+      -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,    -1,
+      -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,   153,   154,    -1,
+     156,   157,    -1,    -1,   160,   161,   162,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   125,    -1,
+      -1,    -1,    -1,    -1,    -1,   132,    -1,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    -1,    -1,   144,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   153,   154,    -1,   156,
+     157,    -1,    -1,   160,   161,   162,    19,    20,    21,    -1,
+      23,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      33,    34,    -1,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,    -1,    -1,    46,    47,    48,    49,    50,    -1,    52,
+      53,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    -1,    -1,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    -1,
+      -1,   144,    -1,    -1,    -1,    -1,    19,    20,    21,    -1,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      33,    34,    -1,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,    -1,    -1,    46,    47,    48,    49,    50,    -1,    52,
+      53,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    19,    20,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    33,    34,    -1,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,    -1,    -1,    46,
+      47,    48,    49,    50,    -1,    52,    53,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    -1,
+      -1,   144,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      -1,    -1,    -1,    -1,    -1,    -1,    25,    -1,    -1,    28,
+      -1,    30,    -1,    32,    -1,   132,    35,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    -1,    45,   144,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   153,   154,    -1,   156,
+     157,    -1,    61,   160,   161,   162,    65,    66,    -1,    -1,
+      -1,    70,    -1,    -1,    -1,    -1,    -1,    76,    -1,    78,
+      79,    -1,    81,    -1,    -1,    -1,    -1,    86,    87,    88,
+      89,    90,    -1,    92,    93,    -1,    -1,    96,    97,    98,
+      99,   100,   101,   102,   103,   104,   105,   106,    -1,   108,
+      -1,   110,   111,    -1,    -1,   114,   115,   116,    -1,   118,
+      -1,   120,    -1,    -1,   123,   124,    -1,    -1,   127,   128,
+     129,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   137,    -1,
+      -1,    -1,   141,   142,   143,   144,   145,   146,   147,   148,
+     149,   150,   151,   152,    -1,    -1,   155,    -1,    -1,   158,
+     159,   160,   161,    25,    -1,    -1,    28,   166,    30,    -1,
+      32,    -1,    -1,    35,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    45,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    61,
+      -1,    -1,    -1,    65,    66,    -1,    -1,    -1,    70,    -1,
+      -1,    -1,    -1,    -1,    76,    -1,    78,    79,    -1,    81,
+      -1,    -1,    -1,    -1,    86,    87,    88,    89,    90,    -1,
+      92,    93,    -1,    -1,    96,    97,    98,    99,   100,   101,
+     102,   103,   104,   105,   106,    -1,   108,    -1,   110,   111,
+      -1,    -1,   114,   115,   116,    -1,   118,    -1,   120,    -1,
+      -1,   123,   124,    -1,    -1,   127,   128,   129,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   137,    -1,    -1,    -1,   141,
+     142,   143,   144,   145,   146,   147,   148,   149,   150,   151,
+     152,    32,    -1,   155,    35,    -1,   158,   159,   160,   161,
+      -1,    -1,    -1,    -1,    45,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,     5,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
+      61,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    76,    -1,    -1,    -1,    -1,
+      81,    -1,    83,    -1,    -1,    86,    87,    88,    89,    90,
+      -1,    -1,    93,    -1,    -1,    96,    97,    98,    99,   100,
+     101,   102,   103,   104,   105,    -1,    -1,    32,    -1,    -1,
+      35,    -1,    -1,    -1,   115,    -1,    -1,    -1,    -1,   120,
+      45,    -1,    -1,    -1,    -1,    -1,   127,    -1,   129,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    61,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   148,   149,   150,
+     151,    76,    -1,    -1,    -1,    -1,    81,    -1,    -1,   160,
+     161,    86,    87,    88,    89,    90,    -1,    -1,    93,    -1,
+      -1,    96,    97,    98,    99,   100,   101,   102,   103,   104,
+     105,    -1,    -1,    -1,    -1,    -1,    35,    -1,    -1,    -1,
+     115,    -1,    -1,    -1,    -1,   120,    -1,    -1,    -1,    -1,
+      -1,    -1,   127,    -1,   129,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    61,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   148,   149,   150,   151,    76,    -1,    -1,
+      -1,    -1,    81,    82,    -1,   160,   161,    86,    87,    88,
+      -1,    90,    -1,    -1,    93,    -1,    -1,    96,    97,    98,
+      99,   100,   101,   102,   103,   104,   105,    -1,    -1,    -1,
+      -1,    -1,    35,    -1,    -1,    -1,   115,    -1,    -1,    -1,
+      -1,   120,    -1,    -1,    -1,    -1,    -1,    -1,   127,    -1,
+     129,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    61,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   148,
+     149,   150,   151,    76,    -1,    -1,    -1,    -1,    81,    -1,
+      -1,   160,   161,    86,    87,    88,    -1,    90,    -1,    -1,
+      93,    -1,    -1,    96,    97,    98,    99,   100,   101,   102,
+     103,   104,   105,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   115,    -1,    -1,    -1,    -1,   120,    -1,    -1,
+      -1,    -1,    -1,    -1,   127,    -1,   129,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    23,    -1,
-      25,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    23,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    23,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      23,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    23,    -1,
-      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    21,    22,    23,    -1,    25,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,
-      40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,    -1,
-      50,    51,    52,    -1,    -1,    55,    56,    57,    58,    59,
-      60,    61,    62,    -1,    64,    65,    66,    -1,    -1,    69,
-      70,    71,   131,    73,    74,    75,    76,    77,    -1,    79,
-      -1,    -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,
-     169,    -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,
-      -1,    -1,   162,   163,   164,   165,    21,    22,    23,   169,
-      -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,   179,
-      -1,    -1,    -1,    -1,    39,    40,    -1,    -1,    -1,    44,
-      45,    46,    47,    -1,    -1,    50,    51,    52,    -1,    -1,
-      55,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    21,    22,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      39,    40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,
-      -1,    50,    51,    52,    -1,    -1,    55,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    -1,    -1,   169,    -1,    -1,    -1,    -1,    -1,
-      -1,   176,    -1,    29,   179,    -1,    32,    33,    34,    35,
-      -1,    -1,    38,   142,   143,    41,    42,    43,    -1,   148,
-      -1,    -1,    48,    49,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    63,    -1,    -1,
-     169,    67,    68,    -1,    -1,    -1,    72,   176,    -1,    -1,
-     179,    -1,    78,    -1,    80,    81,    -1,    83,    -1,    85,
-      86,    87,    88,    89,    -1,    91,    92,    93,    94,    95,
-      96,    97,    98,    99,   100,   101,   102,   103,   104,   105,
-     106,    -1,    -1,   109,   110,   111,    -1,   113,   114,   115,
-      -1,   117,   118,   119,    -1,    -1,   122,    -1,   124,    -1,
-      -1,   127,   128,   129,   130,    -1,    -1,   133,   134,   135,
-      -1,    -1,    -1,    -1,    -1,   141,    -1,    -1,    -1,   145,
-     146,   147,   148,   149,   150,   151,    -1,   153,   154,   155,
-     156,   157,    -1,    -1,   160,    -1,    -1,    -1,    -1,    39,
-      40,   167,   168,   169,    44,    45,    46,    47,    -1,    -1,
-     176,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,    59,
-      60,    61,    62,    -1,    64,    65,    66,    -1,    -1,    69,
-      70,    71,    -1,    73,    74,    75,    76,    77,    -1,    79,
-      39,    40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,
-      -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,   169,
-      -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,   179,
-      -1,    -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,
-     169,    -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,
-     179
+      -1,    -1,    -1,    -1,    -1,   148,   149,   150,   151,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   160,   161
 };
 
@@ -2798,103 +2739,110 @@
 static const yytype_uint16 yystos[] =
 {
-       0,   191,     0,     1,    36,    37,    53,    54,   144,   177,
-     187,   192,   197,   199,   205,   201,   198,   177,   200,    29,
-      32,    34,    38,    41,    42,    43,    48,    49,    63,    67,
-      68,    72,    78,    80,    81,    83,    85,    86,    87,    88,
-      89,    91,    92,    93,    94,    95,    96,    97,    98,    99,
-     100,   101,   102,   103,   104,   105,   106,   109,   110,   111,
-     113,   114,   115,   117,   118,   119,   122,   124,   127,   128,
-     129,   130,   133,   134,   135,   141,   145,   146,   147,   148,
-     149,   150,   151,   153,   154,   155,   156,   157,   160,   167,
-     168,   169,   176,   193,   194,   195,   202,   203,   206,   212,
-     224,   225,   228,   229,   234,   235,   237,   238,   239,   240,
-     241,   243,   244,   251,   253,   257,   258,   261,   262,   263,
-     298,   308,   309,   315,   316,   317,   318,   319,   321,   326,
-     327,   328,   330,   331,   333,   336,   337,   340,   341,   349,
-     351,   352,   365,   372,   201,   205,   169,   204,   179,    12,
-      21,    22,    39,    40,    44,    45,    46,    47,    56,    57,
-      58,    59,    60,    61,    62,    64,    65,    66,    69,    70,
-      71,    73,    74,    75,    76,    77,    79,   131,   142,   143,
-     148,   158,   159,   162,   163,   164,   165,   176,   179,   280,
-     281,   283,   284,   288,   290,   291,   292,   293,   298,   299,
-     300,   307,   320,   179,   187,   280,   304,   179,   217,   218,
-     179,   280,   303,     4,   187,   221,   187,   221,   304,   179,
-     169,   187,   324,   176,   179,   364,   280,   169,   325,   169,
-     324,   179,   169,   176,   179,   346,   179,   179,   221,   221,
-      20,    24,   247,   298,   179,   216,   123,   137,   127,   324,
-     324,   169,   252,    80,    81,   213,   275,   324,    27,   196,
-     198,    33,    35,   196,   158,   207,   196,   169,   179,   249,
-     250,   169,   226,   231,     3,   248,   169,   230,   247,     3,
-     236,   248,     3,   248,     3,   248,   169,   245,   246,   247,
-       3,     4,    35,   222,   223,   255,   271,   169,   176,   268,
-      23,   179,   259,    23,   179,   266,    23,     4,   329,   169,
-     310,   200,   324,   324,   324,   176,   323,   280,     5,   126,
-     189,   332,     3,   179,   334,   169,   304,   179,   345,    21,
-      22,    23,    50,    51,    52,    55,   169,   179,   281,   288,
-     299,   343,   345,   350,   353,   354,   355,   345,    84,    98,
-     105,   298,   328,   280,   280,   280,   282,   179,   179,   179,
-     282,   280,   282,   179,   179,   179,   179,   179,   179,   179,
-     179,   179,   179,   179,   179,   280,   179,   179,   179,   179,
-     179,   179,   280,   281,   283,   307,   360,   361,   362,   179,
-     280,   283,     5,     7,     8,     9,    10,    11,    13,    14,
-      15,    16,    17,    18,    21,    22,    23,    24,    25,   185,
-     186,   285,   280,   189,   179,   302,   179,   179,   169,   158,
-     301,   302,     3,     4,   180,   280,   219,   298,     3,   280,
-       4,   169,   242,   242,   280,   280,   180,   288,   292,   298,
-     330,   366,   367,   368,   176,   283,   298,   298,   367,   369,
-     298,   371,   242,    40,    44,    45,    46,    47,    56,    57,
-      58,    59,    60,    61,    62,    64,    65,    66,    69,    70,
-      71,    74,    75,    76,    77,    79,   169,   214,   215,   169,
-     298,   220,   280,     3,     3,   221,   194,   200,   204,   204,
-     196,     5,   249,     3,    24,   179,   187,   248,     3,    24,
-     230,   247,   179,   276,   230,   298,   247,   169,   169,   247,
-     276,     3,   245,    29,    82,   109,   111,   112,   113,   116,
-     117,   119,   120,   272,   273,   275,     4,   204,     3,   256,
-     254,     5,    23,   269,   280,   180,   176,   179,   169,   260,
-     269,   179,   267,   280,   268,   176,   276,     3,   205,   248,
-     298,   322,   373,   280,   280,   298,   176,    23,   280,   335,
-     338,   339,    23,    25,   179,   298,   347,   348,   353,   354,
-     280,   280,   280,   280,     5,   353,   179,   281,   288,   299,
-     342,   356,   357,   358,     3,   344,    20,    23,    24,    25,
-     355,   353,   360,   179,   179,   180,     3,   180,   282,   282,
-     280,   180,   180,   180,   280,   280,   280,   280,   280,   280,
-     280,   280,   280,   280,   280,   280,   180,   282,   282,   282,
-     282,   282,   280,   283,   361,   362,     3,   132,     3,     3,
-     282,   180,     3,     5,   280,   287,   280,   280,   280,   280,
-     280,   280,   280,   280,   280,   280,   280,   280,   280,   280,
-       5,    24,   280,   286,   280,     5,   280,     5,   280,   288,
-     303,   289,   294,   294,   280,   280,   180,     3,   180,   276,
-     218,   180,     3,   180,     3,   179,     3,   370,   180,   180,
-     180,     3,   370,     3,   180,     3,    24,     3,   180,   179,
-     169,   324,   179,   208,   208,   280,   180,   250,   227,   232,
-     233,   284,   280,   169,   169,   231,   227,   248,     4,    23,
-     277,   278,   279,   280,   248,   276,   276,   248,   246,   276,
-     179,     3,     4,   208,   254,   169,   269,   260,     5,   269,
-     180,     3,   270,    23,   180,   276,    31,   169,   311,   312,
-       5,   329,   364,   180,     3,   353,    23,    25,   179,   280,
-       3,   180,   180,   280,   180,   356,   285,   359,   359,     3,
-     359,   356,   353,   353,   353,   353,   353,   366,   369,   304,
-     280,   180,   180,   180,   180,   180,   180,   180,   180,   180,
-     180,   180,   180,   180,   180,   180,   180,   180,   180,   180,
-     180,   180,     3,     3,     3,   280,   362,   280,   362,   280,
-     362,   180,   283,   280,   280,   280,   280,   280,     4,     4,
-     280,   295,   296,   297,   180,   180,   298,   169,    84,   280,
-     295,   125,   367,   180,   367,   180,   298,   214,   280,   220,
-      23,   169,   180,   210,   211,    30,    24,     3,    21,    22,
-      23,   188,   299,   180,    24,    24,   230,   280,     3,   180,
-       4,   298,    23,   264,   264,   245,   138,   139,   140,   274,
-     273,     4,   169,   276,   180,   269,   270,   169,   180,     4,
-     126,     3,   280,   276,   339,   180,   280,   297,   189,   276,
-     348,   353,     3,   180,   285,   358,   370,   370,   169,   363,
-     363,   363,   180,   303,     4,   280,     4,     3,   302,   276,
-     180,   180,     5,   180,     3,   180,   179,   209,   227,   232,
-     232,   232,   232,   227,   278,   279,   280,   179,   265,   280,
-     180,   276,   264,   270,   269,   169,   187,   313,   314,   169,
-     312,     3,   276,   180,   330,   363,   359,   180,   180,     5,
-     180,   180,   180,   180,   280,     4,   280,   296,     3,   298,
-     211,   180,   210,    24,    23,   264,   305,   306,   126,     3,
-     280,   180,   280,   280,     4,   280,   180,   180,   305,     5,
-     126,   169,   314,     3,     3,   280,   280,   280,   280,   280,
-       3,   280
+       0,   170,     0,     1,    24,    25,    28,    30,    32,    35,
+      45,    61,    65,    66,    70,    76,    78,    79,    81,    86,
+      87,    88,    89,    90,    92,    93,    96,    97,    98,    99,
+     100,   101,   102,   103,   104,   105,   106,   108,   110,   111,
+     114,   115,   116,   118,   120,   123,   124,   127,   128,   129,
+     137,   140,   141,   142,   143,   144,   145,   146,   147,   148,
+     149,   150,   151,   152,   155,   158,   159,   160,   161,   166,
+     171,   172,   173,   174,   176,   178,   186,   198,   199,   203,
+     204,   209,   210,   211,   212,   213,   215,   216,   223,   225,
+     228,   231,   232,   267,   276,   277,   282,   283,   284,   286,
+     287,   291,   300,   301,   302,   303,   304,   310,   315,   319,
+     320,   323,   331,   332,   333,   334,   335,   338,   339,   341,
+     344,   345,   348,   357,   359,   369,   153,   181,   160,   180,
+     162,   162,    11,    19,    20,    33,    34,    39,    40,    41,
+      42,    43,    54,    55,    56,    57,    58,    59,    60,    62,
+      63,    64,    67,    68,    69,    71,    72,    73,    74,    75,
+      77,   125,   132,   138,   139,   144,   153,   154,   156,   157,
+     160,   161,   162,   166,   249,   250,   252,   253,   257,   259,
+     260,   261,   262,   267,   268,   269,   273,   275,   162,   191,
+     192,   162,   249,   272,   131,   166,   195,   166,   195,   273,
+     161,   162,   162,     3,   161,   179,   220,   305,   160,   160,
+     166,   336,   162,   162,   352,   160,   161,   162,   353,   162,
+     162,   195,   195,    18,    22,   219,   267,   162,   190,   119,
+     130,   123,   160,   224,   173,    78,    79,   187,   244,   133,
+     160,   161,   237,   336,   160,   162,   200,   201,   206,     4,
+     175,    24,   140,   166,    24,    29,    31,   175,   175,   160,
+     162,   221,   222,   166,     3,   220,   160,   205,   219,     3,
+     220,   220,     3,   220,   160,   217,   218,   219,     3,    31,
+     131,   196,   197,   226,   240,    21,   162,   229,    21,   162,
+     235,   337,   160,   172,   172,   172,   172,   336,   336,   336,
+       5,   122,   168,   340,     3,   162,   342,   101,   160,   273,
+     352,    19,    20,    21,    46,    47,    48,    49,    50,    52,
+      53,   160,   162,   250,   257,   268,   350,   352,   358,   360,
+     361,   362,   175,   249,   294,   249,   249,   249,   251,   162,
+     162,   162,   251,   249,   251,   162,   162,   162,   162,   162,
+     162,   162,   162,   162,   162,   162,   162,   249,   162,   251,
+     162,   162,   162,   162,   249,   250,   252,   275,   366,   367,
+     162,   249,   252,     5,     6,     7,     8,     9,    10,    12,
+      13,    14,    15,    16,    17,    19,    20,    21,    22,    23,
+     164,   165,   254,   249,   168,   162,   271,   162,   162,   160,
+     153,   270,   271,   193,   267,     3,   249,   133,   160,   214,
+     214,   249,   249,   161,   305,    94,    95,   267,   306,   257,
+     370,   371,    21,    23,   162,   267,   354,   355,   360,   361,
+     366,   161,   252,   267,   371,   372,   267,   374,   214,    34,
+      39,    40,    42,    43,    54,    55,    56,    57,    58,    59,
+      60,    62,    63,    64,    67,    68,    69,    72,    73,    74,
+      75,    77,   160,   188,   189,   160,   267,   194,   249,     3,
+       3,   195,     5,    21,   238,   249,   163,    22,   162,   257,
+     220,     3,    22,    45,    88,    89,   175,   166,   174,   180,
+     180,     5,   221,     3,   205,   219,   162,   245,   205,   267,
+     219,   160,   160,   219,   245,     3,   217,    25,    80,   106,
+     108,   109,   110,   113,   114,   116,   117,   241,   242,   244,
+     180,     3,   227,   160,   161,   162,   160,   230,   238,   161,
+     162,   236,   249,   237,   245,     3,   288,   299,   307,   299,
+      44,   321,   322,   324,   249,   249,   356,   161,    21,   249,
+     343,   346,   347,   249,   249,   249,   249,   249,   249,   249,
+       5,   360,   162,   250,   257,   268,   349,   363,   364,     3,
+     351,    18,    21,    22,    23,   362,   360,   163,   163,     3,
+     163,   251,   251,   249,   163,   163,   163,   249,   249,   249,
+     249,   249,   249,   249,   249,   249,   249,   249,   249,   163,
+     251,   163,   251,   251,   251,   252,   366,   367,     3,     3,
+     126,     3,   251,   163,     3,     5,   249,   256,   249,   249,
+     249,   249,   249,   249,   249,   249,   249,   249,   249,   249,
+     249,   249,     5,    22,   249,   255,   249,     5,   249,     5,
+     249,   356,   272,   258,   263,   263,     3,   163,   245,   192,
+     163,     3,     3,   163,   162,   298,     5,     3,   373,   360,
+      21,    23,   162,   249,     3,   163,   163,   163,   163,     3,
+     373,     3,   163,     3,    22,     3,   163,   162,   160,   336,
+     238,   202,   207,   208,   253,   249,     3,   201,   160,   206,
+     202,   162,   162,   179,   305,   162,   182,   182,   249,   163,
+     222,   220,     4,    21,   246,   247,   248,   249,   220,   245,
+     245,   220,   218,   245,   162,     3,   131,   182,   160,   245,
+     230,     5,   238,   163,     3,   239,    21,   163,   245,    27,
+     160,   278,   279,   249,   285,   286,   287,   289,   292,   293,
+     282,    91,   115,   308,   309,   330,    83,   311,   312,   316,
+     112,   162,   326,   107,   322,   325,   172,   267,   161,   163,
+       3,   249,   163,   363,   254,   365,   365,   365,     3,   363,
+     360,   360,   360,   360,   360,   293,   249,   163,   163,   163,
+     163,   163,   163,   163,   163,   163,   163,   163,   163,   163,
+     163,   163,   163,   163,   163,   163,     3,     3,     3,   249,
+     367,   249,   367,   249,   367,   163,   252,   249,   249,   249,
+     249,   249,   257,     4,     4,   249,   264,   265,   266,   163,
+     163,   267,   133,   160,   249,    35,    82,    88,   284,   249,
+     249,   121,   371,   163,   249,   266,   168,   245,   355,   371,
+     163,   267,   188,   249,   194,    22,     3,    19,    20,    21,
+     167,   268,   163,   160,   368,    22,   249,   249,   305,    21,
+     160,   163,   184,   185,    26,   177,   205,   249,     3,   163,
+       4,   267,    21,   233,   233,   217,   134,   135,   136,   243,
+     242,   245,   233,   163,   238,   239,   160,   163,     4,   122,
+       3,    36,   290,   295,   172,   172,   160,   162,    84,   312,
+     313,   314,   317,   172,     4,   249,   327,   328,   329,   160,
+     160,   299,   337,   347,     3,   163,   254,   364,   160,   368,
+     368,   368,   163,   272,     4,   249,     4,     3,   271,   245,
+     163,   162,   162,   163,     3,     5,   163,   356,   163,   202,
+     207,   207,   207,   207,     5,   163,   163,   163,     3,   163,
+     162,   183,   247,   248,   249,   162,   234,   249,   163,   233,
+       5,   122,   274,   239,   238,   160,   166,   280,   281,   160,
+     279,   294,    37,    38,   296,   297,   172,   249,   160,    85,
+     312,   318,   172,   299,   329,     3,   163,     4,   245,   368,
+     365,   163,   163,   163,   163,   249,     4,   249,   265,     3,
+     294,   249,   249,   257,   338,   249,    22,    82,   185,   163,
+     184,    21,   274,   249,   249,   122,     3,   163,   160,   160,
+     172,   288,   163,   160,   299,   328,   329,   245,   163,   249,
+       4,   249,   163,   163,     3,     3,   202,   163,   163,   160,
+     281,   160,   288,    82,   249,   249,   249,    22,   160,     3,
+     249
 };
 
@@ -2911,22 +2859,31 @@
 /* Like YYERROR except do call yyerror.  This remains here temporarily
    to ease the transition to the new meaning of YYERROR, for GCC.
-   Once GCC version 2 has supplanted version 1, this can go.  */
+   Once GCC version 2 has supplanted version 1, this can go.  However,
+   YYFAIL appears to be in use.  Nevertheless, it is formally deprecated
+   in Bison 2.4.2's NEWS entry, where a plan to phase it out is
+   discussed.  */
 
 #define YYFAIL		goto yyerrlab
+#if defined YYFAIL
+  /* This is here to suppress warnings from the GCC cpp's
+     -Wunused-macros.  Normally we don't worry about that warning, but
+     some users do, and we want to make it easy for users to remove
+     YYFAIL uses, which will produce warnings from Bison 2.5.  */
+#endif
 
 #define YYRECOVERING()  (!!yyerrstatus)
 
-#define YYBACKUP(Token, Value)					\
-do								\
-  if (yychar == YYEMPTY && yylen == 1)				\
-    {								\
-      yychar = (Token);						\
-      yylval = (Value);						\
-      yytoken = YYTRANSLATE (yychar);				\
-      YYPOPSTACK (1);						\
-      goto yybackup;						\
-    }								\
-  else								\
-    {								\
+#define YYBACKUP(Token, Value)                                  \
+do                                                              \
+  if (yychar == YYEMPTY)                                        \
+    {                                                           \
+      yychar = (Token);                                         \
+      yylval = (Value);                                         \
+      YYPOPSTACK (yylen);                                       \
+      yystate = *yyssp;                                         \
+      goto yybackup;                                            \
+    }                                                           \
+  else                                                          \
+    {                                                           \
       yyerror (YY_("syntax error: cannot back up")); \
       YYERROR;							\
@@ -2934,53 +2891,16 @@
 while (YYID (0))
 
-
+/* Error token number */
 #define YYTERROR	1
 #define YYERRCODE	256
 
 
-/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
-   If N is 0, then set CURRENT to the empty location which ends
-   the previous symbol: RHS[0] (always defined).  */
-
-#define YYRHSLOC(Rhs, K) ((Rhs)[K])
-#ifndef YYLLOC_DEFAULT
-# define YYLLOC_DEFAULT(Current, Rhs, N)				\
-    do									\
-      if (YYID (N))                                                    \
-	{								\
-	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
-	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
-	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
-	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
-	}								\
-      else								\
-	{								\
-	  (Current).first_line   = (Current).last_line   =		\
-	    YYRHSLOC (Rhs, 0).last_line;				\
-	  (Current).first_column = (Current).last_column =		\
-	    YYRHSLOC (Rhs, 0).last_column;				\
-	}								\
-    while (YYID (0))
+/* This macro is provided for backward compatibility. */
+#ifndef YY_LOCATION_PRINT
+# define YY_LOCATION_PRINT(File, Loc) ((void) 0)
 #endif
 
 
-/* YY_LOCATION_PRINT -- Print the location on the stream.
-   This macro was not mandated originally: define only if we know
-   we won't break user code: when these are the locations we know.  */
-
-#ifndef YY_LOCATION_PRINT
-# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
-#  define YY_LOCATION_PRINT(File, Loc)			\
-     fprintf (File, "%d.%d-%d.%d",			\
-	      (Loc).first_line, (Loc).first_column,	\
-	      (Loc).last_line,  (Loc).last_column)
-# else
-#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
-# endif
-#endif
-
-
 /* YYLEX -- calling `yylex' with the right arguments.  */
-
 #ifdef YYLEX_PARAM
 # define YYLEX yylex (YYLEX_PARAM)
@@ -3032,4 +2952,6 @@
 #endif
 {
+  FILE *yyo = yyoutput;
+  YYUSE (yyo);
   if (!yyvaluep)
     return;
@@ -3043,5 +2965,5 @@
     {
       default:
-	break;
+        break;
     }
 }
@@ -3081,15 +3003,18 @@
      || defined __cplusplus || defined _MSC_VER)
 static void
-yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
+yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop)
 #else
 static void
-yy_stack_print (bottom, top)
-    yytype_int16 *bottom;
-    yytype_int16 *top;
+yy_stack_print (yybottom, yytop)
+    yytype_int16 *yybottom;
+    yytype_int16 *yytop;
 #endif
 {
   YYFPRINTF (stderr, "Stack now");
-  for (; bottom <= top; ++bottom)
-    YYFPRINTF (stderr, " %d", *bottom);
+  for (; yybottom <= yytop; yybottom++)
+    {
+      int yybot = *yybottom;
+      YYFPRINTF (stderr, " %d", yybot);
+    }
   YYFPRINTF (stderr, "\n");
 }
@@ -3125,9 +3050,9 @@
   for (yyi = 0; yyi < yynrhs; yyi++)
     {
-      fprintf (stderr, "   $%d = ", yyi + 1);
+      YYFPRINTF (stderr, "   $%d = ", yyi + 1);
       yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
 		       &(yyvsp[(yyi + 1) - (yynrhs)])
 		       		       );
-      fprintf (stderr, "\n");
+      YYFPRINTF (stderr, "\n");
     }
 }
@@ -3165,6 +3090,4 @@
 # define YYMAXDEPTH 10000
 #endif
-
-
 
 
@@ -3270,114 +3193,143 @@
 # endif
 
-/* Copy into YYRESULT an error message about the unexpected token
-   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
-   including the terminating null byte.  If YYRESULT is null, do not
-   copy anything; just return the number of bytes that would be
-   copied.  As a special case, return 0 if an ordinary "syntax error"
-   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
-   size calculation.  */
-static YYSIZE_T
-yysyntax_error (char *yyresult, int yystate, int yychar)
+/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message
+   about the unexpected token YYTOKEN for the state stack whose top is
+   YYSSP.
+
+   Return 0 if *YYMSG was successfully written.  Return 1 if *YYMSG is
+   not large enough to hold the message.  In that case, also set
+   *YYMSG_ALLOC to the required number of bytes.  Return 2 if the
+   required number of bytes is too large to store.  */
+static int
+yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg,
+                yytype_int16 *yyssp, int yytoken)
 {
-  int yyn = yypact[yystate];
-
-  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
-    return 0;
-  else
+  YYSIZE_T yysize0 = yytnamerr (YY_NULL, yytname[yytoken]);
+  YYSIZE_T yysize = yysize0;
+  enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+  /* Internationalized format string. */
+  const char *yyformat = YY_NULL;
+  /* Arguments of yyformat. */
+  char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+  /* Number of reported tokens (one for the "unexpected", one per
+     "expected"). */
+  int yycount = 0;
+
+  /* There are many possibilities here to consider:
+     - Assume YYFAIL is not used.  It's too flawed to consider.  See
+       <http://lists.gnu.org/archive/html/bison-patches/2009-12/msg00024.html>
+       for details.  YYERROR is fine as it does not invoke this
+       function.
+     - If this state is a consistent state with a default action, then
+       the only way this function was invoked is if the default action
+       is an error action.  In that case, don't check for expected
+       tokens because there are none.
+     - The only way there can be no lookahead present (in yychar) is if
+       this state is a consistent state with a default action.  Thus,
+       detecting the absence of a lookahead is sufficient to determine
+       that there is no unexpected or expected token to report.  In that
+       case, just report a simple "syntax error".
+     - Don't assume there isn't a lookahead just because this state is a
+       consistent state with a default action.  There might have been a
+       previous inconsistent state, consistent state with a non-default
+       action, or user semantic action that manipulated yychar.
+     - Of course, the expected token list depends on states to have
+       correct lookahead information, and it depends on the parser not
+       to perform extra reductions after fetching a lookahead from the
+       scanner and before detecting a syntax error.  Thus, state merging
+       (from LALR or IELR) and default reductions corrupt the expected
+       token list.  However, the list is correct for canonical LR with
+       one exception: it will still contain any token that will not be
+       accepted due to an error action in a later state.
+  */
+  if (yytoken != YYEMPTY)
     {
-      int yytype = YYTRANSLATE (yychar);
-      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
-      YYSIZE_T yysize = yysize0;
-      YYSIZE_T yysize1;
-      int yysize_overflow = 0;
-      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
-      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
-      int yyx;
-
-# if 0
-      /* This is so xgettext sees the translatable formats that are
-	 constructed on the fly.  */
-      YY_("syntax error, unexpected %s");
-      YY_("syntax error, unexpected %s, expecting %s");
-      YY_("syntax error, unexpected %s, expecting %s or %s");
-      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
-      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
-# endif
-      char *yyfmt;
-      char const *yyf;
-      static char const yyunexpected[] = "syntax error, unexpected %s";
-      static char const yyexpecting[] = ", expecting %s";
-      static char const yyor[] = " or %s";
-      char yyformat[sizeof yyunexpected
-		    + sizeof yyexpecting - 1
-		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
-		       * (sizeof yyor - 1))];
-      char const *yyprefix = yyexpecting;
-
-      /* Start YYX at -YYN if negative to avoid negative indexes in
-	 YYCHECK.  */
-      int yyxbegin = yyn < 0 ? -yyn : 0;
-
-      /* Stay within bounds of both yycheck and yytname.  */
-      int yychecklim = YYLAST - yyn + 1;
-      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
-      int yycount = 1;
-
-      yyarg[0] = yytname[yytype];
-      yyfmt = yystpcpy (yyformat, yyunexpected);
-
-      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
-	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
-	  {
-	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
-	      {
-		yycount = 1;
-		yysize = yysize0;
-		yyformat[sizeof yyunexpected - 1] = '\0';
-		break;
-	      }
-	    yyarg[yycount++] = yytname[yyx];
-	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
-	    yysize_overflow |= (yysize1 < yysize);
-	    yysize = yysize1;
-	    yyfmt = yystpcpy (yyfmt, yyprefix);
-	    yyprefix = yyor;
-	  }
-
-      yyf = YY_(yyformat);
-      yysize1 = yysize + yystrlen (yyf);
-      yysize_overflow |= (yysize1 < yysize);
-      yysize = yysize1;
-
-      if (yysize_overflow)
-	return YYSIZE_MAXIMUM;
-
-      if (yyresult)
-	{
-	  /* Avoid sprintf, as that infringes on the user's name space.
-	     Don't have undefined behavior even if the translation
-	     produced a string with the wrong number of "%s"s.  */
-	  char *yyp = yyresult;
-	  int yyi = 0;
-	  while ((*yyp = *yyf) != '\0')
-	    {
-	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
-		{
-		  yyp += yytnamerr (yyp, yyarg[yyi++]);
-		  yyf += 2;
-		}
-	      else
-		{
-		  yyp++;
-		  yyf++;
-		}
-	    }
-	}
-      return yysize;
+      int yyn = yypact[*yyssp];
+      yyarg[yycount++] = yytname[yytoken];
+      if (!yypact_value_is_default (yyn))
+        {
+          /* Start YYX at -YYN if negative to avoid negative indexes in
+             YYCHECK.  In other words, skip the first -YYN actions for
+             this state because they are default actions.  */
+          int yyxbegin = yyn < 0 ? -yyn : 0;
+          /* Stay within bounds of both yycheck and yytname.  */
+          int yychecklim = YYLAST - yyn + 1;
+          int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+          int yyx;
+
+          for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+            if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR
+                && !yytable_value_is_error (yytable[yyx + yyn]))
+              {
+                if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+                  {
+                    yycount = 1;
+                    yysize = yysize0;
+                    break;
+                  }
+                yyarg[yycount++] = yytname[yyx];
+                {
+                  YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULL, yytname[yyx]);
+                  if (! (yysize <= yysize1
+                         && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
+                    return 2;
+                  yysize = yysize1;
+                }
+              }
+        }
     }
+
+  switch (yycount)
+    {
+# define YYCASE_(N, S)                      \
+      case N:                               \
+        yyformat = S;                       \
+      break
+      YYCASE_(0, YY_("syntax error"));
+      YYCASE_(1, YY_("syntax error, unexpected %s"));
+      YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s"));
+      YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s"));
+      YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s"));
+      YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"));
+# undef YYCASE_
+    }
+
+  {
+    YYSIZE_T yysize1 = yysize + yystrlen (yyformat);
+    if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
+      return 2;
+    yysize = yysize1;
+  }
+
+  if (*yymsg_alloc < yysize)
+    {
+      *yymsg_alloc = 2 * yysize;
+      if (! (yysize <= *yymsg_alloc
+             && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM))
+        *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM;
+      return 1;
+    }
+
+  /* Avoid sprintf, as that infringes on the user's name space.
+     Don't have undefined behavior even if the translation
+     produced a string with the wrong number of "%s"s.  */
+  {
+    char *yyp = *yymsg;
+    int yyi = 0;
+    while ((*yyp = *yyformat) != '\0')
+      if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount)
+        {
+          yyp += yytnamerr (yyp, yyarg[yyi++]);
+          yyformat += 2;
+        }
+      else
+        {
+          yyp++;
+          yyformat++;
+        }
+  }
+  return 0;
 }
 #endif /* YYERROR_VERBOSE */
-
-
 
 /*-----------------------------------------------.
@@ -3408,5 +3360,5 @@
 
       default:
-	break;
+        break;
     }
 }
@@ -3414,31 +3366,22 @@
 
 
-/* Prevent warnings from -Wmissing-prototypes.  */
-
-#ifdef YYPARSE_PARAM
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void *YYPARSE_PARAM);
-#else
-int yyparse ();
+
+/* The lookahead symbol.  */
+int yychar;
+
+
+#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+# define YY_IGNORE_MAYBE_UNINITIALIZED_END
 #endif
-#else /* ! YYPARSE_PARAM */
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void);
-#else
-int yyparse ();
+#ifndef YY_INITIAL_VALUE
+# define YY_INITIAL_VALUE(Value) /* Nothing. */
 #endif
-#endif /* ! YYPARSE_PARAM */
-
-
-
-/* The look-ahead symbol.  */
-int yychar;
-
-/* The semantic value of the look-ahead symbol.  */
-YYSTYPE yylval;
+
+/* The semantic value of the lookahead symbol.  */
+YYSTYPE yylval YY_INITIAL_VALUE(yyval_default);
 
 /* Number of syntax errors so far.  */
 int yynerrs;
-
 
 
@@ -3469,12 +3412,35 @@
 #endif
 {
-  
-  int yystate;
+    int yystate;
+    /* Number of tokens to shift before error messages enabled.  */
+    int yyerrstatus;
+
+    /* The stacks and their tools:
+       `yyss': related to states.
+       `yyvs': related to semantic values.
+
+       Refer to the stacks through separate pointers, to allow yyoverflow
+       to reallocate them elsewhere.  */
+
+    /* The state stack.  */
+    yytype_int16 yyssa[YYINITDEPTH];
+    yytype_int16 *yyss;
+    yytype_int16 *yyssp;
+
+    /* The semantic value stack.  */
+    YYSTYPE yyvsa[YYINITDEPTH];
+    YYSTYPE *yyvs;
+    YYSTYPE *yyvsp;
+
+    YYSIZE_T yystacksize;
+
   int yyn;
   int yyresult;
-  /* Number of tokens to shift before error messages enabled.  */
-  int yyerrstatus;
-  /* Look-ahead token as an internal (translated) token number.  */
+  /* Lookahead token as an internal (translated) token number.  */
   int yytoken = 0;
+  /* The variables used to return semantic value and location from the
+     action routines.  */
+  YYSTYPE yyval;
+
 #if YYERROR_VERBOSE
   /* Buffer for error messages, and its allocated size.  */
@@ -3484,32 +3450,5 @@
 #endif
 
-  /* Three stacks and their tools:
-     `yyss': related to states,
-     `yyvs': related to semantic values,
-     `yyls': related to locations.
-
-     Refer to the stacks thru separate pointers, to allow yyoverflow
-     to reallocate them elsewhere.  */
-
-  /* The state stack.  */
-  yytype_int16 yyssa[YYINITDEPTH];
-  yytype_int16 *yyss = yyssa;
-  yytype_int16 *yyssp;
-
-  /* The semantic value stack.  */
-  YYSTYPE yyvsa[YYINITDEPTH];
-  YYSTYPE *yyvs = yyvsa;
-  YYSTYPE *yyvsp;
-
-
-
 #define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N))
-
-  YYSIZE_T yystacksize = YYINITDEPTH;
-
-  /* The variables used to return semantic value and location from the
-     action routines.  */
-  YYSTYPE yyval;
-
 
   /* The number of symbols on the RHS of the reduced rule.
@@ -3517,4 +3456,8 @@
   int yylen = 0;
 
+  yyssp = yyss = yyssa;
+  yyvsp = yyvs = yyvsa;
+  yystacksize = YYINITDEPTH;
+
   YYDPRINTF ((stderr, "Starting parse\n"));
 
@@ -3522,14 +3465,5 @@
   yyerrstatus = 0;
   yynerrs = 0;
-  yychar = YYEMPTY;		/* Cause a token to be read.  */
-
-  /* Initialize stack pointers.
-     Waste one element of value and location stack
-     so that they stay on the same level as the state stack.
-     The wasted elements are never initialized.  */
-
-  yyssp = yyss;
-  yyvsp = yyvs;
-
+  yychar = YYEMPTY; /* Cause a token to be read.  */
   goto yysetstate;
 
@@ -3558,5 +3492,4 @@
 	yytype_int16 *yyss1 = yyss;
 
-
 	/* Each stack pointer address is followed by the size of the
 	   data in use in that stack, in bytes.  This used to be a
@@ -3566,5 +3499,4 @@
 		    &yyss1, yysize * sizeof (*yyssp),
 		    &yyvs1, yysize * sizeof (*yyvsp),
-
 		    &yystacksize);
 
@@ -3589,7 +3521,6 @@
 	if (! yyptr)
 	  goto yyexhaustedlab;
-	YYSTACK_RELOCATE (yyss);
-	YYSTACK_RELOCATE (yyvs);
-
+	YYSTACK_RELOCATE (yyss_alloc, yyss);
+	YYSTACK_RELOCATE (yyvs_alloc, yyvs);
 #  undef YYSTACK_RELOCATE
 	if (yyss1 != yyssa)
@@ -3602,5 +3533,4 @@
       yyvsp = yyvs + yysize - 1;
 
-
       YYDPRINTF ((stderr, "Stack size increased to %lu\n",
 		  (unsigned long int) yystacksize));
@@ -3611,4 +3541,7 @@
 
   YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+  if (yystate == YYFINAL)
+    YYACCEPT;
 
   goto yybackup;
@@ -3620,14 +3553,14 @@
 
   /* Do appropriate processing given the current state.  Read a
-     look-ahead token if we need one and don't already have one.  */
-
-  /* First try to decide what to do without reference to look-ahead token.  */
+     lookahead token if we need one and don't already have one.  */
+
+  /* First try to decide what to do without reference to lookahead token.  */
   yyn = yypact[yystate];
-  if (yyn == YYPACT_NINF)
+  if (yypact_value_is_default (yyn))
     goto yydefault;
 
-  /* Not known => get a look-ahead token if don't already have one.  */
-
-  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
+  /* Not known => get a lookahead token if don't already have one.  */
+
+  /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
   if (yychar == YYEMPTY)
     {
@@ -3655,12 +3588,9 @@
   if (yyn <= 0)
     {
-      if (yyn == 0 || yyn == YYTABLE_NINF)
-	goto yyerrlab;
+      if (yytable_value_is_error (yyn))
+        goto yyerrlab;
       yyn = -yyn;
       goto yyreduce;
     }
-
-  if (yyn == YYFINAL)
-    YYACCEPT;
 
   /* Count tokens shifted since error; after three, turn off error
@@ -3669,13 +3599,14 @@
     yyerrstatus--;
 
-  /* Shift the look-ahead token.  */
+  /* Shift the lookahead token.  */
   YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
 
-  /* Discard the shifted token unless it is eof.  */
-  if (yychar != YYEOF)
-    yychar = YYEMPTY;
+  /* Discard the shifted token.  */
+  yychar = YYEMPTY;
 
   yystate = yyn;
+  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
   *++yyvsp = yylval;
+  YY_IGNORE_MAYBE_UNINITIALIZED_END
 
   goto yynewstate;
@@ -3713,2816 +3644,2480 @@
   switch (yyn)
     {
-        case 8:
-#line 344 "fortran.y"
-    {yyerrok;yyclearin;;}
-    break;
-
-  case 13:
-#line 352 "fortran.y"
+        case 7:
+/* Line 1807 of yacc.c  */
+#line 319 "fortran.y"
+    {yyerrok;yyclearin;}
+    break;
+
+  case 18:
+/* Line 1807 of yacc.c  */
+#line 337 "fortran.y"
     {
-                     if (inmoduledeclare == 0 )
-                     {
-                        pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_curinclude,
-                                              pos_end-pos_curinclude);
-                     }
-                  ;}
-    break;
-
-  case 18:
-#line 368 "fortran.y"
+            if (inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
+            }
+        }
+    break;
+
+  case 20:
+/* Line 1807 of yacc.c  */
+#line 347 "fortran.y"
+    { pos_cur = setposcur(); }
+    break;
+
+  case 21:
+/* Line 1807 of yacc.c  */
+#line 350 "fortran.y"
+    { isrecursive = 0; }
+    break;
+
+  case 22:
+/* Line 1807 of yacc.c  */
+#line 351 "fortran.y"
+    { isrecursive = 1; }
+    break;
+
+  case 23:
+/* Line 1807 of yacc.c  */
+#line 354 "fortran.y"
+    { is_result_present = 0; }
+    break;
+
+  case 24:
+/* Line 1807 of yacc.c  */
+#line 355 "fortran.y"
+    { is_result_present = 1; }
+    break;
+
+  case 25:
+/* Line 1807 of yacc.c  */
+#line 359 "fortran.y"
     {
-            /* we should ignore the declaration until the keyword             */
-            /*    TOK_ENDDONOTTREAT                                           */
-            couldaddvariable = 0 ;
-            RemoveWordCUR_0(fortranout,-20,20);
-         ;}
-    break;
-
-  case 19:
-#line 375 "fortran.y"
+            insubroutinedeclare = 1;
+            if ( firstpass )
+                Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
+            else
+                WriteBeginof_SubLoop();
+        }
+    break;
+
+  case 26:
+/* Line 1807 of yacc.c  */
+#line 367 "fortran.y"
     {
-             couldaddvariable = 1 ;
-             RemoveWordCUR_0(fortranout,-24,24);
-          ;}
-    break;
-
-  case 22:
-#line 382 "fortran.y"
-    {pos_cur = setposcur();;}
+            insubroutinedeclare = 1;
+            inprogramdeclare = 1;
+            /* in the second step we should write the head of       */
+            /*    the subroutine sub_loop_<subroutinename>          */
+            if ( ! firstpass )
+                WriteBeginof_SubLoop();
+        }
     break;
 
   case 27:
-#line 394 "fortran.y"
-    {if (incom !=1) {strcpy(curbuf,"");incom=0;};}
+/* Line 1807 of yacc.c  */
+#line 376 "fortran.y"
+    {
+            insubroutinedeclare = 1;
+            strcpy(DeclType, "");
+            /* we should to list of the subroutine argument the  */
+            /*    name of the function which has to be defined   */
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1((yyvsp[(4) - (5)].l));
+                if ( ! is_result_present )
+                    Add_FunctionType_Var_1((yyvsp[(3) - (5)].na));
+            }
+            else
+            /* in the second step we should write the head of    */
+            /*    the subroutine sub_loop_<subroutinename>       */
+                WriteBeginof_SubLoop();
+        }
     break;
 
   case 28:
-#line 397 "fortran.y"
-    {isrecursive = 0;;}
-    break;
-
-  case 29:
-#line 399 "fortran.y"
-    {isrecursive = 1;;}
+/* Line 1807 of yacc.c  */
+#line 393 "fortran.y"
+    {
+            GlobalDeclaration = 0;
+            strcpy(curmodulename,(yyvsp[(2) - (2)].na));
+            strcpy(subroutinename,"");
+            Add_NameOfModule_1((yyvsp[(2) - (2)].na));
+            if ( inmoduledeclare == 0 )
+            {
+                /* To know if there are in the module declaration    */
+                inmoduledeclare = 1;
+                /* to know if a module has been met                  */
+                inmodulemeet = 1;
+                /* to know if we are after the keyword contains      */
+                aftercontainsdeclare = 0 ;
+            }
+        }
     break;
 
   case 31:
-#line 403 "fortran.y"
+/* Line 1807 of yacc.c  */
+#line 415 "fortran.y"
+    { strcpy((yyval.na), (yyvsp[(1) - (1)].na)); strcpy(subroutinename, (yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 32:
+/* Line 1807 of yacc.c  */
+#line 417 "fortran.y"
+    { Add_Include_1((yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 33:
+/* Line 1807 of yacc.c  */
+#line 419 "fortran.y"
+    { if ( firstpass ) (yyval.l)=NULL; }
+    break;
+
+  case 34:
+/* Line 1807 of yacc.c  */
+#line 420 "fortran.y"
+    { if ( firstpass ) (yyval.l)=NULL; }
+    break;
+
+  case 35:
+/* Line 1807 of yacc.c  */
+#line 421 "fortran.y"
+    { if ( firstpass ) (yyval.l)=(yyvsp[(2) - (3)].l); }
+    break;
+
+  case 38:
+/* Line 1807 of yacc.c  */
+#line 425 "fortran.y"
+    { if ( firstpass ) Add_SubroutineArgument_Var_1((yyvsp[(2) - (3)].l)); }
+    break;
+
+  case 39:
+/* Line 1807 of yacc.c  */
+#line 428 "fortran.y"
     {
-                      if ( couldaddvariable == 1)
-                      {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (4)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-
-                      }
-                      Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(1);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            writeheadnewsub_0(1);
-                      }
-                      }
-                   ;}
-    break;
-
-  case 32:
-#line 431 "fortran.y"
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar((yyvsp[(1) - (1)].na),NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                curlistvar = insertvar(NULL,curvar);
+                (yyval.l) = settype("",curlistvar);
+            }
+        }
+    break;
+
+  case 40:
+/* Line 1807 of yacc.c  */
+#line 440 "fortran.y"
     {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(2) - (2)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-
-                      }
-                      strcpy(subroutinename,(yyvsp[(2) - (2)].nac));
-                      /* Common case                                          */
-                      insubroutinedeclare = 1;
-                      /* in the second step we should write the head of       */
-                      /*    the subroutine sub_loop_<subroutinename>          */
-                      writeheadnewsub_0(1);
-                   ;}
-    break;
-
-  case 33:
-#line 449 "fortran.y"
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar((yyvsp[(3) - (3)].na),NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                (yyval.l) = insertvar((yyvsp[(1) - (3)].l),curvar);
+            }
+        }
+    break;
+
+  case 41:
+/* Line 1807 of yacc.c  */
+#line 451 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));  }
+    break;
+
+  case 42:
+/* Line 1807 of yacc.c  */
+#line 452 "fortran.y"
+    { strcpy((yyval.na),"*"); }
+    break;
+
+  case 44:
+/* Line 1807 of yacc.c  */
+#line 455 "fortran.y"
+    { inside_type_declare = 1; }
+    break;
+
+  case 45:
+/* Line 1807 of yacc.c  */
+#line 456 "fortran.y"
+    { inside_type_declare = 0; }
+    break;
+
+  case 47:
+/* Line 1807 of yacc.c  */
+#line 459 "fortran.y"
     {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (6)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,(yyvsp[(3) - (6)].nac));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(4) - (6)].l));
-                         strcpy(DeclType,"");
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            /* we should to list of the subroutine argument   */
-                            /* name of the function which has to be defined   */
-                            Add_SubroutineArgument_Var_1((yyvsp[(4) - (6)].l));
-                            strcpy(DeclType,"");
-                            Add_FunctionType_Var_1((yyvsp[(3) - (6)].nac));
-                            writeheadnewsub_0(2);
-                      }
-                   ;}
-    break;
-
-  case 34:
-#line 482 "fortran.y"
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1((yyvsp[(3) - (4)].l));
+                    else                        Add_GlobalParameter_Var_1((yyvsp[(3) - (4)].l));
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out, pos_cur_decl, pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+    break;
+
+  case 48:
+/* Line 1807 of yacc.c  */
+#line 476 "fortran.y"
     {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (4)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,(yyvsp[(3) - (4)].nac));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
-                         strcpy(DeclType,"");
-                         Add_FunctionType_Var_1((yyvsp[(3) - (4)].nac));
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            /* we should to list of the subroutine argument   */
-                            /* name of the function which has to be defined   */
-                            Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
-                            strcpy(DeclType,"");
-                            Add_FunctionType_Var_1((yyvsp[(3) - (4)].nac));
-                            writeheadnewsub_0(2);
-                      }
-                   ;}
-    break;
-
-  case 35:
-#line 516 "fortran.y"
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1((yyvsp[(2) - (2)].l));
+                    else                        Add_GlobalParameter_Var_1((yyvsp[(2) - (2)].l));
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+    break;
+
+  case 50:
+/* Line 1807 of yacc.c  */
+#line 494 "fortran.y"
     {
-                      GlobalDeclaration = 0;
-                      strcpy(curmodulename,(yyvsp[(2) - (2)].nac));
-                      strcpy(subroutinename,"");
-                      Add_NameOfModule_1((yyvsp[(2) - (2)].nac));
-                      if ( inmoduledeclare == 0 )
-                      {
-                         /* To know if there are in the module declaration    */
-                         inmoduledeclare = 1;
-                         /* to know if a module has been met                  */
-                         inmodulemeet = 1;
-                         /* to know if we are after the keyword contains      */
-                         aftercontainsdeclare = 0 ;
-                      }
-                   ;}
-    break;
-
-  case 36:
-#line 533 "fortran.y"
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave);
+        }
+    break;
+
+  case 52:
+/* Line 1807 of yacc.c  */
+#line 500 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));strcpy(subroutinename,(yyvsp[(1) - (1)].nac));
-                      }
-                   ;}
-    break;
-
-  case 38:
-#line 542 "fortran.y"
+            /* if the variable is a parameter we can suppose that is   */
+            /*    value is the same on each grid. It is not useless to */
+            /*    create a copy of it on each grid                     */
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    Add_Globliste_1((yyvsp[(1) - (1)].l));
+                    /* if variableparamlists has been declared in a subroutine   */
+                    if ( insubroutinedeclare )     Add_Dimension_Var_1((yyvsp[(1) - (1)].l));
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension);
+                }
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+        }
+    break;
+
+  case 53:
+/* Line 1807 of yacc.c  */
+#line 537 "fortran.y"
     {
-                      pos_curinclude = setposcur()-9;
-                   ;}
-    break;
-
-  case 39:
-#line 546 "fortran.y"
+            if (firstpass == 0)
+            {
+                if ((yyvsp[(1) - (1)].lnn))
+                {
+                    removeglobfromlist(&((yyvsp[(1) - (1)].lnn)));
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur);
+                    writelistpublic((yyvsp[(1) - (1)].lnn));
+                }
+            }
+        }
+    break;
+
+  case 62:
+/* Line 1807 of yacc.c  */
+#line 558 "fortran.y"
     {
-                      if ( couldaddvariable == 1 ) Add_Include_1((yyvsp[(1) - (1)].nac));
-                   ;}
-    break;
-
-  case 40:
-#line 550 "fortran.y"
+            /* we should remove the data declaration                */
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata);
+
+            if ( aftercontainsdeclare == 1  && firstpass == 0 )
+            {
+                ReWriteDataStatement_0(fortran_out);
+                pos_end = setposcur();
+            }
+        }
+    break;
+
+  case 64:
+/* Line 1807 of yacc.c  */
+#line 572 "fortran.y"
     {
-                      if ( firstpass == 1 && couldaddvariable == 1) (yyval.l)=NULL;
-                   ;}
-    break;
-
-  case 41:
-#line 553 "fortran.y"
+            PublicDeclare = 0 ;
+            PrivateDeclare = 0 ;
+        }
+    break;
+
+  case 102:
+/* Line 1807 of yacc.c  */
+#line 630 "fortran.y"
     {
-                      if ( firstpass == 1 && couldaddvariable == 1 ) (yyval.l)=NULL;
-                   ;}
-    break;
-
-  case 42:
-#line 557 "fortran.y"
+            /* if the variable is a parameter we can suppose that is*/
+            /*    value is the same on each grid. It is not useless */
+            /*    to create a copy of it on each grid               */
+            if ( ! inside_type_declare )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                ReWriteDeclarationAndAddTosubroutine_01((yyvsp[(1) - (2)].l));
+                pos_cur_decl = setposcur();
+                if ( firstpass == 0 && GlobalDeclaration == 0
+                                    && insubroutinedeclare == 0 )
+                {
+                    fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename);
+                    sprintf(ligne, "Module_Declar_%s.h", curmodulename);
+                    module_declar = open_for_write(ligne);
+                    GlobalDeclaration = 1 ;
+                    pos_cur_decl = setposcur();
+                }
+                (yyval.l) = (yyvsp[(1) - (2)].l);
+
+                if ( firstpass )
+                {
+                    Add_Globliste_1((yyvsp[(1) - (2)].l));
+                    if ( insubroutinedeclare )
+                    {
+                        if ( pointerdeclare ) Add_Pointer_Var_From_List_1((yyvsp[(1) - (2)].l));
+                        Add_Parameter_Var_1((yyvsp[(1) - (2)].l));
+                    }
+                    else
+                        Add_GlobalParameter_Var_1((yyvsp[(1) - (2)].l));
+
+                    /* If there's a SAVE declaration in module's subroutines we should    */
+                    /*    remove it from the subroutines declaration and add it in the    */
+                    /*    global declarations                                             */
+                    if ( aftercontainsdeclare && SaveDeclare )
+                    {
+                        if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1((yyvsp[(1) - (2)].l));
+                        else                Add_Save_Var_dcl_1((yyvsp[(1) - (2)].l));
+                    }
+                }
+            }
+            else
+            {
+                (yyval.l) = (listvar *) NULL;
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+            GlobalDeclarationType = 0;
+        }
+    break;
+
+  case 103:
+/* Line 1807 of yacc.c  */
+#line 696 "fortran.y"
     {
-                       if ( firstpass == 1 && couldaddvariable == 1 ) (yyval.l)=(yyvsp[(2) - (3)].l);
-                   ;}
-    break;
-
-  case 45:
-#line 564 "fortran.y"
+            insubroutinedeclare = 1;
+
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
+                Add_FunctionType_Var_1((yyvsp[(2) - (3)].na));
+            }
+            else
+                WriteBeginof_SubLoop();
+
+            strcpy(nameinttypename,"");
+        }
+    break;
+
+  case 104:
+/* Line 1807 of yacc.c  */
+#line 710 "fortran.y"
+    { functiondeclarationisdone = 1; }
+    break;
+
+  case 105:
+/* Line 1807 of yacc.c  */
+#line 712 "fortran.y"
+    { VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
+    break;
+
+  case 109:
+/* Line 1807 of yacc.c  */
+#line 724 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         Add_SubroutineArgument_Var_1((yyvsp[(2) - (3)].l));
-                      }
-                   ;}
-    break;
-
-  case 46:
-#line 571 "fortran.y"
+            createstringfromlistname(ligne,(yyvsp[(3) - (4)].lnn));
+            if (firstpass == 1) Add_Data_Var_1(&List_Data_Var,(yyvsp[(1) - (4)].na),ligne);
+            else                Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(1) - (4)].na),ligne);
+        }
+    break;
+
+  case 110:
+/* Line 1807 of yacc.c  */
+#line 730 "fortran.y"
     {
-                      if ( firstpass == 1  && couldaddvariable == 1)
-                      {
-                         strcpy(nameinttypenameback,nameinttypename);
-                         strcpy(nameinttypename,"");
-                         curvar=createvar((yyvsp[(1) - (1)].na),NULL);
-                        strcpy(nameinttypename,nameinttypenameback);
-                         curlistvar=insertvar(NULL,curvar);
-                         (yyval.l)=settype("",curlistvar);
-                      }
-                   ;}
-    break;
-
-  case 47:
-#line 583 "fortran.y"
+            if (firstpass == 1)  Add_Data_Var_Names_01(&List_Data_Var,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
+            else                 Add_Data_Var_Names_01(&List_Data_Var_Cur,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
+        }
+    break;
+
+  case 111:
+/* Line 1807 of yacc.c  */
+#line 735 "fortran.y"
     {
-                      if ( firstpass == 1  && couldaddvariable == 1)
-                      {
-                         strcpy(nameinttypenameback,nameinttypename);
-                         strcpy(nameinttypename,"");                      
-                         curvar=createvar((yyvsp[(3) - (3)].na),NULL);
-                         strcpy(nameinttypename,nameinttypenameback);                         
-                         (yyval.l)=insertvar((yyvsp[(1) - (3)].l),curvar);
-                      }
-                   ;}
-    break;
-
-  case 48:
-#line 594 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 49:
-#line 595 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),"*");;}
-    break;
-
-  case 50:
-#line 598 "fortran.y"
+            createstringfromlistname(ligne,(yyvsp[(7) - (8)].lnn));
+            printf("###################################################################################################################\n");
+            printf("## CONV Error : data_implied_do statements (R537) are not yet supported. Please complain to the proper authorities.\n");
+            printf("l.%4d -- data_stmt_set : ( lhs , dospec ) /data_stmt_value_list/ -- lhs=|%s| dospec=|%s| data_stmt_value_list=|%s|\n",
+                line_num_input,(yyvsp[(2) - (8)].na),(yyvsp[(4) - (8)].na),ligne);
+            printf("## But, are you SURE you NEED a DATA construct ?\n");
+            printf("###################################################################################################################\n");
+            exit(1);
+        }
+    break;
+
+  case 112:
+/* Line 1807 of yacc.c  */
+#line 748 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 113:
+/* Line 1807 of yacc.c  */
+#line 749 "fortran.y"
+    { (yyval.lnn) = Insertname((yyvsp[(3) - (3)].lnn),(yyvsp[(1) - (3)].na),1);   }
+    break;
+
+  case 118:
+/* Line 1807 of yacc.c  */
+#line 758 "fortran.y"
+    { pos_cursave = setposcur()-4; }
+    break;
+
+  case 120:
+/* Line 1807 of yacc.c  */
+#line 761 "fortran.y"
+    { if ( ! inside_type_declare ) Add_Save_Var_1((yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].d)); }
+    break;
+
+  case 121:
+/* Line 1807 of yacc.c  */
+#line 764 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 122:
+/* Line 1807 of yacc.c  */
+#line 765 "fortran.y"
+    { printf("l.%4d -- INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n",line_num_input); exit(0); }
+    break;
+
+  case 123:
+/* Line 1807 of yacc.c  */
+#line 766 "fortran.y"
+    { (yyval.lnn) = concat_listname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].lnn)); }
+    break;
+
+  case 124:
+/* Line 1807 of yacc.c  */
+#line 769 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));  }
+    break;
+
+  case 125:
+/* Line 1807 of yacc.c  */
+#line 770 "fortran.y"
+    { sprintf((yyval.na),"%s+%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 126:
+/* Line 1807 of yacc.c  */
+#line 771 "fortran.y"
+    { sprintf((yyval.na),"%s-%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 127:
+/* Line 1807 of yacc.c  */
+#line 772 "fortran.y"
+    { sprintf((yyval.na),"%s*%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 128:
+/* Line 1807 of yacc.c  */
+#line 773 "fortran.y"
+    { sprintf((yyval.na),"%s/%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 129:
+/* Line 1807 of yacc.c  */
+#line 775 "fortran.y"
+    { strcpy((yyval.na),""); }
+    break;
+
+  case 130:
+/* Line 1807 of yacc.c  */
+#line 776 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 135:
+/* Line 1807 of yacc.c  */
+#line 786 "fortran.y"
     {
-                      if ( VarTypepar == 1 )
-                      {
-                         couldaddvariable = 1 ;
-                         VarTypepar = 0;
-                      }
-                   ;}
-    break;
-
-  case 51:
-#line 606 "fortran.y"
+            positioninblock = 0;
+            pos_curdimension = setposcur()-9;
+        }
+    break;
+
+  case 136:
+/* Line 1807 of yacc.c  */
+#line 793 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         VarType = 1;
-                         couldaddvariable = 0 ;
-                      }
-                   ;}
-    break;
-
-  case 52:
-#line 614 "fortran.y"
+            printf("l.%4d -- dimension : before_dimension opt_comma TOK_NAME = |%s| -- MHCHECK\n",line_num_input,(yyvsp[(3) - (5)].na));
+            if ( inside_type_declare ) break;
+            curvar = createvar((yyvsp[(3) - (5)].na),(yyvsp[(4) - (5)].d));
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar=insertvar(NULL, curvar);
+            (yyval.l) = settype("",curlistvar);
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 137:
+/* Line 1807 of yacc.c  */
+#line 803 "fortran.y"
     {
-                      if ( VarType == 1 ) couldaddvariable = 1 ;
-                      VarType = 0;
-                      VarTypepar = 0;
-                   ;}
-    break;
-
-  case 54:
-#line 621 "fortran.y"
+            printf("l.%4d -- dimension : dimension ',' TOK_NAME dims lengspec = |%s| -- MHCHECK\n",line_num_input,(yyvsp[(3) - (5)].na));
+            if ( inside_type_declare ) break;
+            curvar = createvar((yyvsp[(3) - (5)].na),(yyvsp[(4) - (5)].d));
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar = insertvar((yyvsp[(1) - (5)].l), curvar);
+            (yyval.l) = curlistvar;
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 140:
+/* Line 1807 of yacc.c  */
+#line 818 "fortran.y"
+    { (yyval.lnn) = (listname *) NULL; }
+    break;
+
+  case 141:
+/* Line 1807 of yacc.c  */
+#line 819 "fortran.y"
+    { (yyval.lnn) = (yyvsp[(3) - (3)].lnn); }
+    break;
+
+  case 142:
+/* Line 1807 of yacc.c  */
+#line 822 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 143:
+/* Line 1807 of yacc.c  */
+#line 823 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 144:
+/* Line 1807 of yacc.c  */
+#line 824 "fortran.y"
+    { (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].na),0);   }
+    break;
+
+  case 145:
+/* Line 1807 of yacc.c  */
+#line 825 "fortran.y"
+    { (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].na),0);   }
+    break;
+
+  case 146:
+/* Line 1807 of yacc.c  */
+#line 829 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         if ( insubroutinedeclare == 0 )
-                         {
-                                                  Add_GlobalParameter_Var_1((yyvsp[(3) - (4)].l));
-                                                  }
-                         else Add_Parameter_Var_1((yyvsp[(3) - (4)].l));
-                         pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                    pos_end-pos_cur_decl);
-                      }
-                      VariableIsParameter =  0 ;
-                   ;}
-    break;
-
-  case 55:
-#line 636 "fortran.y"
+            if ( inside_type_declare ) break;
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+    break;
+
+  case 147:
+/* Line 1807 of yacc.c  */
+#line 835 "fortran.y"
     {
-                     if ( couldaddvariable == 1 )
-                     {
-                        if ( insubroutinedeclare == 0 )
-                                                  Add_GlobalParameter_Var_1((yyvsp[(2) - (2)].l));
-                         else Add_Parameter_Var_1((yyvsp[(2) - (2)].l));
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                    pos_end-pos_cur_decl);
-                      }
-                      VariableIsParameter =  0 ;
-                   ;}
-    break;
-
-  case 57:
-#line 650 "fortran.y"
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",(yyvsp[(2) - (3)].na));
+            Add_NameOfCommon_1((yyvsp[(2) - (3)].na),subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+    break;
+
+  case 148:
+/* Line 1807 of yacc.c  */
+#line 843 "fortran.y"
     {
-                     pos_end = setposcur();
-                     RemoveWordSET_0(fortranout,pos_cursave,
-                                                pos_end-pos_cursave);
-                  ;}
-    break;
-
-  case 59:
-#line 657 "fortran.y"
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",(yyvsp[(3) - (5)].na));
+            Add_NameOfCommon_1((yyvsp[(3) - (5)].na),subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+    break;
+
+  case 149:
+/* Line 1807 of yacc.c  */
+#line 852 "fortran.y"
+    { positioninblock = 0; pos_curcommon = setposcur()-6;   }
+    break;
+
+  case 150:
+/* Line 1807 of yacc.c  */
+#line 853 "fortran.y"
+    { positioninblock = 0; pos_curcommon = setposcur()-6-7; }
+    break;
+
+  case 151:
+/* Line 1807 of yacc.c  */
+#line 856 "fortran.y"
+    { if ( ! inside_type_declare ) Add_Common_var_1(); }
+    break;
+
+  case 152:
+/* Line 1807 of yacc.c  */
+#line 857 "fortran.y"
+    { if ( ! inside_type_declare ) Add_Common_var_1(); }
+    break;
+
+  case 153:
+/* Line 1807 of yacc.c  */
+#line 861 "fortran.y"
     {
-                   /* if the variable is a parameter we can suppose that is   */
-                   /*    value is the same on each grid. It is not useless to */
-                   /*    create a copy of it on each grid                     */
-                      if ( couldaddvariable == 1 )
-                      {
-                         Add_Globliste_1((yyvsp[(1) - (1)].l));
-                         /* if variableparamlists has been declared in a      */
-                         /*    subroutine                                     */
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            Add_Dimension_Var_1((yyvsp[(1) - (1)].l));
-                         }
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curdimension,
-                                                pos_end-pos_curdimension);
-                      }
-                      /*                                                      */
-                      PublicDeclare = 0;
-                      PrivateDeclare = 0;
-                      ExternalDeclare = 0;
-                      strcpy(NamePrecision,"");
-                      c_star = 0;
-                      strcpy(InitialValueGiven," ");
-                      strcpy(IntentSpec,"");
-                      VariableIsParameter =  0 ;
-                      Allocatabledeclare = 0 ;
-                      Targetdeclare = 0 ;
-                      SaveDeclare = 0;
-                      pointerdeclare = 0;
-                      optionaldeclare = 0 ;
-                      dimsgiven=0;
-                      c_selectorgiven=0;
-                      strcpy(nameinttypename,"");
-                      strcpy(c_selectorname,"");
-                   ;}
-    break;
-
-  case 60:
-#line 694 "fortran.y"
+            positioninblock = positioninblock + 1 ;
+            strcpy(commonvar,(yyvsp[(1) - (2)].na));
+            commondim = (yyvsp[(2) - (2)].d);
+        }
+    break;
+
+  case 154:
+/* Line 1807 of yacc.c  */
+#line 869 "fortran.y"
     {
-      if (firstpass == 0)
-      {
-      if ((yyvsp[(1) - (1)].lnn))
-      {
-      removeglobfromlist(&((yyvsp[(1) - (1)].lnn)));
-      pos_end = setposcur();
-           RemoveWordSET_0(fortranout,pos_cur,pos_end-pos_cur);
-      writelistpublic((yyvsp[(1) - (1)].lnn));
-      }
-      }
-      ;}
-    break;
-
-  case 70:
-#line 716 "fortran.y"
+            strcpy((yyval.na),"");
+            positioninblock=0;
+            strcpy(commonblockname,"");
+        }
+    break;
+
+  case 155:
+/* Line 1807 of yacc.c  */
+#line 875 "fortran.y"
     {
-                      /* we should remove the data declaration                */
-                      if ( couldaddvariable == 1 && aftercontainsdeclare != 2 )
-                      {
-                        pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_curdata,
-                                              pos_end-pos_curdata);
-                      }
-                      if ( couldaddvariable == 1 && aftercontainsdeclare == 1 )
-                      {
-                      if (firstpass == 0)
-                      {
-                        ReWriteDataStatement_0(fortranout);
-                        pos_end = setposcur();
-                  }
-                      }
-                  ;}
-    break;
-
-  case 72:
-#line 736 "fortran.y"
+            strcpy((yyval.na),(yyvsp[(2) - (3)].na));
+            positioninblock=0;
+            strcpy(commonblockname,(yyvsp[(2) - (3)].na));
+        }
+    break;
+
+  case 158:
+/* Line 1807 of yacc.c  */
+#line 885 "fortran.y"
+    { (yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v)); }
+    break;
+
+  case 159:
+/* Line 1807 of yacc.c  */
+#line 886 "fortran.y"
+    { (yyval.l)=insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v));   }
+    break;
+
+  case 160:
+/* Line 1807 of yacc.c  */
+#line 890 "fortran.y"
     {
-         PublicDeclare = 0 ;
-         PrivateDeclare = 0 ;
-      ;}
-    break;
-
-  case 110:
-#line 787 "fortran.y"
+            if ( inside_type_declare ) break;
+            curvar=(variable *) calloc(1,sizeof(variable));
+            Init_Variable(curvar);
+            curvar->v_VariableIsParameter = 1;
+            strcpy(curvar->v_nomvar,(yyvsp[(1) - (3)].na));
+            strcpy(curvar->v_subroutinename,subroutinename);
+            strcpy(curvar->v_modulename,curmodulename);
+            strcpy(curvar->v_initialvalue,(yyvsp[(3) - (3)].na));
+            strcpy(curvar->v_commoninfile,cur_filename);
+            Save_Length((yyvsp[(3) - (3)].na),14);
+            (yyval.v) = curvar;
+        }
+    break;
+
+  case 164:
+/* Line 1807 of yacc.c  */
+#line 913 "fortran.y"
     {
-                      /* if the variable is a parameter we can suppose that is*/
-                      /*    value is the same on each grid. It is not useless */
-                      /*    to create a copy of it on each grid               */
-                      if ( couldaddvariable == 1 )
-                      {
-                      pos_end = setposcur();
-                      /*if (insubroutinedeclare == 0)
-                        {   */
-                         RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                 pos_end-pos_cur_decl);
-                                         
-                       /* }
-                      else
-                       {*/
-                        ReWriteDeclarationAndAddTosubroutine_01((yyvsp[(1) - (2)].l));
-                        pos_cur_decl = setposcur();
-                        
-                       /*}*/
-                      if ( firstpass == 0 &&
-                           GlobalDeclaration == 0 &&
-                           insubroutinedeclare == 0 )
-                      {
-
-                         sprintf(ligne,"\n#include \"Module_Declar_%s.h\"\n"
-                                                                ,curmodulename);
-                         tofich(fortranout,ligne,1);
-                         sprintf (ligne, "Module_Declar_%s.h",curmodulename);
-                         module_declar = associate(ligne);
-                         sprintf (ligne, " ");
-                         tofich (module_declar, ligne,1);
-                         GlobalDeclaration = 1 ;
-                         pos_cur_decl = setposcur();
-
-                      }
-                         (yyval.l) = (yyvsp[(1) - (2)].l);
-                         Add_Globliste_1((yyvsp[(1) - (2)].l));
-                                                  
-                         if ( insubroutinedeclare == 0 )
-                                                  Add_GlobalParameter_Var_1((yyvsp[(1) - (2)].l));
-                         else
-                         {
-                            if ( pointerdeclare == 1 )
-                                                Add_Pointer_Var_From_List_1((yyvsp[(1) - (2)].l));
-                            Add_Parameter_Var_1((yyvsp[(1) - (2)].l));
-                         }
-
-                         /* if variables has been declared in a subroutine    */
-                         if ( insubroutinedeclare == 1 )
-                         { 
-                       /*    Add_SubroutineDeclaration_Var_1($1);*/
-                         }
-                         /* If there are a SAVE declarations in module's      */
-                         /*    subroutines we should remove it from the       */
-                         /*    subroutines declaration and add it in the      */
-                         /*    global declarations                            */
-                         if ( aftercontainsdeclare == 1 &&
-                              SaveDeclare == 1 && firstpass == 1 )
-                         {
-                              if ( inmodulemeet == 0 ) Add_Save_Var_dcl_1((yyvsp[(1) - (2)].l));
-                              else  Add_SubroutineDeclarationSave_Var_1((yyvsp[(1) - (2)].l));
-                         }
-                      }
-                      /*                                                      */
-                      PublicDeclare = 0;
-                      PrivateDeclare = 0;
-                      ExternalDeclare = 0;
-                      strcpy(NamePrecision,"");
-                      c_star = 0;
-                      strcpy(InitialValueGiven," ");
-                      strcpy(IntentSpec,"");
-                      VariableIsParameter =  0 ;
-                      Allocatabledeclare = 0 ;
-                      Targetdeclare = 0 ;
-                      SaveDeclare = 0;
-                      pointerdeclare = 0;
-                      optionaldeclare = 0 ;
-                      dimsgiven=0;
-                      c_selectorgiven=0;
-                      strcpy(nameinttypename,"");
-                      strcpy(c_selectorname,"");
-                      GlobalDeclarationType = 0; 
-                   ;}
-    break;
-
-  case 111:
-#line 871 "fortran.y"
-    {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(2) - (3)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,(yyvsp[(2) - (3)].nac));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
-                         Add_FunctionType_Var_1((yyvsp[(2) - (3)].nac));
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
-                         Add_FunctionType_Var_1((yyvsp[(2) - (3)].nac));
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      strcpy(nameinttypename,"");
-
-                   ;}
-    break;
-
-  case 112:
-#line 908 "fortran.y"
-    {
-                       functiondeclarationisdone = 1;
-                   ;}
-    break;
-
-  case 113:
-#line 914 "fortran.y"
-    {
-                      VariableIsParameter = 1;
-                      pos_curparameter = setposcur()-9;
-                   ;}
-    break;
-
-  case 114:
-#line 919 "fortran.y"
-    {
-                      pos_curdata = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                      Init_List_Data_Var();
-                   ;}
-    break;
-
-  case 115:
+            if ( insubroutinedeclare == 1 )
+            {
+                Add_ImplicitNoneSubroutine_1();
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_end-13,13);
+            }
+        }
+    break;
+
+  case 166:
+/* Line 1807 of yacc.c  */
 #line 924 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-/*                      if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
-                      else */
-/*                      sprintf(ligne,"%s",$3);*/
-                      createstringfromlistname(ligne,(yyvsp[(3) - (4)].lnn));
-                      if (firstpass == 1)
-                      Add_Data_Var_1(&List_Data_Var,(yyvsp[(1) - (4)].nac),ligne);
-                      else
-                      Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(1) - (4)].nac),ligne);
-                      }
-                   ;}
-    break;
-
-  case 116:
-#line 938 "fortran.y"
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar((yyvsp[(2) - (5)].na),curdim);
+                else                curvar = createvar((yyvsp[(2) - (5)].na),(yyvsp[(3) - (5)].d));
+                CreateAndFillin_Curvar(DeclType, curvar);
+                curlistvar = insertvar(NULL, curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                (yyval.l)=settype(DeclType,curlistvar);
+            }
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 167:
+/* Line 1807 of yacc.c  */
+#line 946 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                      /*if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
-                      else */
-                      /*sprintf(ligne,"%s",$5);   */
-                      createstringfromlistname(ligne,(yyvsp[(5) - (6)].lnn));                      
-                      if (firstpass == 1)                      
-                      Add_Data_Var_1(&List_Data_Var,(yyvsp[(3) - (6)].nac),ligne);
-                      else
-                      Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(3) - (6)].nac),ligne);                      
-                      }
-                   ;}
-    break;
-
-  case 117:
-#line 952 "fortran.y"
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar((yyvsp[(3) - (6)].na), curdim);
+                else                curvar = createvar((yyvsp[(3) - (6)].na), (yyvsp[(4) - (6)].d));
+                CreateAndFillin_Curvar((yyvsp[(1) - (6)].l)->var->v_typevar,curvar);
+                strcpy(curvar->v_typevar, (yyvsp[(1) - (6)].l)->var->v_typevar);
+                curvar->v_catvar = get_cat_var(curvar);
+                curlistvar = insertvar((yyvsp[(1) - (6)].l), curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                (yyval.l)=curlistvar;
+            }
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 168:
+/* Line 1807 of yacc.c  */
+#line 970 "fortran.y"
+    { dimsgiven = 0; }
+    break;
+
+  case 169:
+/* Line 1807 of yacc.c  */
+#line 972 "fortran.y"
+    { strcpy(DeclType,(yyvsp[(1) - (2)].na));  }
+    break;
+
+  case 170:
+/* Line 1807 of yacc.c  */
+#line 973 "fortran.y"
+    { strcpy(DeclType,"character");  }
+    break;
+
+  case 171:
+/* Line 1807 of yacc.c  */
+#line 974 "fortran.y"
+    { strcpy(DeclType,(yyvsp[(1) - (3)].na)); strcpy(nameinttypename,(yyvsp[(3) - (3)].na));  }
+    break;
+
+  case 172:
+/* Line 1807 of yacc.c  */
+#line 975 "fortran.y"
+    { strcpy(DeclType,"type"); GlobalDeclarationType = 1;  }
+    break;
+
+  case 174:
+/* Line 1807 of yacc.c  */
+#line 978 "fortran.y"
+    { c_selectorgiven = 1; strcpy(c_selectorname,(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 175:
+/* Line 1807 of yacc.c  */
+#line 979 "fortran.y"
+    { c_star = 1;}
+    break;
+
+  case 180:
+/* Line 1807 of yacc.c  */
+#line 987 "fortran.y"
+    { pos_cur_decl = setposcur()-9; }
+    break;
+
+  case 181:
+/* Line 1807 of yacc.c  */
+#line 990 "fortran.y"
+    { strcpy((yyval.na),"integer"); pos_cur_decl = setposcur()-7; }
+    break;
+
+  case 182:
+/* Line 1807 of yacc.c  */
+#line 991 "fortran.y"
+    { strcpy((yyval.na),"logical"); pos_cur_decl = setposcur()-7; }
+    break;
+
+  case 183:
+/* Line 1807 of yacc.c  */
+#line 992 "fortran.y"
+    { strcpy((yyval.na),"real");    pos_cur_decl = setposcur()-4; }
+    break;
+
+  case 184:
+/* Line 1807 of yacc.c  */
+#line 993 "fortran.y"
+    { strcpy((yyval.na),"complex"); pos_cur_decl = setposcur()-7; }
+    break;
+
+  case 185:
+/* Line 1807 of yacc.c  */
+#line 994 "fortran.y"
+    { strcpy((yyval.na),"double complex"); pos_cur_decl = setposcur()-14; }
+    break;
+
+  case 186:
+/* Line 1807 of yacc.c  */
+#line 995 "fortran.y"
+    { pos_cur_decl = setposcur()-16; strcpy((yyval.na),"real"); strcpy(nameinttypename,"8"); }
+    break;
+
+  case 188:
+/* Line 1807 of yacc.c  */
+#line 998 "fortran.y"
+    {strcpy(vallengspec,(yyvsp[(2) - (2)].na));}
+    break;
+
+  case 189:
+/* Line 1807 of yacc.c  */
+#line 1001 "fortran.y"
+    { sprintf((yyval.na),"*%s",(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 190:
+/* Line 1807 of yacc.c  */
+#line 1002 "fortran.y"
+    { strcpy((yyval.na),"*(*)"); }
+    break;
+
+  case 197:
+/* Line 1807 of yacc.c  */
+#line 1014 "fortran.y"
     {
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       if (firstpass == 1)
-                       Add_Data_Var_Names_01(&List_Data_Var,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
-                       else
-                       Add_Data_Var_Names_01(&List_Data_Var_Cur,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
-                   ;}
-    break;
-
-  case 118:
-#line 967 "fortran.y"
+            if ( strstr((yyvsp[(3) - (3)].na),"0.d0") )
+            {
+                strcpy(nameinttypename,"8");
+                strcpy(NamePrecision,"");
+            }
+            else
+                sprintf(NamePrecision,"%s = %s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));
+        }
+    break;
+
+  case 198:
+/* Line 1807 of yacc.c  */
+#line 1023 "fortran.y"
+    { strcpy(NamePrecision,(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 199:
+/* Line 1807 of yacc.c  */
+#line 1024 "fortran.y"
+    { strcpy(NamePrecision,(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 200:
+/* Line 1807 of yacc.c  */
+#line 1025 "fortran.y"
+    { strcpy(NamePrecision,(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 201:
+/* Line 1807 of yacc.c  */
+#line 1028 "fortran.y"
+    { strcpy(CharacterSize,(yyvsp[(1) - (1)].na));  strcpy((yyval.na),(yyvsp[(1) - (1)].na));  }
+    break;
+
+  case 202:
+/* Line 1807 of yacc.c  */
+#line 1029 "fortran.y"
+    { strcpy(CharacterSize,"*"); strcpy((yyval.na),"*"); }
+    break;
+
+  case 210:
+/* Line 1807 of yacc.c  */
+#line 1042 "fortran.y"
+    { VariableIsParameter = 1; }
+    break;
+
+  case 212:
+/* Line 1807 of yacc.c  */
+#line 1044 "fortran.y"
+    { Allocatabledeclare = 1; }
+    break;
+
+  case 213:
+/* Line 1807 of yacc.c  */
+#line 1045 "fortran.y"
+    { dimsgiven = 1; curdim = (yyvsp[(2) - (2)].d); }
+    break;
+
+  case 214:
+/* Line 1807 of yacc.c  */
+#line 1046 "fortran.y"
+    { ExternalDeclare = 1; }
+    break;
+
+  case 215:
+/* Line 1807 of yacc.c  */
+#line 1048 "fortran.y"
+    { strcpy(IntentSpec,(yyvsp[(3) - (4)].na)); }
+    break;
+
+  case 217:
+/* Line 1807 of yacc.c  */
+#line 1050 "fortran.y"
+    { optionaldeclare = 1 ; }
+    break;
+
+  case 218:
+/* Line 1807 of yacc.c  */
+#line 1051 "fortran.y"
+    { pointerdeclare = 1 ; }
+    break;
+
+  case 219:
+/* Line 1807 of yacc.c  */
+#line 1052 "fortran.y"
+    { SaveDeclare = 1 ; }
+    break;
+
+  case 220:
+/* Line 1807 of yacc.c  */
+#line 1053 "fortran.y"
+    { Targetdeclare = 1; }
+    break;
+
+  case 221:
+/* Line 1807 of yacc.c  */
+#line 1056 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 222:
+/* Line 1807 of yacc.c  */
+#line 1057 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 223:
+/* Line 1807 of yacc.c  */
+#line 1058 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 224:
+/* Line 1807 of yacc.c  */
+#line 1061 "fortran.y"
+    { PublicDeclare = 1;  }
+    break;
+
+  case 225:
+/* Line 1807 of yacc.c  */
+#line 1062 "fortran.y"
+    { PrivateDeclare = 1; }
+    break;
+
+  case 226:
+/* Line 1807 of yacc.c  */
+#line 1064 "fortran.y"
+    { (yyval.d) = (listdim*) NULL; }
+    break;
+
+  case 227:
+/* Line 1807 of yacc.c  */
+#line 1066 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0);
-                      }
-                   ;}
-    break;
-
-  case 119:
-#line 974 "fortran.y"
+            (yyval.d) = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  (yyval.d)=(yyvsp[(2) - (3)].d);
+        }
+    break;
+
+  case 228:
+/* Line 1807 of yacc.c  */
+#line 1074 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         (yyval.lnn) = Insertname((yyvsp[(3) - (3)].lnn),(yyvsp[(1) - (3)].na),1);
-                      }
-                   ;}
-    break;
-
-  case 124:
-#line 988 "fortran.y"
+            (yyval.d) = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  (yyval.d)=insertdim(NULL,(yyvsp[(1) - (1)].dim1));
+        }
+    break;
+
+  case 229:
+/* Line 1807 of yacc.c  */
+#line 1080 "fortran.y"
     {
-                     pos_cursave = setposcur()-4;
-                  ;}
-    break;
-
-  case 126:
-#line 994 "fortran.y"
+            (yyval.d) = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( (!inside_type_declare) && created_dimensionlist == 1 ) (yyval.d)=insertdim((yyvsp[(1) - (3)].d),(yyvsp[(3) - (3)].dim1));
+        }
+    break;
+
+  case 230:
+/* Line 1807 of yacc.c  */
+#line 1086 "fortran.y"
+    { strcpy((yyval.dim1).first,"1"); strcpy((yyval.dim1).last,(yyvsp[(1) - (1)].na)); Save_Length((yyvsp[(1) - (1)].na),1); }
+    break;
+
+  case 231:
+/* Line 1807 of yacc.c  */
+#line 1087 "fortran.y"
+    { strcpy((yyval.dim1).first,"");  strcpy((yyval.dim1).last,"");                    }
+    break;
+
+  case 232:
+/* Line 1807 of yacc.c  */
+#line 1088 "fortran.y"
+    { strcpy((yyval.dim1).first,(yyvsp[(1) - (2)].na));  Save_Length((yyvsp[(1) - (2)].na),2); strcpy((yyval.dim1).last,""); }
+    break;
+
+  case 233:
+/* Line 1807 of yacc.c  */
+#line 1089 "fortran.y"
+    { strcpy((yyval.dim1).first,"");  strcpy((yyval.dim1).last,(yyvsp[(2) - (2)].na)); Save_Length((yyvsp[(2) - (2)].na),1); }
+    break;
+
+  case 234:
+/* Line 1807 of yacc.c  */
+#line 1090 "fortran.y"
+    { strcpy((yyval.dim1).first,(yyvsp[(1) - (3)].na));  Save_Length((yyvsp[(1) - (3)].na),2); strcpy((yyval.dim1).last,(yyvsp[(3) - (3)].na)); Save_Length((yyvsp[(3) - (3)].na),1); }
+    break;
+
+  case 235:
+/* Line 1807 of yacc.c  */
+#line 1093 "fortran.y"
+    { strcpy((yyval.na),"*"); }
+    break;
+
+  case 236:
+/* Line 1807 of yacc.c  */
+#line 1094 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));  }
+    break;
+
+  case 237:
+/* Line 1807 of yacc.c  */
+#line 1096 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 238:
+/* Line 1807 of yacc.c  */
+#line 1097 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 239:
+/* Line 1807 of yacc.c  */
+#line 1098 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 240:
+/* Line 1807 of yacc.c  */
+#line 1099 "fortran.y"
+    { sprintf((yyval.na),"(%s)",(yyvsp[(2) - (3)].na)); }
+    break;
+
+  case 241:
+/* Line 1807 of yacc.c  */
+#line 1103 "fortran.y"
+    { sprintf((yyval.na),"SUM(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 242:
+/* Line 1807 of yacc.c  */
+#line 1104 "fortran.y"
+    { sprintf((yyval.na),"MAX(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 243:
+/* Line 1807 of yacc.c  */
+#line 1105 "fortran.y"
+    { sprintf((yyval.na),"TANH(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 244:
+/* Line 1807 of yacc.c  */
+#line 1106 "fortran.y"
+    { sprintf((yyval.na),"MAXVAL(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 245:
+/* Line 1807 of yacc.c  */
+#line 1107 "fortran.y"
+    { sprintf((yyval.na),"MIN(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 246:
+/* Line 1807 of yacc.c  */
+#line 1108 "fortran.y"
+    { sprintf((yyval.na),"MINVAL(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 247:
+/* Line 1807 of yacc.c  */
+#line 1109 "fortran.y"
+    { sprintf((yyval.na),"TRIM(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 248:
+/* Line 1807 of yacc.c  */
+#line 1110 "fortran.y"
+    { sprintf((yyval.na),"SQRT(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 249:
+/* Line 1807 of yacc.c  */
+#line 1111 "fortran.y"
+    { sprintf((yyval.na),"REAL(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 250:
+/* Line 1807 of yacc.c  */
+#line 1112 "fortran.y"
+    { sprintf((yyval.na),"NINT(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 251:
+/* Line 1807 of yacc.c  */
+#line 1113 "fortran.y"
+    { sprintf((yyval.na),"FLOAT(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 252:
+/* Line 1807 of yacc.c  */
+#line 1114 "fortran.y"
+    { sprintf((yyval.na),"EXP(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 253:
+/* Line 1807 of yacc.c  */
+#line 1115 "fortran.y"
+    { sprintf((yyval.na),"COS(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 254:
+/* Line 1807 of yacc.c  */
+#line 1116 "fortran.y"
+    { sprintf((yyval.na),"COSH(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 255:
+/* Line 1807 of yacc.c  */
+#line 1117 "fortran.y"
+    { sprintf((yyval.na),"ACOS(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 256:
+/* Line 1807 of yacc.c  */
+#line 1118 "fortran.y"
+    { sprintf((yyval.na),"SIN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 257:
+/* Line 1807 of yacc.c  */
+#line 1119 "fortran.y"
+    { sprintf((yyval.na),"SINH(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 258:
+/* Line 1807 of yacc.c  */
+#line 1120 "fortran.y"
+    { sprintf((yyval.na),"ASIN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 259:
+/* Line 1807 of yacc.c  */
+#line 1121 "fortran.y"
+    { sprintf((yyval.na),"LOG(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 260:
+/* Line 1807 of yacc.c  */
+#line 1122 "fortran.y"
+    { sprintf((yyval.na),"TAN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 261:
+/* Line 1807 of yacc.c  */
+#line 1123 "fortran.y"
+    { sprintf((yyval.na),"ATAN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 262:
+/* Line 1807 of yacc.c  */
+#line 1124 "fortran.y"
+    { sprintf((yyval.na),"ABS(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 263:
+/* Line 1807 of yacc.c  */
+#line 1125 "fortran.y"
+    { sprintf((yyval.na),"MOD(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 264:
+/* Line 1807 of yacc.c  */
+#line 1126 "fortran.y"
+    { sprintf((yyval.na),"SIGN(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 265:
+/* Line 1807 of yacc.c  */
+#line 1127 "fortran.y"
+    { sprintf((yyval.na),"MINLOC(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 266:
+/* Line 1807 of yacc.c  */
+#line 1128 "fortran.y"
+    { sprintf((yyval.na),"MAXLOC(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 267:
+/* Line 1807 of yacc.c  */
+#line 1130 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 268:
+/* Line 1807 of yacc.c  */
+#line 1131 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 269:
+/* Line 1807 of yacc.c  */
+#line 1133 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 270:
+/* Line 1807 of yacc.c  */
+#line 1134 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 271:
+/* Line 1807 of yacc.c  */
+#line 1135 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 272:
+/* Line 1807 of yacc.c  */
+#line 1136 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 273:
+/* Line 1807 of yacc.c  */
+#line 1137 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 274:
+/* Line 1807 of yacc.c  */
+#line 1138 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 275:
+/* Line 1807 of yacc.c  */
+#line 1140 "fortran.y"
+    { strcpy((yyval.na),"+"); }
+    break;
+
+  case 276:
+/* Line 1807 of yacc.c  */
+#line 1141 "fortran.y"
+    { strcpy((yyval.na),"-"); }
+    break;
+
+  case 277:
+/* Line 1807 of yacc.c  */
+#line 1145 "fortran.y"
+    { sprintf((yyval.na),"+%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 278:
+/* Line 1807 of yacc.c  */
+#line 1146 "fortran.y"
+    { sprintf((yyval.na),"-%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 279:
+/* Line 1807 of yacc.c  */
+#line 1147 "fortran.y"
+    { sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 280:
+/* Line 1807 of yacc.c  */
+#line 1148 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 281:
+/* Line 1807 of yacc.c  */
+#line 1149 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 282:
+/* Line 1807 of yacc.c  */
+#line 1150 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 283:
+/* Line 1807 of yacc.c  */
+#line 1151 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 284:
+/* Line 1807 of yacc.c  */
+#line 1152 "fortran.y"
+    { sprintf((yyval.na)," > %s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 285:
+/* Line 1807 of yacc.c  */
+#line 1153 "fortran.y"
+    { sprintf((yyval.na)," < %s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 286:
+/* Line 1807 of yacc.c  */
+#line 1154 "fortran.y"
+    { sprintf((yyval.na)," >= %s",(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 287:
+/* Line 1807 of yacc.c  */
+#line 1155 "fortran.y"
+    { sprintf((yyval.na)," <= %s",(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 288:
+/* Line 1807 of yacc.c  */
+#line 1156 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 289:
+/* Line 1807 of yacc.c  */
+#line 1157 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 290:
+/* Line 1807 of yacc.c  */
+#line 1158 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 291:
+/* Line 1807 of yacc.c  */
+#line 1159 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 292:
+/* Line 1807 of yacc.c  */
+#line 1160 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 293:
+/* Line 1807 of yacc.c  */
+#line 1161 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 294:
+/* Line 1807 of yacc.c  */
+#line 1162 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 295:
+/* Line 1807 of yacc.c  */
+#line 1163 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 296:
+/* Line 1807 of yacc.c  */
+#line 1164 "fortran.y"
+    { sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 297:
+/* Line 1807 of yacc.c  */
+#line 1165 "fortran.y"
+    { sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 298:
+/* Line 1807 of yacc.c  */
+#line 1167 "fortran.y"
+    { strcpy((yyval.na),""); }
+    break;
+
+  case 299:
+/* Line 1807 of yacc.c  */
+#line 1168 "fortran.y"
+    { sprintf((yyval.na),"/%s",(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 300:
+/* Line 1807 of yacc.c  */
+#line 1169 "fortran.y"
+    { sprintf((yyval.na),"/= %s",(yyvsp[(2) - (2)].na));}
+    break;
+
+  case 301:
+/* Line 1807 of yacc.c  */
+#line 1170 "fortran.y"
+    { sprintf((yyval.na),"//%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 302:
+/* Line 1807 of yacc.c  */
+#line 1173 "fortran.y"
+    { sprintf((yyval.na),"==%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 303:
+/* Line 1807 of yacc.c  */
+#line 1174 "fortran.y"
+    { sprintf((yyval.na),"= %s",(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 304:
+/* Line 1807 of yacc.c  */
+#line 1177 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 305:
+/* Line 1807 of yacc.c  */
+#line 1178 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 306:
+/* Line 1807 of yacc.c  */
+#line 1179 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 307:
+/* Line 1807 of yacc.c  */
+#line 1183 "fortran.y"
     {
-                     if ( couldaddvariable == 1 ) Add_Save_Var_1((yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].d));
-                  ;}
-    break;
-
-  case 127:
-#line 999 "fortran.y"
+            agrif_parentcall = 0;
+            if ( !strcasecmp(identcopy, "Agrif_Parent") )   agrif_parentcall = 1;
+            if ( Agrif_in_Tok_NAME(identcopy) )
+            {
+                inagrifcallargument = 1;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+    break;
+
+  case 308:
+/* Line 1807 of yacc.c  */
+#line 1194 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); if ( incalldeclare == 0 ) inagrifcallargument = 0;   }
+    break;
+
+  case 309:
+/* Line 1807 of yacc.c  */
+#line 1195 "fortran.y"
+    { sprintf((yyval.na)," %s %s ",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 310:
+/* Line 1807 of yacc.c  */
+#line 1196 "fortran.y"
+    { sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na)); }
+    break;
+
+  case 311:
+/* Line 1807 of yacc.c  */
+#line 1197 "fortran.y"
+    { sprintf((yyval.na)," %s ( %s ) %s ",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na)); }
+    break;
+
+  case 312:
+/* Line 1807 of yacc.c  */
+#line 1201 "fortran.y"
     {
-		(yyval.lnn)=Insertname(NULL,(yyvsp[(1) - (1)].nac),0);
-		;}
-    break;
-
-  case 128:
-#line 1003 "fortran.y"
+            if ( inside_type_declare ) break;
+            sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na));
+            ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].na));
+            agrif_parentcall = 0;
+        }
+    break;
+
+  case 313:
+/* Line 1807 of yacc.c  */
+#line 1210 "fortran.y"
     {
-      printf("INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n");
-      exit(0);
-      ;}
-    break;
-
-  case 129:
-#line 1008 "fortran.y"
-    {
-      (yyval.lnn) = concat_listname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].lnn));
-      ;}
-    break;
-
-  case 130:
-#line 1013 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].nac));;}
-    break;
-
-  case 131:
-#line 1015 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s+%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 132:
-#line 1017 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s-%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 133:
-#line 1019 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s*%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 134:
-#line 1021 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s/%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 135:
-#line 1024 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"");;}
-    break;
-
-  case 136:
-#line 1026 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 143:
-#line 1038 "fortran.y"
-    {
-	ininterfacedeclare = 1 ;
-	printf("INTEFACE entree\n");
-	;}
-    break;
-
-  case 144:
-#line 1043 "fortran.y"
-    {
-      ininterfacedeclare = 0;
-      ;}
-    break;
-
-  case 145:
-#line 1048 "fortran.y"
-    {
-                      positioninblock=0;
-                      pos_curdimension = setposcur()-9;
-                   ;}
-    break;
-
-  case 146:
-#line 1054 "fortran.y"
-    {
-         if ( couldaddvariable == 1 )
-         {
-            /*                                                                */
-            curvar=createvar((yyvsp[(3) - (5)].nac),(yyvsp[(4) - (5)].d));
-            /*                                                                */
-            CreateAndFillin_Curvar("",curvar);
-            /*                                                                */
-            curlistvar=insertvar(NULL,curvar);
-            /*                                                                */
-            (yyval.l)=settype("",curlistvar);
-            /*                                                                */
-            strcpy(vallengspec,"");
-         }
-      ;}
-    break;
-
-  case 147:
-#line 1070 "fortran.y"
-    {
-         if ( couldaddvariable == 1 )
-         {
-            /*                                                                */
-            curvar=createvar((yyvsp[(3) - (5)].nac),(yyvsp[(4) - (5)].d));
-            /*                                                                */
-            CreateAndFillin_Curvar("",curvar);
-            /*                                                                */
-            curlistvar=insertvar((yyvsp[(1) - (5)].l),curvar);
-            /*                                                                */
-            (yyval.l)=curlistvar;
-            /*                                                                */
-            strcpy(vallengspec,"");
-         }
-      ;}
-    break;
-
-  case 150:
-#line 1090 "fortran.y"
-    {
-        (yyval.lnn)=(listname *)NULL;
-        ;}
-    break;
-
-  case 151:
-#line 1094 "fortran.y"
-    {
-          (yyval.lnn)=(yyvsp[(3) - (3)].lnn);
-         ;}
-    break;
-
-  case 152:
-#line 1099 "fortran.y"
-    {
-           (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].nac),0);
-           ;}
-    break;
-
-  case 153:
-#line 1103 "fortran.y"
-    {
-          (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].nac),0);
-          ;}
-    break;
-
-  case 154:
-#line 1108 "fortran.y"
-    {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcommon,
-                                                  pos_end-pos_curcommon);
-                   ;}
-    break;
-
-  case 155:
-#line 1114 "fortran.y"
-    {
-                         if ( couldaddvariable == 1 )
-                         {
-                            sprintf(charusemodule,"%s",(yyvsp[(2) - (3)].nac));
-                            Add_NameOfCommon_1((yyvsp[(2) - (3)].nac),subroutinename);
-                            pos_end = setposcur();
-                            RemoveWordSET_0(fortranout,pos_curcommon,
-                                                       pos_end-pos_curcommon);
-                         }
-                   ;}
-    break;
-
-  case 156:
-#line 1125 "fortran.y"
-    {
-                         if ( couldaddvariable == 1 )
-                         {
-                            sprintf(charusemodule,"%s",(yyvsp[(3) - (5)].nac));
-                            Add_NameOfCommon_1((yyvsp[(3) - (5)].nac),subroutinename);
-                            pos_end = setposcur();
-                            RemoveWordSET_0(fortranout,pos_curcommon,
-                                                       pos_end-pos_curcommon);
-                         }
-                   ;}
-    break;
-
-  case 157:
-#line 1137 "fortran.y"
-    {
-                      positioninblock=0;
-                      pos_curcommon = setposcur()-6;
-                   ;}
-    break;
-
-  case 158:
-#line 1142 "fortran.y"
-    {
-                      positioninblock=0;
-                      pos_curcommon = setposcur()-6-7;
-                   ;}
-    break;
-
-  case 159:
-#line 1148 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) Add_Common_var_1();
-                   ;}
-    break;
-
-  case 160:
-#line 1153 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) Add_Common_var_1();
-                   ;}
-    break;
-
-  case 161:
-#line 1157 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         positioninblock = positioninblock + 1 ;
-                         strcpy(commonvar,(yyvsp[(1) - (2)].nac));
-                         commondim = (yyvsp[(2) - (2)].d);
-                      }
-                   ;}
-    break;
-
-  case 162:
-#line 1167 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy((yyval.nac),"");
-                         positioninblock=0;
-                         strcpy(commonblockname,"");
-                      }
-                   ;}
-    break;
-
-  case 163:
-#line 1176 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy((yyval.nac),(yyvsp[(2) - (3)].nac));
-                         positioninblock=0;
-                         strcpy(commonblockname,(yyvsp[(2) - (3)].nac));
-                      }
-                   ;}
-    break;
-
-  case 166:
-#line 1189 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) (yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v));
-                   ;}
-    break;
-
-  case 167:
-#line 1193 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) (yyval.l)=insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v));
-                   ;}
-    break;
-
-  case 168:
-#line 1198 "fortran.y"
-    {
-                     if ( couldaddvariable == 1 )
-                     {
-                         curvar=(variable *) malloc(sizeof(variable));
-                         /*                                                   */
-                         Init_Variable(curvar);
-                         /*                                                   */
-                         curvar->v_VariableIsParameter=1;
-                         strcpy(curvar->v_nomvar,(yyvsp[(1) - (3)].nac));
-                         Save_Length((yyvsp[(1) - (3)].nac),4);
-                         strcpy(curvar->v_subroutinename,subroutinename);
-                         Save_Length(subroutinename,11);
-                         strcpy(curvar->v_modulename,curmodulename);
-                         Save_Length(curmodulename,6);
-                         strcpy(curvar->v_initialvalue,(yyvsp[(3) - (3)].na));
-                         Save_Length((yyvsp[(3) - (3)].na),14);
-                         strcpy(curvar->v_commoninfile,mainfile);
-                         Save_Length(mainfile,10);
-                         (yyval.v)=curvar;
-                      }
-                   ;}
-    break;
-
-  case 172:
-#line 1226 "fortran.y"
-    {
-                       if ( insubroutinedeclare == 1 )
-                       {
-                          Add_ImplicitNoneSubroutine_1();
-                          pos_end = setposcur();
-                          RemoveWordSET_0(fortranout,pos_end-13,
-                                                             13);
-                       }
-                    ;}
-    break;
-
-  case 175:
+            sprintf((yyval.na)," %s %% %s ",(yyvsp[(1) - (4)].na),(yyvsp[(4) - (4)].na));
+            if ( incalldeclare == 0 ) inagrifcallargument = 0;
+        }
+    break;
+
+  case 314:
+/* Line 1807 of yacc.c  */
+#line 1216 "fortran.y"
+    { sprintf((yyval.na),"(/%s/)",(yyvsp[(2) - (3)].na)); }
+    break;
+
+  case 315:
+/* Line 1807 of yacc.c  */
+#line 1219 "fortran.y"
+    { strcpy((yyval.na)," "); }
+    break;
+
+  case 316:
+/* Line 1807 of yacc.c  */
+#line 1220 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 317:
+/* Line 1807 of yacc.c  */
+#line 1223 "fortran.y"
+    {  strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 318:
+/* Line 1807 of yacc.c  */
+#line 1224 "fortran.y"
+    {  sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 319:
+/* Line 1807 of yacc.c  */
+#line 1227 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 320:
+/* Line 1807 of yacc.c  */
+#line 1228 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 321:
+/* Line 1807 of yacc.c  */
+#line 1231 "fortran.y"
+    {  sprintf((yyval.na),"%s :%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));}
+    break;
+
+  case 322:
+/* Line 1807 of yacc.c  */
+#line 1232 "fortran.y"
+    {  sprintf((yyval.na),"%s :%s :%s",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));}
+    break;
+
+  case 323:
+/* Line 1807 of yacc.c  */
+#line 1233 "fortran.y"
+    {  sprintf((yyval.na),":%s :%s",(yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].na));}
+    break;
+
+  case 324:
+/* Line 1807 of yacc.c  */
+#line 1234 "fortran.y"
+    {  sprintf((yyval.na),": : %s",(yyvsp[(3) - (3)].na));}
+    break;
+
+  case 325:
+/* Line 1807 of yacc.c  */
+#line 1235 "fortran.y"
+    {  sprintf((yyval.na),":%s",(yyvsp[(2) - (2)].na));}
+    break;
+
+  case 326:
+/* Line 1807 of yacc.c  */
+#line 1236 "fortran.y"
+    {  sprintf((yyval.na),"%s :",(yyvsp[(1) - (2)].na));}
+    break;
+
+  case 327:
+/* Line 1807 of yacc.c  */
+#line 1237 "fortran.y"
+    {  sprintf((yyval.na),":");}
+    break;
+
+  case 328:
+/* Line 1807 of yacc.c  */
 #line 1240 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         /*                                                   */
-                         if (dimsgiven == 1)
-                         {
-                            curvar=createvar((yyvsp[(3) - (6)].nac),curdim);
-                            GlobalDeclarationType == 0;
-                         }
-                         else
-                         {
-                            curvar=createvar((yyvsp[(3) - (6)].nac),(yyvsp[(4) - (6)].d));
-                         }
-                         /*                                                   */
-                         CreateAndFillin_Curvar(DeclType,curvar);
-                         /*                                                   */
-                         curlistvar=insertvar(NULL,curvar);
-                         if (!strcasecmp(DeclType,"character"))
-                         {
-                            if (c_selectorgiven == 1)
+            if ( afterpercent == 0 )
+            {
+                if ( Agrif_in_Tok_NAME((yyvsp[(1) - (1)].na)) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+                if ( !strcasecmp((yyvsp[(1) - (1)].na),"Agrif_Parent") )   agrif_parentcall = 1;
+                if ( VariableIsFunction((yyvsp[(1) - (1)].na)) )
+                {
+                    if ( inagrifcallargument == 1 )
+                    {
+                        if ( !strcasecmp((yyvsp[(1) - (1)].na),identcopy) )
+                        {
+                            strcpy(sameagrifname,identcopy);
+                            sameagrifargument = 1;
+                        }
+                    }
+                    strcpy(identcopy,(yyvsp[(1) - (1)].na));
+                    pointedvar = 0;
+
+                    if (variscoupled_0((yyvsp[(1) - (1)].na))) strcpy(truename, getcoupledname_0((yyvsp[(1) - (1)].na)));
+                    else                    strcpy(truename, (yyvsp[(1) - (1)].na));
+
+                    if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) )
+                    {
+                        if ( inagrifcallargument == 1 || varispointer_0(truename) == 1 )
+                        {
+                            if ( (IsinListe(List_UsedInSubroutine_Var,(yyvsp[(1) - (1)].na)) == 1) || (inagrifcallargument == 1) )
                             {
-                               strcpy(c_selectordim.first,"1");
-                               strcpy(c_selectordim.last,c_selectorname);
-                               Save_Length(c_selectorname,1);
-                               change_dim_char
-                                     (insertdim(NULL,c_selectordim),curlistvar);
+                                if (varistyped_0(truename) == 0)    ModifyTheVariableName_0(truename,strlen((yyvsp[(1) - (1)].na)));
                             }
-                         }
-                         (yyval.l)=settype(DeclType,curlistvar);
-                      }
-                      strcpy(vallengspec,"");
-                   ;}
-    break;
-
-  case 176:
-#line 1273 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         if (dimsgiven == 1)
-                         {
-                            curvar=createvar((yyvsp[(4) - (7)].nac),curdim);
-                         }
-                         else
-                         {
-                            curvar=createvar((yyvsp[(4) - (7)].nac),(yyvsp[(5) - (7)].d));
-                         }
-                         /*                                                   */
-                         CreateAndFillin_Curvar((yyvsp[(1) - (7)].l)->var->v_typevar,curvar);
-                         /*                                                   */
-                         strcpy(curvar->v_typevar,((yyvsp[(1) - (7)].l)->var->v_typevar));
-                         Save_Length((yyvsp[(1) - (7)].l)->var->v_typevar,3);
-                         /*                                                   */
-                         curlistvar=insertvar((yyvsp[(1) - (7)].l),curvar);
-                         if (!strcasecmp(DeclType,"character"))
-                         {
-                            if (c_selectorgiven == 1)
-                            {
-                               strcpy(c_selectordim.first,"1");
-                               strcpy(c_selectordim.last,c_selectorname);
-                               Save_Length(c_selectorname,1);
-                               change_dim_char
-                                     (insertdim(NULL,c_selectordim),curlistvar);
-                            }
-                         }
-                         (yyval.l)=curlistvar;
-                      }
-                      strcpy(vallengspec,"");
-                   ;}
-    break;
-
-  case 177:
+                        }
+                        if ( inagrifcallargument != 1 || sameagrifargument ==1 )
+                        {
+                            Add_UsedInSubroutine_Var_1(truename);
+                        }
+                    }
+                    NotifyAgrifFunction_0(truename);
+                }
+            }
+            else
+            {
+                afterpercent = 0;
+            }
+        }
+    break;
+
+  case 329:
+/* Line 1807 of yacc.c  */
+#line 1285 "fortran.y"
+    { strcpy((yyval.na),".TRUE.");}
+    break;
+
+  case 330:
+/* Line 1807 of yacc.c  */
+#line 1286 "fortran.y"
+    { strcpy((yyval.na),".FALSE.");}
+    break;
+
+  case 331:
+/* Line 1807 of yacc.c  */
+#line 1287 "fortran.y"
+    { strcpy((yyval.na),"NULL()"); }
+    break;
+
+  case 332:
+/* Line 1807 of yacc.c  */
+#line 1288 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 333:
+/* Line 1807 of yacc.c  */
+#line 1289 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 334:
+/* Line 1807 of yacc.c  */
+#line 1290 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 335:
+/* Line 1807 of yacc.c  */
+#line 1292 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 337:
+/* Line 1807 of yacc.c  */
+#line 1296 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 339:
+/* Line 1807 of yacc.c  */
+#line 1298 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 340:
+/* Line 1807 of yacc.c  */
+#line 1299 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 341:
+/* Line 1807 of yacc.c  */
+#line 1301 "fortran.y"
+    { strcpy((yyval.na)," ");}
+    break;
+
+  case 342:
+/* Line 1807 of yacc.c  */
+#line 1302 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 343:
+/* Line 1807 of yacc.c  */
+#line 1305 "fortran.y"
+    { sprintf((yyval.na),"(%s :%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));}
+    break;
+
+  case 344:
+/* Line 1807 of yacc.c  */
 #line 1307 "fortran.y"
-    {dimsgiven=0;;}
-    break;
-
-  case 178:
-#line 1310 "fortran.y"
-    {strcpy(DeclType,(yyvsp[(1) - (2)].nac));;}
-    break;
-
-  case 179:
+    { strcpy((yyval.na)," ");}
+    break;
+
+  case 345:
+/* Line 1807 of yacc.c  */
+#line 1308 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 346:
+/* Line 1807 of yacc.c  */
+#line 1311 "fortran.y"
+    { strcpy((yyval.na)," ");}
+    break;
+
+  case 347:
+/* Line 1807 of yacc.c  */
 #line 1312 "fortran.y"
-    {
-                      strcpy(DeclType,"CHARACTER");
-                   ;}
-    break;
-
-  case 180:
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 348:
+/* Line 1807 of yacc.c  */
+#line 1314 "fortran.y"
+    { InitialValueGiven = 0; }
+    break;
+
+  case 349:
+/* Line 1807 of yacc.c  */
 #line 1316 "fortran.y"
     {
-                      strcpy(DeclType,(yyvsp[(1) - (3)].nac));
-                      strcpy(nameinttypename,(yyvsp[(3) - (3)].nac));
-                   ;}
-    break;
-
-  case 181:
-#line 1321 "fortran.y"
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,(yyvsp[(2) - (2)].na));
+            InitialValueGiven = 1;
+        }
+    break;
+
+  case 350:
+/* Line 1807 of yacc.c  */
+#line 1322 "fortran.y"
     {
-                      strcpy(DeclType,"TYPE");
-                      GlobalDeclarationType = 1
-                   ;}
-    break;
-
-  case 182:
-#line 1327 "fortran.y"
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,(yyvsp[(2) - (2)].na));
+            InitialValueGiven = 2;
+        }
+    break;
+
+  case 351:
+/* Line 1807 of yacc.c  */
+#line 1329 "fortran.y"
+    {sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 352:
+/* Line 1807 of yacc.c  */
+#line 1333 "fortran.y"
     {
-                 /*     if ( couldaddvariable == 1 ) VarTypepar = 1 ;
-                      couldaddvariable = 0 ;
-                      pos_cur_decl = setposcur()-5;*/
-                   pos_cur_decl = setposcur()-5;
-                   ;}
-    break;
-
-  case 184:
-#line 1336 "fortran.y"
-    {c_selectorgiven=1;strcpy(c_selectorname,(yyvsp[(2) - (2)].nac));;}
-    break;
-
-  case 185:
-#line 1337 "fortran.y"
-    {c_star = 1;;}
-    break;
-
-  case 190:
-#line 1345 "fortran.y"
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule, "%s", (yyvsp[(2) - (2)].na));
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (2)].na));
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuse_0((yyvsp[(2) - (2)].na));
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+    break;
+
+  case 353:
+/* Line 1807 of yacc.c  */
+#line 1353 "fortran.y"
     {
-                      pos_cur_decl = setposcur()-9;
-                   ;}
-    break;
-
-  case 191:
-#line 1349 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 192:
-#line 1352 "fortran.y"
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1((yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].lc));
+                    coupletmp = (yyvsp[(4) - (4)].lc);
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne, coupletmp->c_namevar);
+                        strcat(ligne, " => ");
+                        strcat(ligne, coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",(yyvsp[(2) - (4)].na));
+                }
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (4)].na));
+            }
+            if ( inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+            }
+        }
+    break;
+
+  case 354:
+/* Line 1807 of yacc.c  */
+#line 1380 "fortran.y"
     {
-                      strcpy((yyval.nac),"INTEGER");
-                      pos_cur_decl = setposcur()-7;
-                   ;}
-    break;
-
-  case 193:
-#line 1356 "fortran.y"
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].na));
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].na));
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuseonly_0((yyvsp[(2) - (6)].na));
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+    break;
+
+  case 355:
+/* Line 1807 of yacc.c  */
+#line 1400 "fortran.y"
     {
-                      strcpy((yyval.nac),"REAL");
-                      pos_cur_decl = setposcur()-4;
-                   ;}
-    break;
-
-  case 194:
-#line 1361 "fortran.y"
-    {strcpy((yyval.nac),"COMPLEX");
-                   pos_cur_decl = setposcur()-7;;}
-    break;
-
-  case 195:
-#line 1364 "fortran.y"
+            /* if variables has been declared in a subroutine      */
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1((yyvsp[(2) - (6)].na),(yyvsp[(6) - (6)].lc));
+                    coupletmp = (yyvsp[(6) - (6)].lc);
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne,coupletmp->c_namevar);
+                        if ( strcasecmp(coupletmp->c_namepointedvar,"") )   strcat(ligne," => ");
+                        strcat(ligne,coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].na));
+                }
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].na));
+            }
+            else /* if ( firstpass == 0 ) */
+            {
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                    if (oldfortran_out)  variableisglobalinmodule((yyvsp[(6) - (6)].lc),(yyvsp[(2) - (6)].na),oldfortran_out,pos_curuseold);
+                }
+                else
+                {
+                    /* if we are in the module declare and if the    */
+                    /* onlylist is a list of global variable         */
+                    variableisglobalinmodule((yyvsp[(6) - (6)].lc), (yyvsp[(2) - (6)].na), fortran_out,pos_curuse);
+                }
+            }
+        }
+    break;
+
+  case 356:
+/* Line 1807 of yacc.c  */
+#line 1440 "fortran.y"
     {
-                      pos_cur_decl = setposcur()-16;
-                      strcpy((yyval.nac),"REAL");
-                      strcpy(nameinttypename,"8");
-                   ;}
-    break;
-
-  case 196:
-#line 1370 "fortran.y"
-    {strcpy((yyval.nac),"DOUBLE COMPLEX");;}
-    break;
-
-  case 197:
-#line 1372 "fortran.y"
+            pos_curuse = setposcur()-strlen((yyvsp[(1) - (1)].na));
+            if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);
+        }
+    break;
+
+  case 357:
+/* Line 1807 of yacc.c  */
+#line 1447 "fortran.y"
     {
-                      strcpy((yyval.nac),"LOGICAL");
-                      pos_cur_decl = setposcur()-7;
-                   ;}
-    break;
-
-  case 199:
-#line 1378 "fortran.y"
-    {strcpy(vallengspec,(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 200:
-#line 1380 "fortran.y"
-    {sprintf((yyval.na),"*%s",(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 201:
-#line 1381 "fortran.y"
-    {strcpy((yyval.na),"*(*)");;}
-    break;
-
-  case 208:
-#line 1392 "fortran.y"
+            (yyval.lc) = (yyvsp[(1) - (1)].lc);
+        }
+    break;
+
+  case 358:
+/* Line 1807 of yacc.c  */
+#line 1451 "fortran.y"
     {
-                      if ( strstr((yyvsp[(3) - (3)].na),"0.d0") )
-                      {
-                         strcpy(nameinttypename,"8");
-                         sprintf(NamePrecision,"");
-                      }
-                      else sprintf(NamePrecision,"%s = %s",(yyvsp[(1) - (3)].nac),(yyvsp[(3) - (3)].na));
-                   ;}
-    break;
-
-  case 209:
-#line 1401 "fortran.y"
+            /* insert the variable in the list $1                 */
+            (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
+            (yyval.lc) = (yyvsp[(3) - (3)].lc);
+        }
+    break;
+
+  case 359:
+/* Line 1807 of yacc.c  */
+#line 1458 "fortran.y"
     {
-                      strcpy(NamePrecision,(yyvsp[(1) - (1)].nac));
-                   ;}
-    break;
-
-  case 210:
-#line 1405 "fortran.y"
+            coupletmp = (listcouple *) calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].na));
+            strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].na));
+            coupletmp->suiv = NULL;
+            (yyval.lc) = coupletmp;
+        }
+    break;
+
+  case 360:
+/* Line 1807 of yacc.c  */
+#line 1467 "fortran.y"
+    {  (yyval.lc) = (yyvsp[(1) - (1)].lc); }
+    break;
+
+  case 361:
+/* Line 1807 of yacc.c  */
+#line 1469 "fortran.y"
     {
-                      strcpy(NamePrecision,(yyvsp[(1) - (1)].nac));
-                   ;}
-    break;
-
-  case 211:
-#line 1409 "fortran.y"
-    {strcpy(CharacterSize,(yyvsp[(1) - (1)].na));
-                    strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 212:
-#line 1411 "fortran.y"
-    {strcpy(CharacterSize,"*");
-                    strcpy((yyval.na),"*");;}
-    break;
-
-  case 220:
-#line 1425 "fortran.y"
+            /* insert the variable in the list $1                 */
+            (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
+            (yyval.lc) = (yyvsp[(3) - (3)].lc);
+        }
+    break;
+
+  case 362:
+/* Line 1807 of yacc.c  */
+#line 1477 "fortran.y"
     {
-                      VariableIsParameter = 1;
-                   ;}
-    break;
-
-  case 222:
-#line 1430 "fortran.y"
-    {Allocatabledeclare = 1;;}
-    break;
-
-  case 223:
-#line 1432 "fortran.y"
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].na));
+            strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].na));
+            coupletmp->suiv = NULL;
+            (yyval.lc) = coupletmp;
+            pointedvar = 1;
+            Add_UsedInSubroutine_Var_1((yyvsp[(1) - (3)].na));
+        }
+    break;
+
+  case 363:
+/* Line 1807 of yacc.c  */
+#line 1487 "fortran.y"
     {
-                      dimsgiven=1;
-                      curdim=(yyvsp[(2) - (2)].d);
-                   ;}
-    break;
-
-  case 224:
-#line 1437 "fortran.y"
-    {ExternalDeclare = 1;;}
-    break;
-
-  case 225:
-#line 1439 "fortran.y"
-    {strcpy(IntentSpec,(yyvsp[(3) - (4)].nac));;}
-    break;
-
-  case 227:
-#line 1441 "fortran.y"
-    {optionaldeclare = 1 ;;}
-    break;
-
-  case 228:
-#line 1442 "fortran.y"
-    {pointerdeclare = 1 ;;}
-    break;
-
-  case 229:
-#line 1443 "fortran.y"
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,(yyvsp[(1) - (1)].na));
+            strcpy(coupletmp->c_namepointedvar,"");
+            coupletmp->suiv = NULL;
+            (yyval.lc) = coupletmp;
+        }
+    break;
+
+  case 380:
+/* Line 1807 of yacc.c  */
+#line 1522 "fortran.y"
+    { inallocate = 0; }
+    break;
+
+  case 381:
+/* Line 1807 of yacc.c  */
+#line 1523 "fortran.y"
+    { inallocate = 0; }
+    break;
+
+  case 388:
+/* Line 1807 of yacc.c  */
+#line 1531 "fortran.y"
     {
-/*                       if ( inmodulemeet == 1 )
-                       {*/
-                          SaveDeclare = 1 ;
-                     /*  }*/
-                    ;}
-    break;
-
-  case 230:
-#line 1450 "fortran.y"
-    {Targetdeclare = 1;;}
-    break;
-
-  case 231:
-#line 1452 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 232:
-#line 1453 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 233:
-#line 1454 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac)); ;}
-    break;
-
-  case 234:
-#line 1457 "fortran.y"
-    {PublicDeclare = 1;;}
-    break;
-
-  case 235:
-#line 1459 "fortran.y"
-    {PrivateDeclare = 1;;}
-    break;
-
-  case 236:
-#line 1461 "fortran.y"
-    {if ( created_dimensionlist == 1 )
-                       {
-                           (yyval.d)=(listdim *)NULL;
-                       }
-                   ;}
-    break;
-
-  case 237:
-#line 1467 "fortran.y"
-    {if ( created_dimensionlist == 1 ||
-                         agrif_parentcall      == 1 ) (yyval.d)=(yyvsp[(2) - (3)].d);;}
-    break;
-
-  case 238:
-#line 1470 "fortran.y"
-    {if ( created_dimensionlist == 1 ||
-                         agrif_parentcall      == 1 ) (yyval.d)=insertdim(NULL,(yyvsp[(1) - (1)].dim1));;}
-    break;
-
-  case 239:
-#line 1473 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                         if ( created_dimensionlist == 1 ) (yyval.d)=insertdim((yyvsp[(1) - (3)].d),(yyvsp[(3) - (3)].dim1));;}
-    break;
-
-  case 240:
-#line 1476 "fortran.y"
+            GlobalDeclaration = 0 ;
+            if ( firstpass == 0 && strcasecmp(subroutinename,"") )
+            {
+                if ( module_declar && insubroutinedeclare == 0 )    fclose(module_declar);
+            }
+            if ( strcasecmp(subroutinename,"") )
+            {
+                if ( inmodulemeet == 1 )
+                {
+                    /* we are in a module                                */
+                    if ( insubroutinedeclare == 1 )
+                    {
+                        /* it is like an end subroutine <name>            */
+                        insubroutinedeclare = 0 ;
+                        pos_cur = setposcur();
+                        closeandcallsubloopandincludeit_0(1);
+                        functiondeclarationisdone = 0;
+                    }
+                    else
+                    {
+                        /* it is like an end module <name>                */
+                        inmoduledeclare = 0 ;
+                        inmodulemeet = 0 ;
+                    }
+                }
+                else
+                {
+                    insubroutinedeclare = 0;
+                    pos_cur = setposcur();
+                    closeandcallsubloopandincludeit_0(2);
+                    functiondeclarationisdone = 0;
+                }
+            }
+            strcpy(subroutinename,"");
+        }
+    break;
+
+  case 389:
+/* Line 1807 of yacc.c  */
+#line 1568 "fortran.y"
     {
-                      strcpy((yyval.dim1).first,"1");
-                      strcpy((yyval.dim1).last,(yyvsp[(1) - (1)].na));
-                      Save_Length((yyvsp[(1) - (1)].na),1);
-                   ;}
-    break;
-
-  case 241:
-#line 1481 "fortran.y"
+            insubroutinedeclare = 0;
+            inprogramdeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(3);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+    break;
+
+  case 390:
+/* Line 1807 of yacc.c  */
+#line 1577 "fortran.y"
     {
-                      strcpy((yyval.dim1).first,"");
-                      strcpy((yyval.dim1).last,"");
-                   ;}
-    break;
-
-  case 242:
-#line 1485 "fortran.y"
+            if ( strcasecmp(subroutinename,"") )
+            {
+                insubroutinedeclare = 0;
+                pos_cur = setposcur();
+                closeandcallsubloopandincludeit_0(1);
+                functiondeclarationisdone = 0;
+                strcpy(subroutinename,"");
+            }
+        }
+    break;
+
+  case 391:
+/* Line 1807 of yacc.c  */
+#line 1588 "fortran.y"
     {
-                      strcpy((yyval.dim1).first,(yyvsp[(1) - (2)].na));
-                      Save_Length((yyvsp[(1) - (2)].na),2);
-                      strcpy((yyval.dim1).last,"");
-                   ;}
-    break;
-
-  case 243:
-#line 1490 "fortran.y"
+            insubroutinedeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(0);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+    break;
+
+  case 392:
+/* Line 1807 of yacc.c  */
+#line 1596 "fortran.y"
     {
-                      strcpy((yyval.dim1).first,"");
-                      strcpy((yyval.dim1).last,(yyvsp[(2) - (2)].na));
-                      Save_Length((yyvsp[(2) - (2)].na),1);
-                   ;}
-    break;
-
-  case 244:
-#line 1496 "fortran.y"
+            /* if we never meet the contains keyword               */
+            if ( firstpass == 0 )
+            {
+                RemoveWordCUR_0(fortran_out, strlen((yyvsp[(2) - (2)].na))+11);    // Remove word "end module"
+                if ( inmoduledeclare && ! aftercontainsdeclare )
+                {
+                    Write_Closing_Module(1);
+                }
+                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
+                if ( module_declar && insubroutinedeclare == 0 )
+                {
+                    fclose(module_declar);
+                }
+            }
+            inmoduledeclare = 0 ;
+            inmodulemeet = 0 ;
+            aftercontainsdeclare = 1;
+            strcpy(curmodulename, "");
+            GlobalDeclaration = 0 ;
+        }
+    break;
+
+  case 395:
+/* Line 1807 of yacc.c  */
+#line 1620 "fortran.y"
     {
-                      strcpy((yyval.dim1).first,(yyvsp[(1) - (3)].na));
-                      Save_Length((yyvsp[(1) - (3)].na),2);
-                      strcpy((yyval.dim1).last,(yyvsp[(3) - (3)].na));
-                      Save_Length((yyvsp[(3) - (3)].na),1);
-                   ;}
-    break;
-
-  case 245:
-#line 1503 "fortran.y"
-    {strcpy((yyval.na),"*");;}
-    break;
-
-  case 246:
-#line 1504 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 247:
-#line 1506 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 248:
-#line 1508 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 249:
-#line 1510 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 250:
-#line 1512 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 251:
-#line 1516 "fortran.y"
-    {sprintf((yyval.na),"SUM(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 252:
-#line 1518 "fortran.y"
-    {sprintf((yyval.na),"MAX(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 253:
-#line 1520 "fortran.y"
-    {sprintf((yyval.na),"TANH(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 254:
-#line 1522 "fortran.y"
-    {sprintf((yyval.na),"MAXVAL(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 255:
-#line 1524 "fortran.y"
-    {sprintf((yyval.na),"MIN(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 256:
-#line 1526 "fortran.y"
-    {sprintf((yyval.na),"MINVAL(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 257:
-#line 1528 "fortran.y"
-    {sprintf((yyval.na),"TRIM(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 258:
-#line 1530 "fortran.y"
-    {sprintf((yyval.na),"SQRT(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 259:
-#line 1532 "fortran.y"
-    {sprintf((yyval.na),"REAL(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 260:
-#line 1534 "fortran.y"
-    {sprintf((yyval.na),"NINT(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 261:
-#line 1536 "fortran.y"
-    {sprintf((yyval.na),"FLOAT(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 262:
-#line 1538 "fortran.y"
-    {sprintf((yyval.na),"EXP(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 263:
-#line 1540 "fortran.y"
-    {sprintf((yyval.na),"COS(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 264:
-#line 1542 "fortran.y"
-    {sprintf((yyval.na),"COSH(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 265:
-#line 1544 "fortran.y"
-    {sprintf((yyval.na),"ACOS(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 266:
-#line 1546 "fortran.y"
-    {sprintf((yyval.na),"SIN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 267:
-#line 1548 "fortran.y"
-    {sprintf((yyval.na),"SINH(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 268:
-#line 1550 "fortran.y"
-    {sprintf((yyval.na),"ASIN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 269:
-#line 1552 "fortran.y"
-    {sprintf((yyval.na),"LOG(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 270:
-#line 1554 "fortran.y"
-    {sprintf((yyval.na),"TAN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 271:
-#line 1556 "fortran.y"
-    {sprintf((yyval.na),"ATAN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 272:
-#line 1558 "fortran.y"
-    {sprintf((yyval.na),"ABS(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 273:
-#line 1560 "fortran.y"
-    {sprintf((yyval.na),"MOD(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 274:
-#line 1562 "fortran.y"
-    {sprintf((yyval.na),"SIGN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 275:
-#line 1564 "fortran.y"
-    {sprintf((yyval.na),"MINLOC(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 276:
-#line 1566 "fortran.y"
-    {sprintf((yyval.na),"MAXLOC(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 277:
-#line 1568 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 278:
-#line 1570 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                   { strcpy((yyval.na),(yyvsp[(1) - (3)].na));strcat((yyval.na),",");strcat((yyval.na),(yyvsp[(3) - (3)].na));};}
-    break;
-
-  case 279:
-#line 1573 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 280:
-#line 1575 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 281:
-#line 1577 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 282:
-#line 1579 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 283:
-#line 1581 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 284:
-#line 1583 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 285:
-#line 1585 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"+");;}
-    break;
-
-  case 286:
-#line 1586 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"-");;}
-    break;
-
-  case 287:
-#line 1589 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"+%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 288:
-#line 1591 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"-%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 289:
-#line 1593 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 290:
-#line 1595 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 291:
-#line 1597 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 292:
-#line 1599 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 293:
-#line 1601 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 294:
-#line 1603 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," > %s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 295:
-#line 1605 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 296:
-#line 1607 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," < %s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 297:
-#line 1609 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 298:
-#line 1611 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," >= %s",(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 299:
-#line 1613 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 300:
-#line 1615 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," <= %s",(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 301:
-#line 1617 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 302:
-#line 1619 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 303:
-#line 1621 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 304:
-#line 1623 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 305:
-#line 1625 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 306:
-#line 1627 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 307:
-#line 1629 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 308:
-#line 1631 "fortran.y"
-    {strcpy((yyval.na),"");;}
-    break;
-
-  case 309:
-#line 1633 "fortran.y"
-    {sprintf((yyval.na),"/%s",(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 310:
-#line 1635 "fortran.y"
-    {sprintf((yyval.na),"/= %s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 311:
-#line 1637 "fortran.y"
-    {sprintf((yyval.na),"//%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 312:
-#line 1640 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"==%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 313:
-#line 1642 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"= %s",(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 314:
-#line 1645 "fortran.y"
-    {if ( couldaddvariable == 1 )
-						{
-						printf("ident = %s\n",(yyvsp[(1) - (1)].nac));
-						strcpy((yyval.na),(yyvsp[(1) - (1)].nac));}
-						;}
-    break;
-
-  case 315:
-#line 1651 "fortran.y"
-    {if ( couldaddvariable == 1 ) {
-                   printf("struct = %s\n",(yyvsp[(1) - (1)].na));
-                   strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
-                   ;}
-    break;
-
-  case 316:
-#line 1656 "fortran.y"
-    {if ( couldaddvariable == 1 ) {
-                   printf("arrayref = %s\n",(yyvsp[(1) - (1)].na));
-                   strcpy((yyval.na),(yyvsp[(1) - (1)].na));
-                   };}
-    break;
-
-  case 317:
-#line 1661 "fortran.y"
+            if ( inside_type_declare ) break;
+            if ( inmoduledeclare )
+            {
+                if ( firstpass == 0 )
+                {
+                    RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
+                    Write_Closing_Module(0);
+                }
+                inmoduledeclare = 0 ;
+                aftercontainsdeclare = 1;
+            }
+            else if ( insubroutinedeclare )
+            {
+                incontainssubroutine = 1;
+                insubroutinedeclare  = 0;
+                incontainssubroutine = 0;
+                functiondeclarationisdone = 0;
+
+                if ( firstpass )
+                    List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0);
+                else
+                    closeandcallsubloop_contains_0();
+
+                strcpy(subroutinename, "");
+            }
+            else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input);
+        }
+    break;
+
+  case 483:
+/* Line 1807 of yacc.c  */
+#line 1898 "fortran.y"
     {
-                      agrif_parentcall =0;
-                      if (!strcasecmp(identcopy,"Agrif_Parent") )
-                                                            agrif_parentcall =1;
-                      if ( Agrif_in_Tok_NAME(identcopy) == 1 )
-                      {
-                         inagrifcallargument = 1;
-                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                      }
-                   ;}
-    break;
-
-  case 318:
-#line 1674 "fortran.y"
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+            functiondeclarationisdone = 0;
+        }
+    break;
+
+  case 484:
+/* Line 1807 of yacc.c  */
+#line 1906 "fortran.y"
     {
-                     strcpy((yyval.na),(yyvsp[(1) - (1)].na));
-                     if ( incalldeclare == 0 ) inagrifcallargument = 0;
-                   ;}
-    break;
-
-  case 319:
-#line 1679 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," %s %s ",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 320:
-#line 1681 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                                sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 321:
-#line 1684 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                         sprintf((yyval.na)," %s ( %s ) %s ",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
-    break;
-
-  case 322:
-#line 1688 "fortran.y"
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+        }
+    break;
+
+  case 485:
+/* Line 1807 of yacc.c  */
+#line 1913 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                         sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].nac),(yyvsp[(3) - (4)].na));
-                         ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].na));
-                         agrif_parentcall =0;
-                      }
-                   ;}
-    break;
-
-  case 323:
-#line 1698 "fortran.y"
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+        }
+    break;
+
+  case 486:
+/* Line 1807 of yacc.c  */
+#line 1920 "fortran.y"
     {
-                      sprintf((yyval.na)," %s %% %s ",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));
-                      if ( incalldeclare == 0 ) inagrifcallargument = 0;
-                   ;}
-    break;
-
-  case 324:
-#line 1704 "fortran.y"
-    {sprintf((yyval.na),"(/%s/)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 325:
-#line 1706 "fortran.y"
-    {strcpy((yyval.na)," ");;}
-    break;
-
-  case 326:
-#line 1708 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 327:
-#line 1710 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 328:
-#line 1712 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 329:
-#line 1714 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 330:
-#line 1715 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 331:
-#line 1718 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s :%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 332:
-#line 1720 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                               sprintf((yyval.na),"%s :%s :%s",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
-    break;
-
-  case 333:
-#line 1723 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":%s :%s",(yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].na));;}
-    break;
-
-  case 334:
-#line 1724 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),": : %s",(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 335:
-#line 1725 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 336:
-#line 1726 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s :",(yyvsp[(1) - (2)].na));;}
-    break;
-
-  case 337:
-#line 1727 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":");;}
-    break;
-
-  case 338:
-#line 1729 "fortran.y"
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+        }
+    break;
+
+  case 487:
+/* Line 1807 of yacc.c  */
+#line 1926 "fortran.y"
+    {strcpy((yyval.na),"");}
+    break;
+
+  case 488:
+/* Line 1807 of yacc.c  */
+#line 1927 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 489:
+/* Line 1807 of yacc.c  */
+#line 1930 "fortran.y"
+    { created_dimensionlist = 0; }
+    break;
+
+  case 490:
+/* Line 1807 of yacc.c  */
+#line 1934 "fortran.y"
     {
-                       if ( couldaddvariable == 1 && afterpercent == 0)
-                       {
-                       if ( Vartonumber((yyvsp[(1) - (1)].nac)) == 1 )
-                       {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                       if (!strcasecmp((yyvsp[(1) - (1)].nac),"Agrif_Parent") )
-                                                            agrif_parentcall =1;
-                       if ( VariableIsNotFunction((yyvsp[(1) - (1)].nac)) == 0 )
-                       {
-                       printf("var = %s\n",(yyvsp[(1) - (1)].nac));
-                          if ( inagrifcallargument == 1 )
-                          {
-                             if ( !strcasecmp((yyvsp[(1) - (1)].nac),identcopy) )
-                             {
-                                strcpy(sameagrifname,identcopy);
-                                sameagrifargument = 1;
-                             }
-                          }
-                          strcpy(identcopy,(yyvsp[(1) - (1)].nac));
-                          pointedvar=0;
-                          strcpy(truename,(yyvsp[(1) - (1)].nac));
-                          if (variscoupled_0((yyvsp[(1) - (1)].nac))) strcpy(truename,getcoupledname_0((yyvsp[(1) - (1)].nac)));
-
-                          if ( VarIsNonGridDepend(truename) == 0 &&
-                               Variableshouldberemove(truename) == 0 )
-                          {                      
-                             if ( inagrifcallargument == 1 ||
-                                  varispointer_0(truename) == 1 )
-                             {
-                             printf("var2 = %s\n",(yyvsp[(1) - (1)].nac));
-                            if ((IsinListe(List_UsedInSubroutine_Var,(yyvsp[(1) - (1)].nac)) == 1) || (inagrifcallargument == 1))
-                             {
-                              if (varistyped_0(truename) == 0)
-                                 {
-                                 ModifyTheVariableName_0(truename,strlen((yyvsp[(1) - (1)].nac)));
-                                 }
-                                 }
-                             }
-                             printf("ici3\n");
-                             if ( inagrifcallargument != 1 ||
-                                  sameagrifargument ==1 )
-                                  {
-                                  printf("ici5 %s\n",truename);
-                                  Add_UsedInSubroutine_Var_1(truename);
-                          }
-                          }
-                          NotifyAgrifFunction_0(truename);
-                       }
-                       }
-                       else
-                       {
-                       afterpercent = 0;
-                    }
-                    ;}
-    break;
-
-  case 339:
-#line 1788 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),".TRUE.");;}
-    break;
-
-  case 340:
-#line 1789 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),".FALSE.");;}
-    break;
-
-  case 341:
-#line 1790 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 342:
-#line 1791 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 343:
-#line 1792 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 344:
-#line 1793 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 345:
-#line 1795 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.nac),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].nac));;}
-    break;
-
-  case 347:
-#line 1799 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 349:
-#line 1802 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 350:
-#line 1804 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 351:
-#line 1806 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
-    break;
-
-  case 352:
-#line 1807 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 353:
-#line 1810 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s :%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 354:
-#line 1812 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
-    break;
-
-  case 355:
-#line 1813 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 356:
-#line 1815 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
-    break;
-
-  case 357:
-#line 1816 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 358:
-#line 1818 "fortran.y"
-    {   strcpy(InitialValueGiven," ");;}
-    break;
-
-  case 359:
-#line 1820 "fortran.y"
+            created_dimensionlist = 1;
+            if ( ((yyvsp[(3) - (4)].d) == NULL) || ((yyvsp[(4) - (4)].d) == NULL) ) break;
+            if  ( agrif_parentcall == 1 )
+            {
+                ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].d)->dim.last);
+                agrif_parentcall = 0;
+                fprintf(fortran_out," = ");
+            }
+        }
+    break;
+
+  case 491:
+/* Line 1807 of yacc.c  */
+#line 1945 "fortran.y"
     {
-                       if ( couldaddvariable == 1 )
-                       {
-                          strcpy(InitValue,(yyvsp[(3) - (3)].na));
-                          strcpy(InitialValueGiven,"=");
-                       }
-                    ;}
-    break;
-
-  case 360:
-#line 1828 "fortran.y"
+            created_dimensionlist = 1;
+        }
+    break;
+
+  case 496:
+/* Line 1807 of yacc.c  */
+#line 1958 "fortran.y"
     {
-                       if ( couldaddvariable == 1 )
-                       {
-                          strcpy(InitValue,(yyvsp[(3) - (3)].na));
-                          strcpy(InitialValueGiven,"=>");
-                       }
-                    ;}
-    break;
-
-  case 361:
-#line 1836 "fortran.y"
-    {pos_curinit = setposcur();;}
-    break;
-
-  case 362:
-#line 1839 "fortran.y"
-    {sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 363:
-#line 1842 "fortran.y"
+            inagrifcallargument = 0 ;
+            incalldeclare=0;
+            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
+                strcpy(subofagrifinitgrids,subroutinename);
+            }
+            Instanciation_0(sameagrifname);
+        }
+    break;
+
+  case 502:
+/* Line 1807 of yacc.c  */
+#line 1979 "fortran.y"
     {
-                      if ( couldaddvariable == 1 )
-                      {
-                      /* if variables has been declared in a subroutine       */
-                      if (insubroutinedeclare == 1)
-                      {
-                         copyuse_0((yyvsp[(2) - (2)].nac));
-                      }
-                      sprintf(charusemodule,"%s",(yyvsp[(2) - (2)].nac));
-                      Add_NameOfModuleUsed_1((yyvsp[(2) - (2)].nac));
-
-                      if ( inmoduledeclare == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curuse,
-                                               pos_end-pos_curuse);
-                      }
-                      }
-                    ;}
-    break;
-
-  case 364:
-#line 1862 "fortran.y"
+            if (!strcasecmp((yyvsp[(2) - (2)].na),"MPI_Init") )    callmpiinit = 1;
+            else                                callmpiinit = 0;
+
+            if (!strcasecmp((yyvsp[(2) - (2)].na),"Agrif_Init_Grids") )
+            {
+                callagrifinitgrids = 1;
+                strcpy(meetagrifinitgrids,subroutinename);
+            }
+            else
+            {
+                callagrifinitgrids = 0;
+            }
+            if ( Vartonumber((yyvsp[(2) - (2)].na)) == 1 )
+            {
+                incalldeclare = 1;
+                inagrifcallargument = 1 ;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+    break;
+
+  case 503:
+/* Line 1807 of yacc.c  */
+#line 2000 "fortran.y"
+    { pos_curcall=setposcur()-4; }
+    break;
+
+  case 506:
+/* Line 1807 of yacc.c  */
+#line 2008 "fortran.y"
     {
-                       if ( couldaddvariable == 1 )
-                       {
-                      if (insubroutinedeclare == 1)
-                      {
-                         Add_CouplePointed_Var_1((yyvsp[(2) - (4)].nac),(yyvsp[(4) - (4)].lc));
-                      }
-                      if ( firstpass == 1 )
-                      {
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            coupletmp = (yyvsp[(4) - (4)].lc);
-                            strcpy(ligne,"");
-                            while ( coupletmp )
-                            {
-                               strcat(ligne,coupletmp->c_namevar);
-                               strcat(ligne," => ");
-                               strcat(ligne,coupletmp->c_namepointedvar);
-                               coupletmp = coupletmp->suiv;
-                               if ( coupletmp ) strcat(ligne,",");
-                            }
-                            sprintf(charusemodule,"%s",(yyvsp[(2) - (4)].nac));
-                         }
-                         Add_NameOfModuleUsed_1((yyvsp[(2) - (4)].nac));
-                      }
-                      if ( inmoduledeclare == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curuse,
-                                               pos_end-pos_curuse);
-                      }
-                      }
-                    ;}
-    break;
-
-  case 365:
-#line 1896 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                      /* if variables has been declared in a subroutine       */
-                      if (insubroutinedeclare == 1)
-                      {
-                         copyuseonly_0((yyvsp[(2) - (6)].nac));
-                      }
-                      sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].nac));
-                      Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].nac));
-
-                       if ( inmoduledeclare == 0 )
-                       {
-                          pos_end = setposcur();
-                          RemoveWordSET_0(fortranout,pos_curuse,
-                                                pos_end-pos_curuse);
-                       }
-                       }
-                    ;}
-    break;
-
-  case 366:
-#line 1916 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       /* if variables has been declared in a subroutine      */
-                       if (insubroutinedeclare == 1)
-                       {
-                          Add_CouplePointed_Var_1((yyvsp[(2) - (6)].nac),(yyvsp[(6) - (6)].lc));
-                       }
-                       if ( firstpass == 1 )
-                       {
-                         if ( insubroutinedeclare == 1 )
-                         {
-                             coupletmp = (yyvsp[(6) - (6)].lc);
-                             strcpy(ligne,"");
-                             while ( coupletmp )
-                             {
-                                strcat(ligne,coupletmp->c_namevar);
-                               if ( strcasecmp(coupletmp->c_namepointedvar,"") )
-                                                           strcat(ligne," => ");
-                                strcat(ligne,coupletmp->c_namepointedvar);
-                                coupletmp = coupletmp->suiv;
-                                if ( coupletmp ) strcat(ligne,",");
-                             }
-                             sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].nac));
-                          }
-                          Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].nac));
-                       }
-                       if ( firstpass == 0 )
-                       {
-                          if ( inmoduledeclare == 0 )
-                          {
-
-                            pos_end = setposcur();
-                             RemoveWordSET_0(fortranout,pos_curuse,
-                                                   pos_end-pos_curuse);
-                       if (oldfortranout) 
-                         variableisglobalinmodule((yyvsp[(6) - (6)].lc),(yyvsp[(2) - (6)].nac),oldfortranout,pos_curuseold);
-                        
-                          }
-                          else
-                          {
-
-                             /* if we are in the module declare and if the    */
-                             /* onlylist is a list of global variable         */
-                             variableisglobalinmodule((yyvsp[(6) - (6)].lc), (yyvsp[(2) - (6)].nac), fortranout,pos_curuse);
-                          }
-                       }
-                       }
-                    ;}
-    break;
-
-  case 367:
-#line 1967 "fortran.y"
-    {
-                      pos_curuse = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                     if (firstpass == 0 && oldfortranout) {
-                     pos_curuseold = setposcurname(oldfortranout);
-                     }
-                   ;}
-    break;
-
-  case 368:
-#line 1975 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 369:
-#line 1978 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 ) (yyval.lc) = (yyvsp[(1) - (1)].lc);
-                    ;}
-    break;
-
-  case 370:
-#line 1982 "fortran.y"
-    {
-                        if ( couldaddvariable == 1 )
-                        {
-                        /* insert the variable in the list $1                 */
-                        (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
-                        (yyval.lc) = (yyvsp[(3) - (3)].lc);
-                        }
-                    ;}
-    break;
-
-  case 371:
-#line 1992 "fortran.y"
-    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].nac));
-                       Save_Length((yyvsp[(1) - (3)].nac),21);
-                       strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].nac));
-                       Save_Length((yyvsp[(3) - (3)].nac),22);
-                       coupletmp->suiv = NULL;
-                       (yyval.lc) = coupletmp;
-                     ;}
-    break;
-
-  case 372:
-#line 2003 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 ) (yyval.lc) = (yyvsp[(1) - (1)].lc);
-                    ;}
-    break;
-
-  case 373:
-#line 2007 "fortran.y"
-    {
-                        if ( couldaddvariable == 1 )
-                        {
-                        /* insert the variable in the list $1                 */
-                        (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
-                        (yyval.lc) = (yyvsp[(3) - (3)].lc);
-                        }
-                    ;}
-    break;
-
-  case 374:
-#line 2017 "fortran.y"
-    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].nac));
-                       Save_Length((yyvsp[(1) - (3)].nac),21);
-                       strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].nac));
-                       Save_Length((yyvsp[(3) - (3)].nac),22);
-                       coupletmp->suiv = NULL;
-                       (yyval.lc) = coupletmp;
-                       pointedvar=1;
-                       Add_UsedInSubroutine_Var_1((yyvsp[(1) - (3)].nac));
-                    ;}
-    break;
-
-  case 375:
-#line 2028 "fortran.y"
-    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (1)].nac));
-                       Save_Length((yyvsp[(1) - (1)].nac),21);
-                       strcpy(coupletmp->c_namepointedvar,"");
-                       coupletmp->suiv = NULL;
-                       (yyval.lc) = coupletmp;
-                     ;}
-    break;
-
-  case 377:
-#line 2039 "fortran.y"
-    {
-                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     ;}
-    break;
-
-  case 378:
-#line 2045 "fortran.y"
-    {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                         curmodulename);
-                                                         inallocate = 0;
-                     ;}
-    break;
-
-  case 380:
-#line 2052 "fortran.y"
-    {
-                       GlobalDeclaration = 0 ;
-                       if ( firstpass == 0 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                          if ( module_declar && insubroutinedeclare == 0 )
-                          {
-                              fclose(module_declar);
-                          }
-                       }
-                       if ( couldaddvariable == 1 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                       if ( inmodulemeet == 1 )
-                       {
-                         /* we are in a module                                */
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            /* it is like an end subroutine <name>            */
-                            insubroutinedeclare = 0 ;
-                            /*                                                */
-                            pos_cur = setposcur();
-                            closeandcallsubloopandincludeit_0(1);
-                            functiondeclarationisdone = 0;
-                         }
-                         else
-                         {
-                            /* it is like an end module <name>                */
-                            inmoduledeclare = 0 ;
-                            inmodulemeet = 0 ;
-                         }
-                       }
-                       else
-                       {
-                          insubroutinedeclare = 0;
-                          /*                                                  */
-                          pos_cur = setposcur();                        
-                          closeandcallsubloopandincludeit_0(2);
-                            functiondeclarationisdone = 0;
-                          if ( firstpass == 0 )
-                          {
-                             if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                             else fprintf(paramout,"C\n");
-                             fclose(paramout);
-                           }
-                        }
-                      }
-                      strcpy(subroutinename,"");
-                    ;}
-    break;
-
-  case 381:
-#line 2102 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();                      
-                       closeandcallsubloopandincludeit_0(3);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    ;}
-    break;
-
-  case 382:
+            if ( callmpiinit == 1 )
+            {
+                strcpy(mpiinitvar,(yyvsp[(1) - (1)].na));
+                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
+            }
+        }
+    break;
+
+  case 532:
+/* Line 1807 of yacc.c  */
+#line 2056 "fortran.y"
+    { afterpercent = 1; }
+    break;
+
+  case 572:
+/* Line 1807 of yacc.c  */
+#line 2115 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 573:
+/* Line 1807 of yacc.c  */
+#line 2116 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 574:
+/* Line 1807 of yacc.c  */
+#line 2117 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 575:
+/* Line 1807 of yacc.c  */
+#line 2118 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 576:
+/* Line 1807 of yacc.c  */
+#line 2119 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 577:
+/* Line 1807 of yacc.c  */
 #line 2120 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();
-                                             
-                       closeandcallsubloopandincludeit_0(1);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    ;}
-    break;
-
-  case 383:
-#line 2140 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();
-
-                       closeandcallsubloopandincludeit_0(0);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    ;}
-    break;
-
-  case 384:
-#line 2159 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       /* if we never meet the contains keyword               */
-                      Remove_Word_end_module_0(strlen((yyvsp[(2) - (2)].nac)));
-                       if ( inmoduledeclare == 1 )
-                       {
-                          if ( aftercontainsdeclare == 0 )
-                          {
-                             Write_GlobalParameter_Declaration_0();
-                             Write_NotGridDepend_Declaration_0();
-                             Write_GlobalType_Declaration_0();
-                             if ( module_declar_type )
-                             {
-                             strcpy (ligne, "\n#include \"Module_DeclarType_");
-                             strcat (ligne, curmodulename);
-                             strcat (ligne, ".h\"\n");
-                             tofich(fortranout,ligne,1); 
-                             }
-                             Write_Alloc_Subroutine_For_End_0();
-                          }
-                       }
-                                           
-                       inmoduledeclare = 0 ;
-                       inmodulemeet = 0 ;
-
-                      Write_Word_end_module_0();
-                      strcpy(curmodulename,"");
-                      aftercontainsdeclare = 1;
-                      if ( firstpass == 0 )
-                      {
-                         if ( module_declar && insubroutinedeclare == 0)
-                         {
-                           fclose(module_declar);
-                         }
-                         if ( module_declar_type && insubroutinedeclare == 0)
-                         {
-                          fclose(module_declar_type);
-                          module_declar_type = 0;
-                         }
-                      }
-                      GlobalDeclaration = 0 ;
-                      }
-                  ;}
-    break;
-
-  case 398:
-#line 2217 "fortran.y"
-    {
-                      if (inmoduledeclare == 1 )
-                      {
-                         Remove_Word_Contains_0();
-                         Write_GlobalParameter_Declaration_0();
-                         Write_GlobalType_Declaration_0();
-                             if ( module_declar_type)
-                             {                         
-                             strcpy (ligne, "\n#include \"Module_DeclarType_");
-                             strcat (ligne, curmodulename);
-                             strcat (ligne, ".h\"\n");
-                             tofich(fortranout,ligne,1); 
-                             }
-                         Write_NotGridDepend_Declaration_0();
-                         Write_Alloc_Subroutine_0();
-                         inmoduledeclare = 0 ;
-                         aftercontainsdeclare = 1;
-                      }
-                      else
-                      {
-                      incontainssubroutine = 1;
-                      strcpy(previoussubroutinename,subroutinename);
-                       if ( couldaddvariable == 1 )
-                       {
-                          if ( firstpass == 1 ) List_ContainsSubroutine =
-                                                Addtolistnom(subroutinename,
-                                                     List_ContainsSubroutine,0);
-                          insubroutinedeclare = 0;
-                          /*                                                  */
-
-                          closeandcallsubloop_contains_0();
-                            functiondeclarationisdone = 0;
-                         if ( firstpass == 0 )
-                         {
-                            if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                            else fprintf(paramout,"C\n");
-                            fclose(paramout);
-                         }
-                         }
-                         strcpy(subroutinename,"");
-                      }
-                   ;}
-    break;
-
-  case 399:
-#line 2261 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       functiondeclarationisdone = 0;
-                       }
-                    ;}
-    break;
-
-  case 400:
-#line 2271 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       }
-                    ;}
-    break;
-
-  case 401:
-#line 2280 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       }
-                    ;}
-    break;
-
-  case 402:
-#line 2289 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       }
-                    ;}
-    break;
-
-  case 414:
-#line 2311 "fortran.y"
-    {strcpy((yyval.nac),"");;}
-    break;
-
-  case 415:
-#line 2312 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 425:
-#line 2332 "fortran.y"
-    {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     ;}
-    break;
-
-  case 426:
-#line 2338 "fortran.y"
-    {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     ;}
-    break;
-
-  case 432:
-#line 2349 "fortran.y"
-    {if ( couldaddvariable == 1 ) created_dimensionlist = 0;;}
-    break;
-
-  case 433:
-#line 2351 "fortran.y"
-    {
-                  created_dimensionlist = 1;
-                  if  ( agrif_parentcall == 1 )
-                  {
-                      ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].d)->dim.last);
-                      agrif_parentcall =0;
-                      fprintf(fortranout," = ");
-                  }
-              ;}
-    break;
-
-  case 434:
-#line 2361 "fortran.y"
-    {created_dimensionlist = 1;;}
-    break;
-
-  case 439:
-#line 2369 "fortran.y"
-    {
-                      inagrifcallargument = 0 ;
-                      incalldeclare=0;
-                      if ( oldfortranout &&
-                           !strcasecmp(meetagrifinitgrids,subroutinename) &&
-                           firstpass == 0 &&
-                           callmpiinit == 1)
-                      {
-                      /*   pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcall,
-                                               pos_end-pos_curcall);
-                         fprintf(oldfortranout,"      Call MPI_Init (%s) \n"
-                                                                   ,mpiinitvar);*/
-                      }
-                      if ( oldfortranout           &&
-                           callagrifinitgrids == 1 &&
-                           firstpass == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcall,
-                                               pos_end-pos_curcall);
-
-                         strcpy(subofagrifinitgrids,subroutinename);
-                      }
-                      Instanciation_0(sameagrifname);
-                   ;}
-    break;
-
-  case 444:
-#line 2403 "fortran.y"
-    {
-                       if (!strcasecmp((yyvsp[(2) - (2)].nac),"MPI_Init") )
-                       {
-                          callmpiinit = 1;
-                       }
-                       else
-                       {
-                          callmpiinit = 0;
-                       }
-                       if (!strcasecmp((yyvsp[(2) - (2)].nac),"Agrif_Init_Grids") )
-                       {
-                          callagrifinitgrids = 1;
-                          strcpy(meetagrifinitgrids,subroutinename);
-                       }
-                       else callagrifinitgrids = 0;
-                       if ( !strcasecmp((yyvsp[(2) - (2)].nac),"Agrif_Open_File") )
-                       {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                       if ( Vartonumber((yyvsp[(2) - (2)].nac)) == 1 )
-                       {
-                          incalldeclare=1;
-                          inagrifcallargument = 1 ;
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                    ;}
-    break;
-
-  case 445:
-#line 2433 "fortran.y"
-    {pos_curcall=setposcur()-4;;}
-    break;
-
-  case 448:
-#line 2438 "fortran.y"
-    {
-                  if ( callmpiinit == 1 )
-                  {
-                     strcpy(mpiinitvar,(yyvsp[(1) - (1)].na));
-                     if ( firstpass == 1 )
-                     {
-                        Add_UsedInSubroutine_Var_1 (mpiinitvar);
-/*                        curvar=createvar($1,NULL);
-                        curlistvar=insertvar(NULL,curvar);
-                        List_Subr outineArgument_Var = AddListvarToListvar
-                         (curlistvar,List_SubroutineAr gument_Var,1);*/
-                     }
-                  }
-               ;}
-    break;
-
-  case 520:
-#line 2562 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 521:
-#line 2563 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 522:
-#line 2564 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 523:
-#line 2567 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 524:
-#line 2569 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 525:
-#line 2571 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 526:
-#line 2573 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 527:
-#line 2575 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 528:
-#line 2577 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 529:
-#line 2578 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 530:
-#line 2579 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 531:
-#line 2582 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 532:
-#line 2584 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," (%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 533:
-#line 2586 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 534:
-#line 2588 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 535:
-#line 2590 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 536:
-#line 2594 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                              sprintf((yyval.na),"%s=%s,%s)",(yyvsp[(1) - (5)].nac),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
-    break;
-
-  case 537:
-#line 2597 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                        sprintf((yyval.na),"%s=%s,%s,%s)",(yyvsp[(1) - (7)].nac),(yyvsp[(3) - (7)].na),(yyvsp[(5) - (7)].na),(yyvsp[(7) - (7)].na));;}
-    break;
-
-  case 544:
-#line 2613 "fortran.y"
-    {Add_Allocate_Var_1((yyvsp[(1) - (1)].nac),curmodulename);;}
-    break;
-
-  case 547:
-#line 2618 "fortran.y"
-    {Add_Allocate_Var_1((yyvsp[(1) - (4)].nac),curmodulename);;}
-    break;
-
-  case 555:
-#line 2641 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-
-/* Line 1267 of yacc.c.  */
-#line 6522 "fortran.tab.c"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 578:
+/* Line 1807 of yacc.c  */
+#line 2121 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 579:
+/* Line 1807 of yacc.c  */
+#line 2122 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 580:
+/* Line 1807 of yacc.c  */
+#line 2123 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 581:
+/* Line 1807 of yacc.c  */
+#line 2124 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 582:
+/* Line 1807 of yacc.c  */
+#line 2127 "fortran.y"
+    { sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 583:
+/* Line 1807 of yacc.c  */
+#line 2128 "fortran.y"
+    { sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 584:
+/* Line 1807 of yacc.c  */
+#line 2129 "fortran.y"
+    { sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 585:
+/* Line 1807 of yacc.c  */
+#line 2131 "fortran.y"
+    { sprintf((yyval.na),"%s=%s,%s)",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));}
+    break;
+
+  case 586:
+/* Line 1807 of yacc.c  */
+#line 2132 "fortran.y"
+    { sprintf((yyval.na),"%s=%s,%s,%s)",(yyvsp[(1) - (7)].na),(yyvsp[(3) - (7)].na),(yyvsp[(5) - (7)].na),(yyvsp[(7) - (7)].na));}
+    break;
+
+  case 591:
+/* Line 1807 of yacc.c  */
+#line 2142 "fortran.y"
+    { Add_Allocate_Var_1((yyvsp[(1) - (1)].na),curmodulename); }
+    break;
+
+
+/* Line 1807 of yacc.c  */
+#line 6110 "fortran.tab.c"
       default: break;
     }
+  /* User semantic actions sometimes alter yychar, and that requires
+     that yytoken be updated with the new translation.  We take the
+     approach of translating immediately before every use of yytoken.
+     One alternative is translating here after every semantic action,
+     but that translation would be missed if the semantic action invokes
+     YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or
+     if it invokes YYBACKUP.  In the case of YYABORT or YYACCEPT, an
+     incorrect destructor might then be invoked immediately.  In the
+     case of YYERROR or YYBACKUP, subsequent parser actions might lead
+     to an incorrect destructor call or verbose syntax error message
+     before the lookahead is translated.  */
   YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
 
@@ -6532,5 +6127,4 @@
 
   *++yyvsp = yyval;
-
 
   /* Now `shift' the result of the reduction.  Determine what state
@@ -6553,4 +6147,8 @@
 `------------------------------------*/
 yyerrlab:
+  /* Make sure we have latest lookahead translation.  See comments at
+     user semantic actions for why this is necessary.  */
+  yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar);
+
   /* If not already recovering from an error, report this error.  */
   if (!yyerrstatus)
@@ -6560,35 +6158,34 @@
       yyerror (YY_("syntax error"));
 #else
+# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \
+                                        yyssp, yytoken)
       {
-	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
-	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
-	  {
-	    YYSIZE_T yyalloc = 2 * yysize;
-	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
-	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
-	    if (yymsg != yymsgbuf)
-	      YYSTACK_FREE (yymsg);
-	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
-	    if (yymsg)
-	      yymsg_alloc = yyalloc;
-	    else
-	      {
-		yymsg = yymsgbuf;
-		yymsg_alloc = sizeof yymsgbuf;
-	      }
-	  }
-
-	if (0 < yysize && yysize <= yymsg_alloc)
-	  {
-	    (void) yysyntax_error (yymsg, yystate, yychar);
-	    yyerror (yymsg);
-	  }
-	else
-	  {
-	    yyerror (YY_("syntax error"));
-	    if (yysize != 0)
-	      goto yyexhaustedlab;
-	  }
+        char const *yymsgp = YY_("syntax error");
+        int yysyntax_error_status;
+        yysyntax_error_status = YYSYNTAX_ERROR;
+        if (yysyntax_error_status == 0)
+          yymsgp = yymsg;
+        else if (yysyntax_error_status == 1)
+          {
+            if (yymsg != yymsgbuf)
+              YYSTACK_FREE (yymsg);
+            yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc);
+            if (!yymsg)
+              {
+                yymsg = yymsgbuf;
+                yymsg_alloc = sizeof yymsgbuf;
+                yysyntax_error_status = 2;
+              }
+            else
+              {
+                yysyntax_error_status = YYSYNTAX_ERROR;
+                yymsgp = yymsg;
+              }
+          }
+        yyerror (yymsgp);
+        if (yysyntax_error_status == 2)
+          goto yyexhaustedlab;
       }
+# undef YYSYNTAX_ERROR
 #endif
     }
@@ -6598,5 +6195,5 @@
   if (yyerrstatus == 3)
     {
-      /* If just tried and failed to reuse look-ahead token after an
+      /* If just tried and failed to reuse lookahead token after an
 	 error, discard it.  */
 
@@ -6615,5 +6212,5 @@
     }
 
-  /* Else will try to reuse look-ahead token after shifting the error
+  /* Else will try to reuse lookahead token after shifting the error
      token.  */
   goto yyerrlab1;
@@ -6649,5 +6246,5 @@
     {
       yyn = yypact[yystate];
-      if (yyn != YYPACT_NINF)
+      if (!yypact_value_is_default (yyn))
 	{
 	  yyn += YYTERROR;
@@ -6672,8 +6269,7 @@
     }
 
-  if (yyn == YYFINAL)
-    YYACCEPT;
-
+  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
   *++yyvsp = yylval;
+  YY_IGNORE_MAYBE_UNINITIALIZED_END
 
 
@@ -6699,5 +6295,5 @@
   goto yyreturn;
 
-#ifndef yyoverflow
+#if !defined yyoverflow || YYERROR_VERBOSE
 /*-------------------------------------------------.
 | yyexhaustedlab -- memory exhaustion comes here.  |
@@ -6710,7 +6306,12 @@
 
 yyreturn:
-  if (yychar != YYEOF && yychar != YYEMPTY)
-     yydestruct ("Cleanup: discarding lookahead",
-		 yytoken, &yylval);
+  if (yychar != YYEMPTY)
+    {
+      /* Make sure we have latest lookahead translation.  See comments at
+         user semantic actions for why this is necessary.  */
+      yytoken = YYTRANSLATE (yychar);
+      yydestruct ("Cleanup: discarding lookahead",
+                  yytoken, &yylval);
+    }
   /* Do not reclaim the symbols of the rule which action triggered
      this YYABORT or YYACCEPT.  */
@@ -6736,62 +6337,32 @@
 
 
-#line 2643 "fortran.y"
-
-
-void processfortran(char *fichier_entree)
+/* Line 2055 of yacc.c  */
+#line 2156 "fortran.y"
+
+
+void process_fortran(const char *input_file)
 {
-   extern FILE *fortranin;
-   extern FILE *fortranout;
-   char nomfile[LONG_C];
-   int c;
-   int confirmyes;
-
-/*   fortrandebug = 1;*/
-   if ( mark == 1 ) printf("Firstpass == %d \n",firstpass);
+    extern FILE *fortran_in;
+    extern FILE *fortran_out;
+
+    char output_file[LONG_FNAME];
+    char input_fullpath[LONG_FNAME];
+
+    if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass);
+
+     yydebug=0;
 /******************************************************************************/
-/*  1-  Open input and output files                                           */
+/*  1-  Open input file                                                       */
 /******************************************************************************/
-   strcpy(nomfile,commondirin);
-   strcat(nomfile,"/");
-   strcat(nomfile,fichier_entree);
-   fortranin=fopen( nomfile,"r");
-   if (! fortranin)
-   {
-      printf("Error : File %s does not exist\n",nomfile);
-      exit(1);
-   }
-
-   strcpy(curfile,nomfile);
-   strcpy(nomfile,commondirout);
-   strcat(nomfile,"/");
-   strcat(nomfile,fichier_entree);
-   strcpy(nomfileoutput,nomfile);
-   Save_Length(nomfileoutput,31);
-   if (firstpass == 1)
-   {
-      if (checkexistcommon == 1)
-      {
-         if (fopen(nomfile,"r"))
-         {
-            printf("Warning : file %s already exist\n",nomfile);
-            confirmyes = 0;
-            while (confirmyes==0)
-            {
-               printf("Override file %s ? [Y/N]\n",nomfile);
-               c=getchar();
-               getchar();
-               if (c==79 || c==110)
-               {
-                  printf("We stop\n");
-                  exit(1);
-               }
-               if (c==89 || c==121)
-               {
-                  confirmyes=1;
-               }
-            }
-         }
-      }
-   }
+
+    strcpy(cur_filename, input_file);
+    sprintf(input_fullpath, "%s/%s", input_dir, input_file);
+
+    fortran_in = fopen(input_fullpath, "r");
+    if (! fortran_in)
+    {
+        printf("Error : File %s does not exist\n", input_fullpath);
+        exit(1);
+    }
 
 /******************************************************************************/
@@ -6799,67 +6370,43 @@
 /******************************************************************************/
 
-   line_num_fortran_common=1;
-   line_num_fortran=1;
-   PublicDeclare = 0;
-   PrivateDeclare = 0;
-   ExternalDeclare = 0;
-   SaveDeclare = 0;
-   pointerdeclare = 0;
-   optionaldeclare = 0;
-   incalldeclare = 0;
-   VarType = 0;
-   VarTypepar = 0;
-   Allocatabledeclare = 0 ;
-   Targetdeclare = 0 ;
-   strcpy(NamePrecision," ");
-   VariableIsParameter =  0 ;
-   strcpy(NamePrecision,"");
-   c_star = 0 ;
-   functiondeclarationisdone = 0;
-   insubroutinedeclare = 0 ;
-   ininterfacedeclare = 0 ;   
-   strcpy(subroutinename," ");
-   isrecursive = 0;
-   strcpy(InitialValueGiven," ");
-   strcpy(EmptyChar," ");
-   inmoduledeclare = 0;
-   incontainssubroutine = 0;
-   module_declar_type = 0;
-   GlobalDeclarationType = 0;
-   colnum=0;
-   incom=0;
-   couldaddvariable=1;
-   afterpercent = 0;
-   aftercontainsdeclare = 1;
-   strcpy(nameinttypename,"");
-   /* Name of the file without format                                         */
-   tmp = strchr(fichier_entree, '.');
-   strncpy(curfilename,fichier_entree,strlen(fichier_entree)-strlen(tmp));
-   Save_Length(curfilename,30);
+    line_num_input = 1;
+    PublicDeclare = 0;
+    PrivateDeclare = 0;
+    ExternalDeclare = 0;
+    SaveDeclare = 0;
+    pointerdeclare = 0;
+    optionaldeclare = 0;
+    incalldeclare = 0;
+    inside_type_declare = 0;
+    Allocatabledeclare = 0 ;
+    Targetdeclare = 0 ;
+    VariableIsParameter =  0 ;
+    strcpy(NamePrecision,"");
+    c_star = 0 ;
+    functiondeclarationisdone = 0;
+    insubroutinedeclare = 0 ;
+    strcpy(subroutinename," ");
+    isrecursive = 0;
+    InitialValueGiven = 0 ;
+    GlobalDeclarationType = 0;
+    inmoduledeclare = 0;
+    incontainssubroutine = 0;
+    afterpercent = 0;
+    aftercontainsdeclare = 1;
+    strcpy(nameinttypename,"");
+
 /******************************************************************************/
 /*  3-  Parsing of the input file (1 time)                                    */
 /******************************************************************************/
-   if (firstpass == 0 )
-   {
-      fortranout=fopen(nomfileoutput,"w");
-
-/*      NewModule_Creation_0();*/
-   }
-
-   fortranparse();
-
-   if (firstpass == 0 )
-   {
-   NewModule_Creation_0();
-   }
-   
-   strcpy(curfile,mainfile);
-
-   if (firstpass == 0 )
-   {
-   fclose(fortranout);
-   }
+
+    sprintf(output_file, "%s/%s", output_dir, input_file);
+
+    if (firstpass == 0) fortran_out = fopen(output_file,"w");
+
+    fortran_parse();
+
+    if (firstpass == 0) NewModule_Creation_0();
+    if (firstpass == 0) fclose(fortran_out);
 }
-
 #line 2 "fortran.yy.c"
 
@@ -6870,22 +6417,22 @@
 /* A lexical scanner generated by flex */
 
-#define yy_create_buffer fortran_create_buffer
-#define yy_delete_buffer fortran_delete_buffer
-#define yy_flex_debug fortran_flex_debug
-#define yy_init_buffer fortran_init_buffer
-#define yy_flush_buffer fortran_flush_buffer
-#define yy_load_buffer_state fortran_load_buffer_state
-#define yy_switch_to_buffer fortran_switch_to_buffer
-#define yyin fortranin
-#define yyleng fortranleng
-#define yylex fortranlex
-#define yylineno fortranlineno
-#define yyout fortranout
-#define yyrestart fortranrestart
-#define yytext fortrantext
-#define yywrap fortranwrap
-#define yyalloc fortranalloc
-#define yyrealloc fortranrealloc
-#define yyfree fortranfree
+#define yy_create_buffer fortran__create_buffer
+#define yy_delete_buffer fortran__delete_buffer
+#define yy_flex_debug fortran__flex_debug
+#define yy_init_buffer fortran__init_buffer
+#define yy_flush_buffer fortran__flush_buffer
+#define yy_load_buffer_state fortran__load_buffer_state
+#define yy_switch_to_buffer fortran__switch_to_buffer
+#define yyin fortran_in
+#define yyleng fortran_leng
+#define yylex fortran_lex
+#define yylineno fortran_lineno
+#define yyout fortran_out
+#define yyrestart fortran_restart
+#define yytext fortran_text
+#define yywrap fortran_wrap
+#define yyalloc fortran_alloc
+#define yyrealloc fortran_realloc
+#define yyfree fortran_free
 
 #define FLEX_SCANNER
@@ -6930,4 +6477,5 @@
 typedef int32_t flex_int32_t;
 typedef uint32_t flex_uint32_t;
+typedef uint64_t flex_uint64_t;
 #else
 typedef signed char flex_int8_t;
@@ -7018,5 +6566,5 @@
 
 /* Special action meaning "start processing a new file". */
-#define YY_NEW_FILE fortranrestart(fortranin  )
+#define YY_NEW_FILE fortran_restart(fortran_in  )
 
 #define YY_END_OF_BUFFER_CHAR 0
@@ -7041,7 +6589,7 @@
 #endif
 
-extern yy_size_t fortranleng;
-
-extern FILE *fortranin, *fortranout;
+extern yy_size_t fortran_leng;
+
+extern FILE *fortran_in, *fortran_out;
 
 #define EOB_ACT_CONTINUE_SCAN 0
@@ -7055,5 +6603,5 @@
 	do \
 		{ \
-		/* Undo effects of setting up fortrantext. */ \
+		/* Undo effects of setting up fortran_text. */ \
         int yyless_macro_arg = (n); \
         YY_LESS_LINENO(yyless_macro_arg);\
@@ -7061,5 +6609,5 @@
 		YY_RESTORE_YY_MORE_OFFSET \
 		(yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
-		YY_DO_BEFORE_ACTION; /* set up fortrantext again */ \
+		YY_DO_BEFORE_ACTION; /* set up fortran_text again */ \
 		} \
 	while ( 0 )
@@ -7124,6 +6672,6 @@
 	 *
 	 * When we actually see the EOF, we change the status to "new"
-	 * (via fortranrestart()), so that the user can continue scanning by
-	 * just pointing fortranin at a new input file.
+	 * (via fortran_restart()), so that the user can continue scanning by
+	 * just pointing fortran_in at a new input file.
 	 */
 #define YY_BUFFER_EOF_PENDING 2
@@ -7152,8 +6700,8 @@
 #define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
 
-/* yy_hold_char holds the character lost when fortrantext is formed. */
+/* yy_hold_char holds the character lost when fortran_text is formed. */
 static char yy_hold_char;
 static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
-yy_size_t fortranleng;
+yy_size_t fortran_leng;
 
 /* Points to current character in buffer. */
@@ -7162,39 +6710,39 @@
 static int yy_start = 0;	/* start state number */
 
-/* Flag which is used to allow fortranwrap()'s to do buffer switches
- * instead of setting up a fresh fortranin.  A bit of a hack ...
+/* Flag which is used to allow fortran_wrap()'s to do buffer switches
+ * instead of setting up a fresh fortran_in.  A bit of a hack ...
  */
 static int yy_did_buffer_switch_on_eof;
 
-void fortranrestart (FILE *input_file  );
-void fortran_switch_to_buffer (YY_BUFFER_STATE new_buffer  );
-YY_BUFFER_STATE fortran_create_buffer (FILE *file,int size  );
-void fortran_delete_buffer (YY_BUFFER_STATE b  );
-void fortran_flush_buffer (YY_BUFFER_STATE b  );
-void fortranpush_buffer_state (YY_BUFFER_STATE new_buffer  );
-void fortranpop_buffer_state (void );
-
-static void fortranensure_buffer_stack (void );
-static void fortran_load_buffer_state (void );
-static void fortran_init_buffer (YY_BUFFER_STATE b,FILE *file  );
-
-#define YY_FLUSH_BUFFER fortran_flush_buffer(YY_CURRENT_BUFFER )
-
-YY_BUFFER_STATE fortran_scan_buffer (char *base,yy_size_t size  );
-YY_BUFFER_STATE fortran_scan_string (yyconst char *yy_str  );
-YY_BUFFER_STATE fortran_scan_bytes (yyconst char *bytes,yy_size_t len  );
-
-void *fortranalloc (yy_size_t  );
-void *fortranrealloc (void *,yy_size_t  );
-void fortranfree (void *  );
-
-#define yy_new_buffer fortran_create_buffer
+void fortran_restart (FILE *input_file  );
+void fortran__switch_to_buffer (YY_BUFFER_STATE new_buffer  );
+YY_BUFFER_STATE fortran__create_buffer (FILE *file,int size  );
+void fortran__delete_buffer (YY_BUFFER_STATE b  );
+void fortran__flush_buffer (YY_BUFFER_STATE b  );
+void fortran_push_buffer_state (YY_BUFFER_STATE new_buffer  );
+void fortran_pop_buffer_state (void );
+
+static void fortran_ensure_buffer_stack (void );
+static void fortran__load_buffer_state (void );
+static void fortran__init_buffer (YY_BUFFER_STATE b,FILE *file  );
+
+#define YY_FLUSH_BUFFER fortran__flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE fortran__scan_buffer (char *base,yy_size_t size  );
+YY_BUFFER_STATE fortran__scan_string (yyconst char *yy_str  );
+YY_BUFFER_STATE fortran__scan_bytes (yyconst char *bytes,yy_size_t len  );
+
+void *fortran_alloc (yy_size_t  );
+void *fortran_realloc (void *,yy_size_t  );
+void fortran_free (void *  );
+
+#define yy_new_buffer fortran__create_buffer
 
 #define yy_set_interactive(is_interactive) \
 	{ \
 	if ( ! YY_CURRENT_BUFFER ){ \
-        fortranensure_buffer_stack (); \
+        fortran_ensure_buffer_stack (); \
 		YY_CURRENT_BUFFER_LVALUE =    \
-            fortran_create_buffer(fortranin,YY_BUF_SIZE ); \
+            fortran__create_buffer(fortran_in,YY_BUF_SIZE ); \
 	} \
 	YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
@@ -7204,7 +6752,7 @@
 	{ \
 	if ( ! YY_CURRENT_BUFFER ){\
-        fortranensure_buffer_stack (); \
+        fortran_ensure_buffer_stack (); \
 		YY_CURRENT_BUFFER_LVALUE =    \
-            fortran_create_buffer(fortranin,YY_BUF_SIZE ); \
+            fortran__create_buffer(fortran_in,YY_BUF_SIZE ); \
 	} \
 	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
@@ -7215,16 +6763,19 @@
 /* Begin user sect3 */
 
+#define fortran_wrap(n) 1
+#define YY_SKIP_YYWRAP
+
 typedef unsigned char YY_CHAR;
 
-FILE *fortranin = (FILE *) 0, *fortranout = (FILE *) 0;
+FILE *fortran_in = (FILE *) 0, *fortran_out = (FILE *) 0;
 
 typedef int yy_state_type;
 
-extern int fortranlineno;
-
-int fortranlineno = 1;
-
-extern char *fortrantext;
-#define yytext_ptr fortrantext
+extern int fortran_lineno;
+
+int fortran_lineno = 1;
+
+extern char *fortran_text;
+#define yytext_ptr fortran_text
 
 static yy_state_type yy_get_previous_state (void );
@@ -7234,9 +6785,9 @@
 
 /* Done after the current pattern has been matched and before the
- * corresponding action - sets up fortrantext.
+ * corresponding action - sets up fortran_text.
  */
 #define YY_DO_BEFORE_ACTION \
 	(yytext_ptr) = yy_bp; \
-	fortranleng = (size_t) (yy_cp - yy_bp); \
+	fortran_leng = (yy_size_t) (yy_cp - yy_bp); \
 	(yy_hold_char) = *yy_cp; \
 	*yy_cp = '\0'; \
@@ -7252,133 +6803,130 @@
 	flex_int32_t yy_nxt;
 	};
-static yyconst flex_int16_t yy_accept[1162] =
+static yyconst flex_int16_t yy_accept[1132] =
     {   0,
         0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-        0,    0,  177,  176,  165,  161,  164,  175,  152,  151,
-      155,  167,  152,  154,  154,  154,  157,  153,  137,  150,
-      156,  159,  158,  160,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  165,  161,  164,  175,  150,  145,  145,  145,
-      145,  145,  145,  176,  176,  173,  176,  176,  176,  161,
-      161,  154,  145,    0,    0,  165,    0,  166,    0,  164,
-      175,  175,  175,    0,  141,    0,    0,  167,  167,  167,
-      167,    0,    0,    0,  140,    0,    0,  132,   26,    0,
-
-      146,    0,    0,    0,    0,    0,    0,    0,  133,    0,
-      150,   25,    0,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-       43,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,   85,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  165,  163,    0,  163,    0,    0,    0,    0,
-        0,    0,  166,  162,  163,    0,  175,  174,  175,  175,
-      175,  163,  150,    4,  145,  145,  145,  145,   85,  145,
-
-      145,    0,  173,    0,    0,    0,    0,    0,    0,    0,
-      169,   26,    0,    0,    4,    0,  145,  145,  145,  145,
-      145,  145,    0,    0,    0,  175,  175,    0,    0,  167,
-      167,    0,    0,    0,    0,  139,    0,    0,    0,    0,
-        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-        0,  149,  146,    0,    0,    0,  142,    0,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  115,  145,  145,  145,    0,  145,  145,  145,  145,
-      145,   16,  145,  145,  145,  114,  145,  145,  145,  145,
-      145,    0,  145,    0,   96,  145,  145,  145,  145,  145,
-
-      121,  145,  145,  126,  145,  145,  145,  145,  145,  145,
-      145,   89,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  118,  145,  145,  145,
-      145,  145,  122,  145,  145,  145,  145,  145,  165,  163,
-        0,  166,    0,    0,    0,    0,    0,    0,    0,    0,
-      163,    0,  163,  175,  175,  175,  150,    4,    4,    4,
-        4,  145,  145,  145,  145,  145,  145,  145,    0,    0,
-        0,    0,  170,    0,    0,  169,    0,    0,    4,    4,
-        4,    4,  142,    0,  145,  145,    0,  145,  145,  145,
-      145,    0,    0,    0,  175,  175,    0,    0,  167,  167,
-
-        0,    0,    0,    0,  147,    0,  146,    0,  148,    0,
-       28,    0,   30,   29,   32,   31,   34,    0,    0,   36,
-        0,  146,    0,  147,    0,  146,    0,  148,    0,  142,
-        0,  125,  117,  145,  145,  120,  123,  145,  145,   22,
-      145,  145,  145,  145,  145,  116,  145,  145,  145,    0,
-      145,  145,  145,   94,    0,  108,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,    0,  109,  145,  145,  145,
-      145,  145,  145,  145,    0,   88,  145,  145,  145,  145,
-      145,  145,  145,    0,   98,  145,  145,    0,  111,  145,
-      145,  145,  145,  112,   21,  145,   60,   74,  145,  145,
-
-      145,  145,  145,  145,  145,  145,   79,   44,  145,  145,
-      145,  145,   69,  145,  127,  119,  145,   72,   54,  145,
-        0,   97,   99,  145,   92,  101,  145,  145,  165,  163,
-      166,    0,    0,    0,    0,    0,    0,    0,  163,    0,
-      163,  175,  175,  175,  150,    4,    4,  145,  145,  145,
-      145,  145,  145,   18,    0,    0,    0,    0,    0,  170,
-        0,    0,    4,    4,    0,  142,    0,  145,  145,  145,
-      145,    0,    0,    0,  175,  175,    0,    0,  167,  167,
-        0,    0,   38,   27,    0,   35,   37,    0,  142,    0,
-      142,  145,  145,  145,  145,  145,   49,  145,  145,  145,
-
-      124,  145,  145,    0,  145,  145,  145,    0,  145,  145,
-        0,    0,    0,    0,    0,    0,    0,    0,   42,  145,
-       95,  145,  145,  145,  145,  145,  145,  145,  145,   76,
-       76,   76,   76,  145,    0,  107,  113,  145,  145,   88,
-      145,  145,   90,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,   52,  145,   77,
-      145,  145,  145,    0,  145,  145,  145,  145,  145,  102,
-      145,  145,   55,   81,  165,  163,  166,    0,    0,    0,
-        0,    0,    0,  163,    0,  163,  175,  175,  175,  150,
-        4,    3,    0,  104,  145,  145,   86,  145,  145,   70,
-
-       71,   70,    0,    0,    0,    0,    4,    3,    0,  142,
-        0,  142,  145,   49,  145,  124,    0,   23,    0,  175,
-       23,    0,   23,   23,  167,   23,    0,   23,   23,   23,
-       33,  145,  145,   23,   23,   23,  145,  145,   63,  145,
-      145,  145,  145,    0,  145,  145,  138,    0,    0,   93,
-      145,   42,    0,   95,    0,    0,    0,    0,    0,    0,
-      145,  145,  145,  145,  145,  145,  145,  145,    0,  110,
-      145,  145,  145,  145,  145,  145,  145,   66,  145,  145,
-      129,  100,  128,  130,   39,  145,  145,  145,  145,  145,
-      145,  145,   83,    0,  145,   11,   75,   19,  145,  145,
-
-       82,  165,  163,  166,    0,    0,    0,    0,  163,  175,
-      175,   23,    4,    3,    3,  145,  145,  145,  145,    0,
-        0,    0,   23,    4,    3,    3,  145,   23,   23,   23,
-       24,    0,  168,   24,   24,   24,   24,   24,   24,   24,
-       24,   24,   24,  145,  145,  145,   58,  145,  145,  145,
-        0,    0,  145,  145,   40,   93,    0,  145,    0,    0,
-        0,    0,    0,    0,    0,  145,  145,  145,  145,  145,
-       73,  145,  145,  145,    0,    0,  145,  145,   17,   50,
-       45,  145,   46,    0,  145,  145,    9,  145,  145,   67,
-       84,    7,    0,    0,  145,    0,  145,  145,    0,    0,
-
-        0,    0,  175,   24,    4,  145,  145,   64,  145,    0,
-        0,   24,    4,   24,   24,   24,  145,    8,  145,  145,
-       87,  145,  145,   40,    0,    0,  145,  145,    0,  145,
-        0,    0,    0,    0,    0,   73,    0,  145,  145,  145,
-      145,  145,   56,  145,   65,    0,    0,    0,    0,  134,
-       12,   20,  145,    0,  145,   80,   68,  145,    0,  145,
-        0,  145,  145,    0,    0,    0,  175,    4,  145,   59,
-      145,    0,    0,    4,  145,  131,   47,  145,   51,    0,
-        0,  145,  145,    0,   57,    0,    0,    0,    0,    0,
-       56,  145,   41,  145,  106,  145,  145,    0,    0,    0,
-
-        0,    0,  134,   91,    0,  145,   61,    0,   62,    0,
-      145,  145,    0,   59,    0,  175,    4,    4,  145,  143,
-        0,    0,    4,    4,  145,   10,    0,    0,  145,  145,
-       57,    0,   41,    0,  106,    0,  145,   14,  145,  145,
-        0,    0,    0,  145,    0,    0,  103,    6,    0,  143,
-      175,    4,    4,  145,    0,    0,    4,    4,   48,    0,
-        0,  145,  145,    0,   14,    0,   15,  145,   53,    0,
-        0,    0,  145,    0,  103,    0,  175,    4,    2,  105,
-        0,    0,    4,    2,    0,    0,  145,  145,   15,    0,
-      145,    0,    0,    0,  145,    0,  105,  175,    4,    0,
-
-        0,    4,    0,    0,  136,  145,    0,   13,    0,    0,
-        0,  145,    0,  175,    1,    0,    0,  144,    1,  136,
-        0,  145,   13,    0,    0,    0,    0,  145,    0,  175,
-        0,    0,  135,    0,    0,    0,   78,    5,  175,    0,
-      135,   78,  175,    0,  175,    0,  175,    0,  175,    0,
-      175,    0,  175,  171,    0,    0,    0,    0,    0,  172,
+        0,    0,  177,  176,  166,  164,  175,  176,  155,  158,
+      176,  176,  157,  157,  157,  160,  156,  144,  154,  157,
+      159,  162,  161,  163,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  166,  164,  166,  175,  154,  151,
+      151,  151,  151,  151,  151,  176,  176,  172,  176,  176,
+      176,  157,  151,    0,    0,  166,    0,    0,  175,  175,
+      175,    0,  148,    0,    0,    0,  168,    0,    0,    0,
+        0,    0,  147,    0,    0,  141,   25,    0,  153,    0,
+
+        0,    0,    0,    0,    0,    0,  142,    0,  154,    0,
+      140,   23,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,   42,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  100,  151,   89,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,    0,  166,  166,    0,  167,    0,
+        0,    0,    0,    0,    0,  165,  166,    0,  175,  174,
+      175,  175,  175,  167,  154,    0,  151,  151,  151,  151,
+
+       89,  151,  151,    0,  172,    0,    0,    0,    0,    0,
+        0,  173,   25,    0,    0,    0,  151,  151,  151,  151,
+      151,    0,    0,    0,  175,  175,    0,    0,    0,    0,
+        0,    0,    0,    0,  146,    0,    0,    0,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,    0,  152,  152,
+        0,  153,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  123,  151,  151,  151,
+      151,  151,  151,  151,   14,  151,  151,  151,  151,  122,
+      151,  151,  151,  151,  151,  151,  151,    0,  151,  151,
+      151,  151,  151,  151,  129,  151,  151,  134,  151,  151,
+
+      151,  151,  151,  151,  151,  151,   93,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  126,  151,  151,  151,  151,  151,  130,  151,  151,
+      151,  151,  151,  151,  151,    0,  166,  166,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,  166,    0,  167,
+      175,  175,  175,  154,    0,  151,  151,  151,  151,  151,
+      151,  151,    0,    0,    0,    0,  173,    0,    0,    0,
+      151,  151,  151,  151,  151,    0,    0,    0,  175,  175,
+        0,    0,    0,    0,    0,    0,    0,    0,  153,    0,
+       27,    0,   29,   28,   31,   30,   33,    0,    0,   35,
+
+        0,    0,  133,  125,  151,  151,  128,  151,  131,  151,
+      151,   20,  151,  151,  151,  151,  151,  151,  124,  151,
+      151,  151,  151,  151,  151,   98,    0,  115,  151,  151,
+      151,  151,  151,  151,  151,  151,    0,  116,  151,    0,
+      117,  151,  151,  151,  151,  151,  151,    0,  113,  151,
+      151,    0,   92,  151,  151,  151,  151,  151,  151,  151,
+        0,  102,  151,  151,    0,  119,  151,  151,  151,  151,
+      120,    0,  114,   19,  151,   63,   77,  151,  151,  151,
+      151,  151,  151,  151,  151,   82,   43,  151,  151,  151,
+      151,   72,  151,  151,  127,  151,   76,   57,  151,    0,
+
+      101,  103,  151,   96,  105,  151,  151,  151,  151,   47,
+      166,  166,    0,    0,    0,    0,    0,    0,    0,  166,
+        0,  167,  175,  175,  175,  154,    0,  108,  151,  151,
+      151,  151,  151,   16,    0,    0,    0,    0,    0,    0,
+      151,  151,  151,  151,    0,    0,    0,  175,  175,    0,
+        0,    0,    0,    0,    0,   37,   26,    0,   34,   36,
+      151,  151,  151,  151,  151,  151,   52,  151,  151,  151,
+      151,  132,  151,  151,  151,  151,  151,    0,  151,  151,
+        0,    0,    0,    0,    0,    0,    0,    0,   41,  151,
+       99,  151,  151,  151,  151,  151,  151,  151,  151,   79,
+
+       79,  151,    0,  111,  121,   85,  151,  151,   92,  151,
+      151,   94,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,    0,    0,  151,  151,  151,   55,  151,
+       80,  151,  151,  151,    0,  151,  151,  151,  151,  151,
+        0,  135,  106,  151,  151,    0,  112,   58,   39,   84,
+      166,  166,  108,    0,    0,    0,    0,    0,  166,    0,
+      167,  175,  175,  175,  154,    0,  108,  151,   90,  151,
+      151,   74,   73,   74,    0,    0,    0,    0,    0,  151,
+       52,  151,  132,    0,   21,    0,  175,   21,    0,   21,
+       21,    0,   21,    0,   21,   21,   21,   32,  151,  151,
+
+      151,   21,  151,  151,   66,  151,  151,  151,  151,  151,
+      151,  151,  145,    0,    0,   97,  151,   41,    0,   99,
+        0,    0,    0,    0,    0,    0,  151,  151,  151,  151,
+      151,  151,  151,  151,    0,  118,  151,  151,  151,  151,
+      151,  151,  151,   69,  151,  151,  137,  104,  136,  138,
+       38,  151,    0,    6,  151,  151,  151,  151,  151,  151,
+       87,    0,  151,    8,   78,   17,  151,  151,   86,  166,
+      166,    0,    0,    0,  166,  175,  175,   21,    0,  151,
+      151,  151,    0,    0,    0,   21,    0,  151,   21,   22,
+        0,  169,   22,   22,   22,   22,   22,   22,   22,   22,
+
+      151,  151,  151,  151,   50,  151,  151,  151,  109,  151,
+        0,  151,  151,   97,    0,  151,    0,    0,    0,    0,
+        0,    0,    0,  151,  151,  151,  151,  151,   75,  151,
+      151,  151,    0,    0,  151,  151,   15,   53,   44,  151,
+       45,    0,  151,  151,    5,  151,  151,   70,   88,    3,
+        0,    0,  151,    0,  151,  151,    0,    0,    0,  175,
+       22,    0,  151,   67,  151,    0,    0,   22,    0,   22,
+      151,    4,  151,  151,  151,  151,   91,  151,  151,    0,
+        0,  151,  151,    0,  151,    0,    0,    0,    0,    0,
+       75,    0,  151,  151,  151,  151,  151,   59,  151,   68,
+
+        0,    0,    0,    0,  143,    9,   18,  151,    0,  151,
+       83,   71,  151,    0,  151,    0,  151,  151,    0,    0,
+      175,    0,   62,  151,    0,    0,    0,  151,  151,  139,
+       46,  151,  151,   54,    0,    0,  151,  151,    0,   61,
+        0,    0,    0,    0,    0,   59,  151,   11,  151,  110,
+      151,  151,    0,    0,    0,    0,    0,  143,   95,    0,
+      151,   64,    0,   65,    0,  151,  151,   62,    0,  175,
+        0,  149,    0,    0,    0,  151,  151,   40,    7,    0,
+        0,  151,  151,   61,    0,   60,    0,   11,    0,  110,
+        0,  151,   10,  151,  151,    0,    0,    0,  151,    0,
+
+        0,  107,    2,  149,  175,    0,    0,    0,    0,   51,
+        0,    0,    0,    0,  151,  151,    0,   10,    0,   13,
+      151,   56,    0,    0,    0,  151,    0,  107,  175,    0,
+        0,    0,    0,    0,    0,    0,    0,  151,  151,   13,
+        0,  151,    0,    0,    0,  151,    0,  175,    0,    0,
+        0,    0,    0,   24,    0,    0,   49,  151,    0,   12,
+        0,    0,    0,  151,    0,  175,    0,    0,    0,  150,
+        0,   49,    0,  151,   12,    0,    0,    0,    0,  151,
+        0,  175,    0,    0,    0,    0,   48,    0,    0,    0,
+       81,    1,  175,    0,    0,    0,   48,   81,  175,    0,
+
+        0,    0,  175,    0,    0,    0,  175,    0,    0,    0,
+      175,    0,    0,    0,  175,    0,    0,    0,  175,  170,
+        0,  170,    0,    0,  170,    0,    0,    0,    0,  171,
         0
     } ;
@@ -7399,5 +6947,5 @@
        68,   69,   70,   71,   72,   44,   73,   74,   75,   76,
        77,   78,   79,   80,   81,   82,   83,   84,   85,   86,
-       87,   88,   89,   89,   89,    1,    1,    1,    1,    1,
+       87,   88,    1,   89,    1,    1,    1,    1,    1,    1,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
@@ -7418,1313 +6966,736 @@
 static yyconst flex_int32_t yy_meta[90] =
     {   0,
-        1,    2,    3,    2,    1,    4,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    5,    1,    6,
-        6,    6,    6,    6,    6,    6,    6,    6,    6,    1,
-        1,    1,    1,    1,    7,    8,    8,    9,    9,    5,
-       10,   11,    8,    8,    8,   10,   10,   10,    7,    8,
-        9,   10,   10,    5,   10,    8,   12,    8,    8,    8,
-        1,    1,    8,    7,    8,    8,    9,    9,    5,   10,
-       11,    8,    8,   10,   10,   10,    7,    8,    9,   10,
-       10,    5,   10,    8,   12,    8,    8,    8,    4
+        1,    1,    2,    1,    1,    3,    1,    1,    1,    1,
+        1,    4,    1,    1,    1,    1,    1,    3,    1,    5,
+        5,    5,    5,    5,    5,    5,    5,    5,    5,    1,
+        1,    1,    1,    1,    6,    7,    7,    5,    5,    8,
+        9,   10,   11,   11,   11,    9,   11,    9,   12,   11,
+       13,    9,    9,    9,    9,   11,   11,   11,   11,   11,
+        1,    1,   11,    6,    7,    7,    5,    5,    8,    9,
+       10,   11,   11,    9,   11,    9,   12,   11,   13,    9,
+        9,    9,    9,   11,   11,   11,   11,   11,    3
     } ;
 
-static yyconst flex_int16_t yy_base[1215] =
+static yyconst flex_int16_t yy_base[1171] =
     {   0,
-        0,   88,    0,    0,    0,    0, 1215,   93, 1196,   91,
-        0,    0, 1179,   64,   97,  117,  132,   87,  124,   98,
-       99,  142,  173,  154,  108,  135,  134,  254,  172,  179,
-      175,  178,  219,  180,  323,  388,  384,  318,  386,  319,
-      186,  128,  250,  256,  392,  404,  438,  428,  204,  455,
-      432,  465,  544,  120,  537,  548,  627,  624,  622,  544,
-      644,  658,  251, 9159, 1175, 9159,  267,   99,  162,  569,
-      572,  620,  745,  164,  107,  262,  307,  335,  376,  522,
-        0,  167,  157, 1162, 9159,  278,  321, 1160, 1118,  372,
-      304,  532,  593,  567, 9159,  633,  832, 9159, 9159,  911,
-
-      798,  318,  319,  450,  799,  552,  320,  354, 9159,  978,
-      834, 9159,  865,  860,  862,  866,  914,  863,  973,  980,
-      974, 1013, 1024, 1045,  869, 1049, 1075, 1095, 1098, 1101,
-     1182, 1177, 1161, 1181, 1214, 1212, 1237, 1239, 1235, 1270,
-     1290, 1316, 1325, 1293, 1346, 1323, 1366, 1368, 1391, 1399,
-     1403, 1429, 1430, 1455, 1452, 1478, 1498, 1482, 1523, 1521,
-     1554, 1548, 1579, 1586, 1606, 1629, 1649, 1675, 1681, 1698,
-     1707, 1729,  871, 1114, 1109,  140, 1023,  187,  372,  403,
-      553,  401, 1095,  565, 1792, 1818, 1083, 9159,  643,  669,
-      589, 1844, 1870, 1580, 1865, 1867, 1868, 1905, 1926, 1922,
-
-     1925, 1078, 9159,  837,  437,  677,  249,  660, 1072,  712,
-     9159, 1062,  844,  625, 1874, 1993, 2022, 1042,  864,  473,
-      904,  621,  506,  651,  721,  798,  791,  890,  912,  936,
-      907,  725, 1029, 1143,  729, 9159, 1114, 1179, 2097, 2112,
-     2127,  229,  937, 1033, 1012, 1006,  994,  943,  883,  974,
-      891, 9159, 1476, 2142, 2157, 2172, 2182, 2202, 2178, 2180,
-     2200, 2203, 2223, 2243, 2246, 2244, 2276, 2269, 2299, 2307,
-     2301, 2324, 2344, 2351, 2377,  901, 1018, 2374, 2394, 2397,
-     2414, 2495, 2434, 2440, 2465, 2472, 2518, 2521, 2515, 2548,
-     2556, 1138, 2564,  968, 9159, 2581, 2597, 2604, 2627, 2649,
-
-     2650, 2690, 2693, 2686, 2726, 2738, 2746, 2747, 2763, 2783,
-     2799, 2800, 2803, 2820, 2840, 2843, 2870, 2891, 2895, 2903,
-     2926, 2928, 2935, 2961, 2981, 2958, 2984, 2978, 3004, 3011,
-     3027, 3052, 3048, 3059, 3085, 3068, 3105, 3111,  196,  203,
-      976,  383,  974,  988, 1018, 1014, 1025, 1029, 1042,  253,
-     3174, 3200, 3226, 1067, 1182, 1172, 3252,    0,  418,  288,
-     1096, 3228, 3229, 3231, 3251, 3267, 3287, 3290, 1188, 1566,
-      973,  740, 9159,  938,  866, 9159, 1268, 1178,  931, 1170,
-     1241, 1299, 3354, 3381,    0,  903, 3408, 1148, 1116, 1177,
-     1322, 1145,  410, 1415, 1235,  460, 1292, 1218, 1323, 1022,
-
-      963, 1520, 1662, 3418, 3430, 3440, 3450, 3460, 3470,  889,
-     9159,  865, 9159, 9159, 9159, 9159, 9159, 1239,  853, 9159,
-      846, 2472, 3480, 3490, 3500, 3510, 3520, 3530, 3545, 3555,
-     3575, 9159, 3289, 3553, 3573, 3551, 3574, 3590, 3596, 3612,
-     3628, 3634, 3635, 3655, 3671, 3651, 3687, 3688, 3696,  459,
-     3728, 3736, 3740, 3784, 3868, 9159, 3780, 3776, 3807, 3811,
-     3850, 3912, 3872, 3920, 3921, 1351, 9159, 3828, 4005, 4060,
-     4095, 3904, 4063, 4069, 1258, 4096, 4104, 4126, 4134, 4156,
-     4165, 4196, 4205, 1409, 9159, 4208, 4197, 1476, 9159, 4235,
-     4241, 4257, 4261, 4273, 4284, 4293, 4305, 4309, 4332, 4336,
-
-     4353, 4316, 4359, 4362, 4384, 4407, 4385, 4416, 4423, 4448,
-     4455, 4456, 4486, 4494, 4488, 4511, 4527, 4519, 4531, 4554,
-     1498, 9159, 4552, 4575, 4584, 4587, 4607, 4610,  493,  529,
-      551,  476, 1287,  816,  953, 1119, 1293,  841, 4678, 4704,
-     4730, 1607, 1346, 1458, 4756, 1362, 1397, 4733, 4732, 4759,
-     4627, 4768, 4817,  733, 1619, 1594, 1406,  728, 1537, 9159,
-     1571, 1651, 1625, 1613, 4839, 4867, 4894, 1627, 1658, 1686,
-     1714, 1394,    0, 1756, 1574,    0, 1668,  724, 1709,  724,
-     1763, 1775, 9159, 9159,  708, 9159, 9159, 4904, 4916, 4926,
-     4936, 4771, 4931, 5013, 4934, 5068, 5069, 5071, 5075, 5072,
-
-     5120, 5121, 5123, 1725, 5127, 5153, 5176, 1832, 5175, 5179,
-     1458, 1493, 1739, 1516, 1519, 1873, 1592, 1739, 5201, 5224,
-     5202, 5241, 5240, 5257, 5278, 5280, 5301, 5284, 5352, 9159,
-     5351, 5346, 5349, 5353, 1802, 9159, 5355, 5385, 5401, 9159,
-     5405, 5408, 5412, 5428, 5449, 5451, 5458, 5460, 5495, 5501,
-     5531, 5527, 5539, 5571, 5564, 5575, 5591, 5602, 5623, 5614,
-     5634, 5635, 5660,  693, 5666, 5667, 5692, 5703, 5715, 9159,
-     5723, 5719, 5740, 5746,  846, 1103, 1234, 1788, 1768, 1386,
-     1788, 1615, 1847, 1854,  236,  590, 1781, 1913,  715, 5809,
-     1790, 1645, 2264, 9159, 5785, 5805, 1690, 5806, 5807, 2344,
-
-     9159, 1951, 1858, 1924, 2256,  679, 1930, 1879, 5870, 5880,
-     5907, 5917, 1811,  658, 5946,  624,    0, 9159, 6034,    0,
-        0,  613,  609, 9159,  604,  586, 2245, 2364, 2389, 9159,
-     9159, 6063, 6118, 6139, 6138, 6134, 6135, 6141, 6161, 6173,
-     6184, 6209, 6217, 1654, 6260, 6248, 6216, 1844, 1864, 6239,
-     6280, 9159, 1689, 9159, 1930, 1750, 1763, 1934, 1933, 2077,
-     6300, 6292, 6317, 6337, 6338, 6344, 6369, 6376, 2212, 9159,
-     6360, 6413, 6392, 6412, 6424, 6433, 6456, 6435, 6465, 6476,
-     6488, 6497, 6508, 6509, 6552, 6529, 6540, 6549, 6560, 6585,
-     6593, 6605, 6628, 2392, 6636, 6637, 6648, 6659, 6694, 6685,
-
-     6686, 6775, 2286,  518, 2092, 2103, 1938, 2148, 2420, 2303,
-      472,  442, 2196,    0, 1803, 6692, 6717, 6768, 6756, 2424,
-     2334,  426,  422, 2432,  378, 1883, 6858, 6945, 6974,  337,
-     9159, 1922, 9159,    0,  328, 9159,  314, 2481, 2510, 9159,
-     6929, 6757, 7029, 7031, 7037, 7040, 7033, 7077, 7070, 7086,
-     2264, 2842, 7093, 7097, 7118, 9159, 2372, 7129, 2384, 2060,
-     2411, 2418, 2078, 2421, 2139, 7138, 7149, 7170, 7179, 7195,
-     7201, 7227, 7234, 7236, 2483, 3160, 7259, 7257, 7279, 7280,
-     7282, 7302, 7318, 2564, 7325, 7319, 7345, 7356, 7377, 7357,
-     7368, 7388, 2513, 2467, 7400, 2603, 7389, 7425, 2468, 2371,
-
-     2235, 2479,  361,  296,  182, 7409, 7432, 2249, 7455,  622,
-     2529,  227, 1008, 7505,    0,  207, 7482, 7503, 7505, 7514,
-     7535, 7536, 7544, 9159, 2413, 2526, 7567, 7571, 2546, 7593,
-     2547, 2562, 2567, 2526, 2575, 9159, 2526, 7587, 7625, 7594,
-     7631, 7632, 7648, 7657, 7668, 3179, 3203, 2672, 3229, 3335,
-     7684, 7688, 7709, 2597, 7705, 7725, 7732, 7736,  178, 7758,
-     2596, 7775, 7769, 2619, 2617, 2641, 2696, 2668, 7795, 7801,
-     7807, 2677, 2720, 3150, 7827, 7818, 7834, 7867, 7850, 2625,
-     2685, 7870, 7890, 2688, 7859, 2699, 2731, 2741, 2661, 2665,
-     9159, 7911, 7907, 7910, 7927, 7933, 7963, 2822, 3360, 3384,
-
-     3411, 4103, 4220, 7959, 2702, 7970, 7966, 2741, 7986, 2738,
-     8003, 8019, 2758, 9159, 2765, 2781, 2809, 2818, 8030, 8026,
-     2900, 2883, 2903, 2951, 8042, 8051, 2820, 2829, 8063, 8086,
-     9159, 2838, 9159, 2846, 9159, 2846, 8088, 8090, 8113, 8134,
-     3067, 4430, 2880, 8136,  175, 2911, 8125, 8156, 2877, 9159,
-     1190, 2938, 2908, 8157, 3034, 3081, 3049, 3028, 8173, 2959,
-     2985, 8189, 8182, 3029, 9159, 3039, 8205, 8212, 8214, 3241,
-     4684, 3056, 8235, 3049, 9159, 3056, 3212, 3072,    0, 8237,
-     1210, 3169, 3157,  144, 3103, 3103, 8257, 8260, 9159, 3110,
-     8283, 3255, 4708, 3110, 8290,  123, 9159, 3235, 3207, 3329,
-
-     3387, 3558, 3232, 3256, 8306, 8313, 3278, 8315, 8396, 4870,
-     3259, 8391, 3280, 3664,    0, 3349, 3414, 9159,  103, 9159,
-     3346, 8392, 9159, 3745, 4900, 8473, 3347, 8450,   90, 1237,
-     1328, 3570, 8470, 4973, 4977, 3380, 8471, 9159, 3676, 3645,
-     9159, 9159, 3693, 3608, 3764, 3684, 3616, 1433, 3705, 3782,
-     3810, 3774, 3875, 9159, 3852, 3697, 3910, 3892, 3896, 9159,
-     9159, 8553, 8565, 8577, 8589, 8601, 8613, 8621, 8623, 8635,
-     8647, 8659, 8671, 8678, 8687, 8699, 8711, 8723, 8735, 8747,
-     8754, 8762, 8774, 8786, 8798, 8810, 8822, 8834, 8846, 8858,
-     8870, 8882, 8894, 8906, 8918, 8930, 8942, 8954, 8966, 8978,
-
-     8990, 9002, 9014, 9026, 9038, 9050, 9062, 9074, 9086, 9098,
-     9110, 9122, 9134, 9146
+        0,   88,    0,    0,    0,    0,  984,   93,    0,   85,
+        0,    0,  891,   64,   98,  103,   80,  129,   96,   99,
+      134,  137,  145,  133,  168,  135,  249,  180,  318,  136,
+      156,  172,  212,  239,  246,  297,  366,  341,  414,  461,
+      247,  294,  398,  334,  407,  476,  506,  517,  459,  566,
+      572,  522,  571,  367,  653,  226,  656,  658,  737,  638,
+      785,  655,  698,  806,  652, 4012,  878, 4012,  241,  116,
+      124,  455,  893,   59,   76,  229,  253,  256,    0,  122,
+      127,  872, 4012,  157,  188,  869,  866,  327,  302,  349,
+      740,  416, 4012,  768,  592, 4012, 4012,  981,  730,  147,
+
+      184,  438,  495,  328,  184,  190, 4012, 1048,  335,  969,
+     4012, 4012,    0,  269,  315,  149,  319,  486,  462,  248,
+      318,  325,  269,  426,  736,  336,  767,  470,  500,  518,
+      512,  403,  516,  525,  535,  801,  544,  620,  565,  570,
+      589,  768,  483,  589,  810,  592,  613,  638,  650,  664,
+      678,  736,  737,  740,  741,  949,  736,  788,  646,  956,
+      756,  999,  739,  753,  804,  749, 1043,  972,  962,  769,
+      813,  963,  972,  969,    0, 1057,    0,  839,  238, 1044,
+      986,  789,  956, 1030,  965,  429, 1109, 1136,  830, 4012,
+     1061, 1087, 1091, 1162, 1188,  990, 1095, 1120, 1006, 1042,
+
+     1170, 1050, 1046,  823, 4012, 1201, 1099, 1115, 1190,  797,
+      483, 4012,  790, 1167, 1100, 1194, 1269, 1358, 1255, 1254,
+     1195, 1103, 1098,  625, 1148, 1163, 1217, 1237, 1222, 1238,
+     1095, 1305, 1325, 1234, 4012, 1334, 1302, 1326, 1107, 1182,
+      738,  735,  731,  730, 1244, 1166,  713, 1242, 4012, 1428,
+     1374, 1389, 1419, 1244, 1252, 1261, 1263, 1192, 1266, 1301,
+     1333, 1333, 1352, 1352, 1387, 1392, 1388, 1389, 1390, 1404,
+     1401, 1405, 1407, 1404, 1506, 1471, 1417, 1476, 1430,    0,
+     1422, 1437, 1442, 1432, 1484, 1440, 1454, 1497, 1444, 1448,
+     1451, 1443, 1445, 1475, 1459, 1530, 1536, 1464, 1477, 1470,
+
+     1531, 1490, 1491, 1482, 1509, 1511,    0, 1526, 1513, 1519,
+     1524, 1527, 1524, 1555, 1516, 1519, 1522, 1546, 1557, 1564,
+     1558, 1565, 1555, 1557, 1562, 1561, 1615, 1573, 1575, 1573,
+     1576, 1570, 1574, 1582, 1576,  719,  351,  666, 1572,  713,
+     1580, 1587, 1584, 1593, 1589, 1596, 1608, 1658, 1684, 1710,
+     1652, 1645, 1661, 1741, 1626, 1629, 1635, 1634, 1637, 1703,
+     1653,  709, 1654, 1744,  707,  998, 4012, 1712, 1674, 1715,
+     1664, 1708, 1725, 1738, 1749, 1622, 1684, 1379, 1672, 1735,
+     1743, 1771, 1723, 1772, 1787, 1804, 1815, 1807, 1821,  656,
+     4012,  646, 4012, 4012, 4012, 4012, 4012, 1735,  614, 4012,
+
+      613, 1849, 4012,    0, 1741, 1751,    0, 1796,    0, 1799,
+     1799,    0, 1820, 1819, 1811, 1816, 1808, 1821,    0, 1826,
+     1822, 1814, 1822, 1825, 1819, 1871, 1955, 4012, 1825, 1821,
+     1837, 1830, 1829, 1850, 1823, 1844, 1899, 4012, 1836, 1909,
+     4012, 1841, 2040, 1856, 1915, 1858, 1874, 1920, 4012, 1886,
+     1872, 1878,    0, 1886, 1879, 1881, 1888, 1896, 1895, 1902,
+     1967, 4012, 1897, 1906, 1971, 4012, 1900, 1912, 1906, 1915,
+        0, 1980, 4012,    0, 1988,    0,    0, 1929, 1939, 1926,
+     1933, 1936, 1946, 1939, 1953,    0,  602, 1949, 1958, 1955,
+     1963,    0, 1960, 2063,    0,  598,    0,    0, 1985, 2064,
+
+     4012,    0, 1960,    0,    0, 2019, 2022, 2024, 2025, 4012,
+      792,  880, 2030, 2023, 2043, 2043, 2041, 2042,  581, 2092,
+     2118, 2144, 2079, 2080, 2084, 2170, 2045, 1005, 2060, 1022,
+     2071, 2134, 2199,  574, 2082, 2174, 2108, 2147, 2148, 2101,
+     2154, 2184, 2187, 2190, 2087,    0, 1422, 2144,    0, 2200,
+      138, 2202,  571, 2221, 2233, 4012, 4012,  514, 4012, 4012,
+     2174, 2192, 2051, 2289, 2080, 2193,    0, 2109, 2194, 2193,
+     2199,    0, 2201, 2207, 2204, 2195, 2198, 2270, 2240, 2240,
+     2215, 2229, 2246, 2239, 2258, 2275, 2258, 2276,    0, 2276,
+        0, 2287, 2279, 2283, 2295, 2283, 2295, 2300, 2335, 4012,
+
+        0, 2293, 2342, 4012,    0,    0, 2294, 2293, 4012, 2316,
+     2321,    0, 2297, 2323, 2312, 2319, 2335, 2334, 2327, 2337,
+     2333, 2341, 2338,  197,  451, 2343, 2337, 2347,    0, 2348,
+        0, 2335, 2355, 2355,  477, 2343, 2343, 2350, 2355, 2348,
+     2275, 4012, 4012, 2349, 2351, 2404, 4012,    0,    0,    0,
+     1140, 1249, 1797, 2376, 2082, 2379, 2366, 2432, 2263,  424,
+      569, 2417, 2420,  499, 2486, 2384, 2087, 2385, 2427, 2389,
+     2398, 2437, 4012, 2448, 2444, 2439, 2452,  479, 2451, 2431,
+     2410, 2565, 2416,    0, 4012, 2653,    0,    0,  475,  445,
+     4012,  441,  436, 2458, 2462, 2468, 4012, 4012, 2682, 2404,
+
+     2428,    0, 2441, 2444,    0, 2442, 2449, 2447, 2480, 2465,
+     2479, 2553,    0, 2487, 2489,    0, 2493, 4012, 2486, 4012,
+     2497, 2509, 2513, 2527, 2535, 2549, 2552, 2538, 2550, 2555,
+     2548, 2562, 2552, 2559, 2604, 4012, 2572, 2480, 2561, 2568,
+     2573, 2575, 2564,    0, 2569, 2578,    0,    0,    0,    0,
+     2660, 2572,  508, 4012, 2583, 2594, 2591, 2650, 2664, 2658,
+        0, 2536, 2663,    0,    0,    0, 2715, 2654,    0, 2539,
+     2479, 2668, 2663, 2678, 2644, 2682,  426,  421, 2680, 2677,
+     2540, 2686, 2701, 2720,  411,  365, 2721, 2790, 2691, 4012,
+     2725, 4012,    0,  343, 4012,  307, 2753, 2755, 4012,    0,
+
+     2747, 2692, 2702, 2706,    0, 2707, 2709, 2719,    0, 2685,
+     2776, 2708, 2732, 4012, 2748, 2737, 2773, 2763, 2773, 2780,
+     2773, 2788, 2777, 2776, 2785, 2780, 2796, 2786,    0, 2797,
+     2798, 2794, 2647, 2867, 2796, 2791,    0,    0,    0, 2795,
+        0, 2845, 2798, 2801,    0, 2815, 2825,    0,    0,    0,
+     2872, 2840, 2825, 2883, 2847, 2843, 2840, 2548, 2855,  827,
+      303,  239, 2841, 2765, 2855, 1020, 2888,  288, 1687, 2861,
+     2861,    0, 2851, 2861, 2850, 2855,    0, 2851, 2858, 2858,
+     2856, 2863, 2873, 2862, 2878, 2870, 2882, 2880, 2881, 2888,
+     4012, 2904, 2901, 2906, 2913, 2885, 2895,    0, 2903,    0,
+
+     2951, 2978, 2955, 2982, 2994,    0,    0, 2933, 2910, 2917,
+        0,    0, 2923,  248, 2932, 2941, 2930, 2939, 2936, 2956,
+     2998, 2964,    0, 2967, 3005, 3006, 3007, 2966, 2959,    0,
+        0, 2960, 2979,    0, 2973, 2982, 2973, 2987, 2986, 3025,
+     2983, 2989, 2995, 2978, 2978, 4012, 2985,    0, 2991,    0,
+     2985, 3006, 3066, 3074, 3078, 3090, 3094, 3106,    0, 3009,
+     3019,    0, 3041,    0, 3018, 3050, 3056, 4012, 3062, 3076,
+     3056,    0, 3087, 3103, 3099, 3072, 3111,    0,    0, 3064,
+     3080, 3075, 3079, 3124, 3125, 4012, 3082, 4012, 3085, 4012,
+     3080, 3093,    0, 3096, 3104, 3152, 3171, 3113, 3118,  245,
+
+     3119,    0,    0, 4012, 1737,  184, 3142, 3141, 1922,    0,
+     3181, 3186, 3115, 3122, 3127, 3111, 3122, 4012, 3128,    0,
+     3129,    0, 3208, 3211, 3152, 3158, 3150, 4012, 3194, 3154,
+     2097, 3179, 3201, 3224, 3231, 3169, 3153, 3159, 3179, 4012,
+     3183, 3184, 3251, 3258, 3191, 3183,  207, 3229, 3207, 3237,
+      194, 3233, 3261, 4012, 3209, 3200,    0, 3220, 3211,    0,
+     3309, 3283, 3218, 3228, 3221, 3285, 3236, 3273,  142, 4012,
+     3286, 4012, 3243, 3250, 4012, 3339, 3342, 3367, 3248, 3286,
+      108, 2482,   40, 2606, 2838, 3273,    0, 3395, 3399, 3290,
+        0, 4012, 3302, 3294, 3311, 3350, 4012, 4012, 3299, 3320,
+
+     3357, 3358, 3375, 3318, 3359, 3380, 3404, 3376, 3300, 3412,
+     3362, 3363, 3370, 3415, 3418, 3423, 3420, 3426, 3433, 4012,
+     3447, 4012, 3428, 3451, 4012, 3430, 3439, 3454, 3457, 4012,
+     4012, 3521, 3534, 3547, 3560, 3573, 3586, 3595, 3608, 3621,
+     3634, 3647, 3656, 3669, 3678, 3686, 3699, 3712, 3725, 3738,
+     3751, 3764, 3777, 3790, 3803, 3816, 3829, 3842, 3855, 3868,
+     3881, 3894, 3907, 3920, 3933, 3946, 3959, 3972, 3985, 3998
     } ;
 
-static yyconst flex_int16_t yy_def[1215] =
+static yyconst flex_int16_t yy_def[1171] =
     {   0,
-     1161,    1, 1162, 1162,    1,    2, 1163, 1163,    1,    2,
-        1,    2, 1161, 1161, 1161, 1161, 1161, 1164, 1165, 1161,
-     1161, 1166, 1167, 1161, 1161, 1161, 1161, 1161, 1161, 1168,
-     1161, 1161, 1161, 1161, 1169, 1169,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36, 1161, 1161,   53, 1170, 1161,   36,   36,   36,
-       36,   36,   36, 1161, 1171, 1161, 1171, 1171, 1171, 1161,
-     1161, 1172, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1164, 1164, 1164, 1165, 1161, 1165, 1165, 1166, 1161, 1166,
-     1166, 1167, 1173, 1167, 1161, 1167, 1167, 1161, 1161, 1161,
-
-     1174, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1175,
-     1161, 1161, 1161,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-     1169,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   53,  173, 1176, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161,  173, 1161,  173, 1161, 1170, 1161, 1170, 1170,
-     1170, 1161, 1161, 1177,   36,   36,   36,   36,   36,   36,
-
-       36, 1171, 1161, 1171, 1171, 1171, 1171, 1178, 1179, 1179,
-     1161, 1179, 1179, 1179, 1180, 1179, 1161,  217,  217,  217,
-      217,  217, 1161, 1161, 1161, 1164, 1164, 1165, 1165, 1166,
-     1166, 1173, 1173, 1173, 1173, 1161, 1167, 1167, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1181, 1161, 1161, 1161, 1161, 1161,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36, 1182,  131,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36, 1161,   36, 1161, 1161,   36,   36,   36,   36,   36,
-
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,  173,  173,
-     1161,  173, 1176, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-      185, 1161, 1161, 1170, 1170, 1170, 1161, 1177, 1177, 1177,
-     1177,   36,   36,   36,   36,   36,   36,   36, 1171, 1171,
-     1183, 1183, 1161, 1179, 1179, 1161, 1179, 1179, 1180, 1180,
-     1180, 1180, 1179, 1179,  217,  217, 1179,  217,  217,  217,
-      217, 1161, 1161, 1161, 1164, 1164, 1165, 1165, 1166, 1166,
-
-     1173, 1167, 1167, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1181, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36, 1161,
-       36,   36,   36,   36, 1161, 1161,   36,   36,   36,   36,
-       36,   36,   36,   36,   36, 1161, 1161,   36, 1161,   36,
-       36,   36,   36,   36, 1161,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161, 1161,   36,   36, 1161, 1161,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-     1161, 1161,   36,   36,   36,   36,   36,   36,  173,  173,
-      173, 1161, 1161, 1161, 1161, 1161, 1161, 1161,  185, 1161,
-     1161, 1170, 1170, 1170, 1161, 1177, 1177,   36,   36,   36,
-       36,   36,   36, 1161, 1171, 1171, 1171, 1183, 1183, 1161,
-     1179, 1179, 1180, 1180, 1179, 1179, 1179,  217,  217,  217,
-      217, 1161, 1184, 1161, 1164, 1185, 1165, 1186, 1187, 1188,
-     1189, 1190, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
-
-       36,   36,   36, 1161,   36,   36,   36, 1161,   36,   36,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36, 1161,
-     1161,   36,   36,   36, 1161, 1161,   36,   36,   36, 1161,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36,   36,   36, 1161,
-       36,   36,   36,   36,  173,  173,  173, 1161, 1161, 1161,
-     1161, 1161, 1161,  173, 1161, 1161, 1170, 1170, 1191, 1161,
-     1177, 1192, 1161, 1161,   36,   36, 1161,   36,   36, 1161,
-
-     1161, 1161, 1171, 1171, 1179, 1193, 1180, 1194, 1179, 1179,
-     1179, 1179,  217,  217, 1161,  217, 1195, 1161, 1161, 1196,
-     1197, 1198, 1199, 1161, 1200, 1201, 1202, 1203, 1203, 1161,
-     1161, 1161,   36, 1161,   36,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36, 1161, 1161,   36,
-       36, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-       36,   36,   36,   36,   36,   36,   36,   36, 1161, 1161,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
-
-       36, 1161,  802,  802, 1161, 1161, 1161, 1161,  802, 1204,
-     1205, 1204, 1206, 1207, 1207,   36,   36,   36,   36, 1208,
-     1208, 1209, 1210, 1211, 1212, 1212, 1161, 1210, 1161,  829,
-     1161, 1161, 1161, 1197, 1199, 1161, 1201, 1203, 1203, 1161,
-     1161,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-     1161, 1161,   36,   36,   36, 1161, 1161,   36, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161,   36,   36,   36,   36,   36,
-       36,   36,   36,   36, 1161, 1213,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
-       36,   36, 1161, 1161,   36, 1161,   36,   36, 1161, 1161,
-
-     1161, 1161, 1204, 1204, 1206,   36,   36, 1161,   36, 1208,
-     1208, 1210, 1211, 1210,  829,  829,   36,   36,   36,   36,
-       36,   36,   36, 1161, 1161, 1161,   36,   36, 1161,   36,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161,   36,   36,   36,
-       36,   36,   36,   36,   36, 1213, 1213, 1161, 1214, 1213,
-       36,   36,   36, 1161,   36,   36,   36,   36, 1161,   36,
-     1161,   36,   36, 1161, 1161, 1161, 1204, 1206,   36,   36,
-       36, 1208, 1208, 1211,   36,   36,   36,   36,   36, 1161,
-     1161,   36,   36, 1161,   36, 1161, 1161, 1161, 1161, 1161,
-     1161,   36,   36,   36,   36,   36,   36, 1161, 1214, 1214,
-
-     1213, 1214, 1214,   36, 1161,   36,   36, 1161,   36, 1161,
-       36,   36, 1161, 1161, 1161, 1204, 1206, 1206,   36,   36,
-     1208, 1208, 1211, 1211,   36,   36, 1161, 1161,   36,   36,
-     1161, 1161, 1161, 1161, 1161, 1161,   36,   36,   36,   36,
-     1161, 1213, 1161,   36, 1161, 1161,   36,   36, 1161, 1161,
-     1204, 1206, 1206,   36, 1208, 1208, 1211, 1211,   36, 1161,
-     1161,   36,   36, 1161, 1161, 1161,   36,   36,   36, 1161,
-     1213, 1161,   36, 1161, 1161, 1161, 1204, 1206, 1206,   36,
-     1208, 1208, 1211, 1211, 1161, 1161,   36,   36, 1161, 1161,
-       36, 1161, 1213, 1161,   36, 1161, 1161, 1204, 1206, 1208,
-
-     1208, 1211, 1161, 1161,   36,   36, 1161,   36, 1161, 1213,
-     1161,   36, 1161, 1204, 1206, 1208, 1208, 1161, 1211, 1161,
-     1161,   36, 1161, 1161, 1213, 1213, 1161,   36, 1161, 1204,
-     1208, 1161,   36, 1213, 1214, 1161,   36, 1161, 1204, 1208,
-     1161, 1161, 1204, 1208, 1204, 1208, 1204, 1208, 1204, 1208,
-     1204, 1208, 1204, 1161, 1208, 1208, 1208, 1208, 1208, 1161,
-        0, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161
+     1131,    1, 1132, 1132,    1,    2, 1133, 1133,    1,    2,
+        1,    2, 1131, 1131, 1131, 1131, 1134, 1135, 1131, 1131,
+     1136, 1137, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138,   40, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1131,   55, 1139, 1131,   37,
+     1138, 1138, 1138, 1138, 1138, 1131, 1140, 1131, 1140, 1140,
+     1140, 1141, 1131, 1131, 1131, 1131, 1131, 1131, 1134, 1134,
+     1134, 1135, 1131, 1135, 1135, 1136, 1131, 1136, 1136, 1137,
+     1142, 1137, 1131, 1137, 1137, 1131, 1131, 1131, 1143, 1131,
+
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1144,   29, 1131,
+     1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1145,   55,  176, 1146, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131,  176, 1131, 1139, 1131,
+     1139, 1139, 1139, 1131, 1131, 1131, 1138, 1138, 1138, 1138,
+
+     1138, 1138, 1138, 1140, 1131, 1140, 1140, 1140, 1140, 1147,
+     1147, 1131, 1147, 1147, 1147, 1147, 1148, 1148,  218,  218,
+      218, 1131, 1131, 1131, 1134, 1134, 1135, 1135, 1136, 1136,
+     1142, 1142, 1142, 1142, 1131, 1137, 1137, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1144,
+     1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1145,  176,  176, 1131, 1146,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131,  187, 1131, 1131,
+     1139, 1139, 1139, 1131, 1131, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1140, 1140, 1147, 1147, 1131, 1147, 1147, 1147,
+      218,  218,  218,  218,  218, 1131, 1131, 1131, 1134, 1134,
+     1135, 1135, 1136, 1136, 1142, 1137, 1137, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+
+     1131, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1131, 1131, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1131, 1131, 1138, 1131,
+     1131, 1138, 1149, 1138, 1138, 1138, 1138, 1131, 1131, 1138,
+     1138, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1131, 1131, 1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+
+     1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+      176,  176, 1131, 1131, 1131, 1131, 1131, 1131, 1131,  187,
+     1131, 1131, 1139, 1139, 1139, 1131, 1131, 1138, 1138, 1138,
+     1138, 1138, 1138, 1131, 1140, 1140, 1140, 1147, 1147, 1147,
+      218,  218,  218,  218, 1131, 1150, 1131, 1134, 1151, 1135,
+     1152, 1136, 1153, 1137, 1154, 1131, 1131, 1131, 1131, 1131,
+     1138, 1138, 1138, 1155, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131, 1138, 1138,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+
+     1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138, 1131, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1138, 1138, 1138, 1138, 1138,
+     1131, 1131, 1131, 1138, 1138, 1131, 1131, 1138, 1138, 1138,
+      176,  176, 1131, 1131, 1131, 1131, 1131, 1131,  176, 1131,
+     1131, 1139, 1139, 1156, 1131, 1131, 1131, 1138, 1131, 1138,
+     1138, 1131, 1131, 1131, 1140, 1140, 1147, 1157, 1147,  218,
+      218, 1158,  218, 1159, 1131, 1131, 1160, 1134, 1161, 1135,
+     1131, 1162, 1136, 1163, 1137, 1137, 1131, 1131, 1164, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1131, 1131, 1138, 1138, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,  176,
+      176, 1131, 1131, 1131,  176, 1139, 1165, 1139, 1131, 1138,
+     1138, 1138, 1140, 1140, 1166, 1147, 1147, 1167,  218, 1131,
+     1131, 1131, 1134, 1135, 1131, 1136, 1137, 1137, 1131, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1131, 1138, 1138, 1131, 1131, 1138, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1131, 1168, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1131, 1131, 1138, 1131, 1138, 1138, 1131, 1131, 1131, 1139,
+     1139, 1131, 1138, 1131, 1138, 1140, 1140, 1147, 1147,  218,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+     1131, 1138, 1138, 1131, 1138, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+
+     1168, 1168, 1131, 1169, 1168, 1138, 1138, 1138, 1131, 1138,
+     1138, 1138, 1138, 1131, 1138, 1131, 1138, 1138, 1131, 1131,
+     1139, 1131, 1138, 1138, 1140, 1140, 1147, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1131, 1138, 1138, 1131, 1138,
+     1131, 1131, 1131, 1131, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1138, 1131, 1169, 1169, 1168, 1169, 1169, 1138, 1131,
+     1138, 1138, 1131, 1138, 1131, 1138, 1138, 1131, 1131, 1139,
+     1131, 1138, 1140, 1140, 1147, 1138, 1138, 1138, 1138, 1131,
+     1131, 1138, 1138, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1138, 1138, 1138, 1138, 1131, 1168, 1131, 1138, 1131,
+
+     1131, 1138, 1138, 1131, 1139, 1131, 1140, 1140, 1147, 1138,
+     1131, 1131, 1131, 1131, 1138, 1138, 1131, 1131, 1131, 1138,
+     1138, 1138, 1131, 1168, 1131, 1138, 1131, 1131, 1139, 1131,
+     1140, 1140, 1147, 1131, 1131, 1131, 1131, 1138, 1138, 1131,
+     1131, 1138, 1131, 1168, 1131, 1138, 1131, 1139, 1131, 1140,
+     1170, 1147, 1131, 1131, 1131, 1131, 1138, 1138, 1131, 1138,
+     1131, 1168, 1131, 1138, 1131, 1139, 1131, 1140, 1170, 1131,
+     1147, 1131, 1131, 1138, 1131, 1131, 1168, 1168, 1131, 1138,
+     1131, 1139, 1131, 1140, 1147, 1131, 1138, 1168, 1169, 1131,
+     1138, 1131, 1139, 1131, 1140, 1147, 1131, 1131, 1139, 1131,
+
+     1140, 1147, 1139, 1131, 1140, 1147, 1139, 1131, 1140, 1147,
+     1139, 1131, 1140, 1147, 1139, 1131, 1140, 1147, 1139, 1131,
+     1131, 1131, 1140, 1147, 1131, 1140, 1140, 1140, 1140, 1131,
+        0, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131
     } ;
 
-static yyconst flex_int16_t yy_nxt[9249] =
+static yyconst flex_int16_t yy_nxt[4102] =
     {   0,
-       14,   15,   16,   17,   18,   19,   14,   20,   21,   22,
-       23,   24,   25,   26,   25,   27,   25,   28,   29,   30,
-       30,   30,   30,   30,   30,   30,   30,   30,   30,   25,
+       14,   15,   16,   15,   17,   18,   14,   19,   20,   21,
+       22,   23,   24,   25,   24,   26,   24,   27,   28,   29,
+       29,   29,   29,   29,   29,   29,   29,   29,   29,   30,
        31,   32,   33,   34,   35,   36,   37,   38,   39,   40,
        41,   42,   43,   42,   42,   44,   45,   46,   47,   48,
-       42,   49,   50,   51,   42,   42,   52,   42,   42,   42,
-       25,   25,   42,   35,   36,   37,   38,   39,   40,   41,
+       42,   49,   50,   51,   52,   42,   53,   42,   42,   54,
+       24,   24,   42,   35,   36,   37,   38,   39,   40,   41,
        42,   43,   42,   44,   45,   46,   47,   48,   42,   49,
-       50,   51,   42,   42,   52,   42,   42,   42,   14,   53,
-       54,   55,   56,   71,   67,   66,   67,   68,   76,   77,
-
-       78,  203, 1138,   74,   72,  211,  206,   57,   57,   57,
-       57,   57,   57,   57,   57,   57,   57,   75,   79,   77,
-       79,   79,   77,   79,   58,   59,   82,   73,   60,   85,
-       61,   69,   74,   78,   77,   80,   74,   74,   74, 1113,
-       83,   62,   63,  176,   89,   75,  211,   74,   99,  176,
-       75,   75,   75,   58,   59,   82,   73,   60,  224,   61,
-       69,   75,  115,   86,  203,   74,   74,   74,   83,   62,
-       63,   74,   98,   74,   74,   93,   74,   87,   75,   75,
-       75,   90,   94,   95,  109,   75,  224,   75,   75,   75,
-     1074,  115,   86,   74, 1008,   91,  110,  529,  223,  530,
-
-       74,  226,   74,   74,  531,   87,  530,   75,  227,  207,
-       90,   74,   96,   75,   74,   75,   75,   74,   74,   74,
-      115,  346,   74,   91,  387,   75,   97,  223,   75,  211,
-      226,   75,   75,   75,  142,   75,  227,  207,  115,  176,
-       74,   96,  161,   74,  968,  176,   74,   74,   74,  115,
-      346,  203,  112,   75,   97,  100,   75,  100,   74,   75,
-       75,   75,  142,   76,   77,   78,  410,  115,  204,  203,
-      204,  161,   75,  101,  101,  101,  101,  101,  101,  101,
-      101,  101,  101,   85,  115,  115,  370,   74,  102,  143,
-      115,  538,  103,   74,  104,  410,  144,  145,  188,  105,
-
-       75,  106,  107,  201,  146,  205,   89,   75,   79,   77,
-       79,  108,  228,  115,  115,  370,   89,  102,  143,  115,
-      538,  103,   74,  104,  144,  145,   85,  105,  546,  106,
-      107,  201,  146,   85,  205,   75,   78,   77,   78,  108,
-      113,  228,  114,  114,  114,  114,  114,  114,  114,  114,
-      114,  114,  115,  115,  387,  231,  129,  546,  116,  117,
-      130,  138,  118,  188,  139,  242,  131,  140,  119,  243,
-      132,  250,  229,  141,   89,  120,  121,  225,   77,  225,
-      211,  115,  115,  231,  531,  129,  530,  116,  117,  130,
-      138,  118,  139,  242,  131,  140,  119,  243,  132,  250,
-
-      229,  141,  251,  120,  121,  113,  230,  114,  114,  114,
-      114,  114,  114,  114,  114,  114,  114,  347,  124,  359,
-      115,  359,  122,  967,  211,  125,  147,  118,  211,  126,
-      251,  133,  127,  134,  148,  230,  135,  136,  150,  203,
-      149,  123,  128,  137,  188,  347,  151,  124,  573,  115,
-      348,  122,  152,  350,  125,  147,  118,  126,  153,  133,
-      127,  134,  157,  148,  135,  136,  168,  150,  149,  123,
-      128,  137,  115,  169,  188,  151,  158,  573,  348,  159,
-      152,  350,  160,  170,  207,  154,  153,  155,  244,  162,
-      387,  157,  156,  163,  675,  168,  676,  164,  576,  115,
-
-      604,  115,  169,  245,  158,  165,  171,  159,  166,  167,
-      160,  170,  207,  154,  678,  155,  172,  244,  162,  804,
-      156,  389,  163,   78,   77,   80,  164,  576,  115,  604,
-      677,  245,  676,  165,   93,  171,  166,  167,  183,  184,
-      185,   94,   95,  678,  172,  173,   77,  174,  175,  389,
-      188,  392,  677,  176,  676,  189,  186,  186,  186,  186,
-      186,  186,  186,  186,  186,  186,   79,   77,   79,   93,
-       79,   77,   79,   79,   77,   79,   94,   95,  115,  392,
-      177,  178,  208,   74,  179,  208,  180,  190,   89,  198,
-      248,  188,  142,  176,  233,  234,  233,  181,  182,  176,
-
-      249,  191,  235,  236,  224,  208,   89,  115,  208,  177,
-      178,  349,   74,  179,   85,  180,  190,  198,  836,  248,
-      142,  210,  211,  210,  203,  181,  182,  211,  249,  191,
-      192,  194,  224,  212,  208,   93,  176,  208,  387,  349,
-      356,  387,   94,   95,  110,  188,  193,  193,  193,  193,
-      193,  193,  193,  193,  193,  193,  197,  391,  195,  213,
-      129,  372,  373,  372,  130,  125,   74,  237,  356,  126,
-      131,  188,  196,  214,  132,  387,  378,  354,  115,  203,
-       75,  211,  128,  143,  972,  197,  391,  195,  213,  129,
-      144,  199,  168,  130,  125,   74,  237,  126,  131,  169,
-
-      196,  214,  132,  355,  378,  393,  354,  115,   75,  170,
-      128,  369,  143,  375,  376,  375,  200,  188,  144,  199,
-      794,  168,  394,   77,  394,  731,   89,  234,  169,  724,
-      373,  234,  355,  393,  401,  236,  554,  170,  401,  236,
-      369,  559,  560,  559,  200,  209,  210,  211,  210,  209,
-      209,  209,  215,  209,  209,  209,  209,  209,  209,  209,
-      209,  209,  216,  209,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  209,  209,  209,  209,  209,  195,
-      218,  218,  218,  218,  219,  218,  125,  218,  218,  218,
-      220,  218,  218,  196,  218,  218,  218,  218,  221,  218,
-
-      218,  218,  218,  222,  218,  209,  209,  218,  195,  218,
-      218,  218,  218,  219,  218,  125,  218,  218,  220,  218,
-      218,  196,  218,  218,  218,  218,  221,  218,  218,  218,
-      218,  222,  218,  209,   93,  239,  240,  246,  204,  203,
-      204,   94,   95,  395,  554,  396,  211,  802,  241,  803,
-      680,  110,  247,  111,  111,  111,  111,  111,  111,  111,
-      111,  111,  111,  587,  239,  240,  246,  375,  376,  375,
-      586,  395,  339,  396,  340,  205,  241,  258,  377,  680,
-      247,  387,  584,  238,  257,  257,  257,  257,  257,  257,
-      257,  257,  257,  257,  115,   85,  115,  261,  388,  115,
-
-      115,  115,  115,  268,  205,  115,  583,  377,  115,   89,
-     1161,  238,  100,  115,  100,  115,  115,   85,  259,  115,
-      387,  387,  115,  115,  341,  115,  261,  388,  115,  115,
-      115,  115,  268,  211,  115,  397,  419,  115,   89, 1161,
-      211,  115,  421,  115,  115,  102,  259,  115,  115,  103,
-      115,  104,  341,  115,  411,  390,  105,  450,  106,  107,
-      417,  400,  260,  397,  419,  234,  398,  115,  108,  294,
-      421,  294,  401,  236,  102,  373,  188,  115,  103,  295,
-      104,  399,  115,  390,  105,  450,  106,  107,  681,  400,
-      260,  420,  412,  418,  398,  115,  108,  253,  253,  253,
-
-      253,  253,  253,  253,  253,  253,  253,  115,  264,  399,
-      211,  416,  115,  115,  115,  254,  255,  681,  262,  115,
-      412,  418,  263,  415,   89,  265,  115,  115,  256,  414,
-      233,  234,  233,  115,  349,  258,  115,  264,  235,  236,
-      532,  115,  115,  115,  254,  255,  262,  115,  115,  266,
-      413,  263,  115,  265,  115,  115,  256,  344,  115,  387,
-      580,  115,  349,  115,  211,  533,  115,  534,  532,  188,
-      974,  345,  115,  535,  211,  265,  115,  115,  266,  115,
-      203,  115,  536,  115,  115,  188,  344,  115,  115,  580,
-      267,  537,  115,  533,  115,  534,  342,  269,  115,  345,
-
-      115,  535,  115,  265,  804,  115,  803,  542,  115,  115,
-      536,  188,  115,  115,  115,  342,   93,  115,  267,  537,
-       89,  270,  271,   94,   95,  269,  115,  272,  115,  115,
-      115,  273,  274,  387,  115,  115,  542,  115,  115,  292,
-      115,  292,  547,  115,  233,  234,  233,  275,  115,  270,
-      271,  115,  235,  236,  115,  272,  115,  682,  115,  402,
-      273,  274,   89,  115,  115,  387,  115,   85,  569,  115,
-      547,  380,  211,  380,  188,  275,  115,  203, 1161,  115,
-      211,   93,  115,  276,  188,  276,  682,  402,   94,   95,
-      203,  475,  188,  568,  387,  115,  569,  572,   70,  113,
-
-      115,  277,  277,  277,  277,  277,  277,  277,  277,  277,
-      277,  115,  203,  281,  115,  115,  115,   66,  282,  475,
-      115,  568,  280,   85,  115,  572,  544,  543,  555,  115,
-      115,  570,  562,  403,  115,  804,  278,  803,  279,  188,
-      115,  281,  115,  211,  115,  115,  115,  282,  115,  115,
-      280,  115, 1077,  115,  544,  543,  578,  555,  115,  570,
-      562,  403,  115,  284,  278,  115,  279,  115,  283,  115,
-      211,  115, 1100,  115,  115,  115,  115,  115,  115,  285,
-      115,  563,  115,  289,  288,  578,  286,  575,  115, 1161,
-      287,  284,  115,  115,  585,  115,  283,   85,  115, 1139,
-
-      115,  211,  115,  115,  115,  115,  640,  115,  285,  115,
-      563,  289,  288,  561,  286,  575,  115,  292,  287,  292,
-      115,  290,  585,  115,  115,   89,  294,  115,  294,  115,
-      203,  683,  115,  115,  640, 1161,  295,  291,  115,  387,
-      679,  561,  296,  115,  577,  564,  115, 1161,  188,  290,
-      115,  115,  466,  115,  466,  115,  115,  115,  115,  261,
-      683,  115,  115,  301,  115,  291, 1161,  571,  679,  293,
-      296,  115,  577,  564,  115,  579,  115, 1161,  115,  115,
-      115, 1161,  297,  467,  115,  115,  115,  697,  261,  697,
-     1140,  115,  301,  115,  298,  571,  299,  293,  688,  300,
-
-      115, 1161,  115,  579,  115,  115,  115,  115,  203,  115,
-      484,  297,  484,  691,  115,  303,  574,   77,  574,  115,
-      485,  115,  298,  302,  299,  115,  688,  300,  304,  115,
-      115,  115,  717,  115,  115,  203,  115,  115,  115, 1161,
-     1161,  691,  115,  303,  115,  305,  692,  115, 1161,  115,
-      306,  302,  115,  704,  115, 1161,  115,  304, 1161,  115,
-      188,  717,  115,  115,  115, 1161,  115,  115,  115,  115,
-     1161,  115,  115,  305,  692,  308,  307,  488,  306,  488,
-      115,  704,  115,  115,  115, 1161,  115,  489, 1161,  115,
-      310,  115,  115,  115,  115, 1150,  689,  115,  115,  521,
-
-      309,  521, 1161,  308,  307,  311,  752, 1161,  115,  522,
-      115,  115,  115,  239,  240,  115,  115,  115,  115,  310,
-      115,  115,   93,  115,  315,  689,  241, 1161,  309,   94,
-       95,  312,  115,  311,  752,  115,  115,  115,  559,  560,
-      559,  115,  239,  240, 1161,  115,  115,  753, 1161,  313,
-      115,  115,  314,  315,  241,  115,  318,  115, 1161,  312,
-      115,  115,  115,  115,  755,  316,  115,  556,  203,  556,
-      756,  317,  581,  211,  115,  753,  115,  313, 1161,  115,
-      314,  359,  115,  359,  115,  318,  115,  115,  319,  115,
-      320,  115,  755,  115,  316,  556,  203,  556,  756,  317,
-
-      581,  115,  115,  324,  115, 1161,  321,  322,  557,  188,
-      323,  115,  720,  115,  360,  211,  115,  319,  115,  320,
-      115,  203,  115,  705,  325,  115,  326,  211,  361,  115,
-     1161,  324,  115,  327,  321,  322,  557,  557,  323,  115,
-      115,  720,  115,  360,  387,  115,  815,  115,  815,  115,
-      759,  705,  325,  211,  115,  326,  361,  328,  687,  115,
-      115,  327,  708,  329,   93,  557,  808,  115,  115,  115,
-      703,   94,   95,   85,  115,  387,  707,  330,  759,  713,
-      265, 1161,  115,  115,  331,  328,  687,  115,  115,  706,
-      708,  697,  329,  697,  808,  332,  714,  115,  703,  851,
-
-      582, 1161,  115,  387,  707,  330,  722,  713,  265,  115,
-      115,   89,  115,  331,  115,  115, 1161,  115,  706,  335,
-      115, 1161,  333,  332,  715,  714,  334,  851,  115,  582,
-      115,  387,  115, 1161,  115,  722,  859,  115,  115, 1161,
-      336,  115, 1161,  115,  115,  337,  115,  725,  335,  115,
-      333,  115,  716,  715,  334, 1161,  115,  719,   77,  719,
-      115,  115,  115,  115,  859,   93,  115,  744,  115,  336,
-      115,  338,   94,   95,  337,  115,  725,   93,  754,  115,
-      760,  716,  115,  188,  729,  730, 1161, 1161,  115,  693,
-     1161,  693,  115,  342,  184,  351,  744,  115,  861,  694,
-
-      338,  727,  806,  635,  815,  635,  815,  754,  862,  760,
-      115,  352,  352,  352,  352,  352,  352,  352,  352,  352,
-      352,  353,  807,  810, 1161,  805,  861,  176,  387, 1161,
-      727,  806,  813,  608,  636,  608,  862,  352,  352,  352,
-      352,  352,  352,  352,  352,  352,  352,  353,  700,  827,
-      700,  807,  810,  176,  805,  804,  184,  809,  701, 1161,
-      203,  813,  702,  352,  352,  352,  352,  352,  352,  352,
-      352,  352,  352,  353,  748,  380,  211,  380,  827,  176,
-      826,  211,  826,  856,  826,  211,  826,  110,  749,  357,
-      357,  357,  357,  357,  357,  357,  357,  357,  357,  115,
-
-      820,  115,  115,  748,  115,  857,  115,  115,  381, 1161,
-      267,  757,  856,  270,  363,  188,  749,  362,  115,  272,
-      115,  364,  382,  832,   77,  832,  203,  758,  115,  820,
-      115,  115,  211,  115,  857,  115,  115,  381,  267,  115,
-      757,  270,  363, 1161,  115,  362,  115,  272,  115,  364,
-      382,  811,  702,  365,  702,  758,  115, 1161,  115,  115,
-      115,  115,  297,  368,  115,  115,  702,  860,  115,  863,
-     1161,  367,  824,  115,  298,  115,  299,  821,  115,  366,
-      811,  365,  864,  901, 1161,  115,  115, 1161,  115,  115,
-      115,  297,  368,  115,  115,  211,  860, 1161,  863,  367,
-
-     1161,  824,  298,  115,  299,  821,  115,  366, 1161, 1161,
-      864,  901,  383,  383,  383,  383,  383,  383,  383,  383,
-      383,  383,  374,  374,  211,  374,  374,  374,  374,  374,
-      374,  374,  374,  374,  374,  374,  374,  374,  374,  384,
-      374,  385,  385,  385,  385,  385,  385,  385,  385,  385,
-      385,  374,  374,  374,  374,  374,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  374,  374,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      374,  404, 1161,  404,  932,  865,  405,  405,  405,  405,
-      405,  405,  405,  405,  405,  405,  406, 1161,  406,  935,
-      899,  407,  407,  407,  407,  407,  407,  407,  407,  407,
-      407,  408,  932,  408,  865,  900,  409,  409,  409,  409,
-      409,  409,  409,  409,  409,  409,  423,  935,  423,  899,
-     1161,  424,  424,  424,  424,  424,  424,  424,  424,  424,
-      424,  425, 1161,  425,  900, 1161,  426,  426,  426,  426,
-      426,  426,  426,  426,  426,  426,  427,  902,  427,  432,
-      937,  428,  428,  428,  428,  428,  428,  428,  428,  428,
-
-      428,  257,  257,  257,  257,  257,  257,  257,  257,  257,
-      257, 1161,  115,  769,  115,  769,  902,  115,  937,  115,
-      429,  430,  430,  430,  430,  430,  430,  430,  430,  430,
-      430,  115,  433,  115,  115,  905,  908,  115,  908,  115,
-      431,  115,  115,  115,  770,  434,  115,   93,  115,  429,
-      908,  435,  908,  115,  839,  840,  115,  115,  211,  115,
-      433,  115,  115,  115,  905,  693,  115,  693,  115,  431,
-      436,  115, 1161,  434, 1161,  694,  115,  115,  115,  435,
-      115,  115,  115,  115,  115,  115,  115,  804,  439,  803,
-      437,  115, 1161, 1161,  822,  176,  115,  115,  436,  115,
-
-      438,  805,  924,  115,  115,  188,  115,  115,  115,  115,
-      115,  115,  115, 1161,  115,  115,  439, 1161,  437, 1161,
-      441,  440,  115,  822,  115,  115, 1161,  115,  438,  115,
-      805,  924,  115,  115, 1161,  115,  203,  115,  115,  115,
-      115,  115,  903, 1161,  115,  700,  115,  700,  441,  440,
-      115,  442,  115,  443,  445,  701,  444,  115,  115,  702,
-      115, 1161,  115,  115,  115,  446,   93,  115, 1161,  115,
-      115,  903,  911,   94,   95,  115, 1161,  115,  115,  442,
-      115,  443,  445,  115,  444,  115, 1161,  115,  115,  447,
-      115,   93,  115,  893,  446,  893,  448,  115,   94,   95,
-
-     1161,  911, 1161,  894,  115,  115, 1161,  115,  115,  451,
-      929,  115,  115,  115,  115,  449,  115,  447,  965,  115,
-      931,  804,  184,  809,  448,  115,  203,  115,  115,  176,
-      115,  453,  115,  115,  211,  452,  115,  115,  451,  929,
-      115,  466,  115,  466,  449,  115,  965,  115,  115,  931,
-      115,  933,  454,  115, 1161,  115,  934,  115,  115,  936,
-      453,  980,  115,  910,  452,  115, 1161,  115,  115, 1161,
-     1161,  913,  467,  115,  115,  115,  465,  115,  115,  115,
-      933,  454,  115,   93,  875,  934,  875,  115,  936,  980,
-       94,   95,  910,  115,  876,  115,  455,  115,  455,  115,
-
-      913,  959,  115,  115,  115,  465,  115,  964,  115,  239,
-      240,  115,   93,  966,  893,  115,  893,  468,  469,   94,
-       95,  115,  241, 1161,  894,  115, 1161,  456,  115,  115,
-      959,  203,  457,  115,  458,  115,  964,  459,  239,  240,
-      115,  460,  966, 1161,  461,  468,  469,  462,  463,  472,
-      241,  464,  115,  115,  115,  115,  470,  115,  115,  471,
-      115,  457,  989,  458,  991,  884,  459,  884,  115,  460,
-     1161,  115,  461, 1161,  115,  462,  463,  981,  472,  464,
-      973,  115,  115,  115,  115,  470,  115,  115,  471,  115,
-      115,  989,  474,  991,  473,  115,  115,  984,  115,  115,
-
-      986,  115,  115,  115,  896,  981,  896,  987,  973,  115,
-     1161,  115,  476,  954, 1161,  115,  115,  115,  988,  115,
-      115,  474,  473,  990,  115,  984,  477,  115,  986,  115,
-     1010,  115,  115, 1161,  115,  987,  115,  115,  115,  961,
-      476,  954,  478,  115,  115,  115,  988, 1161, 1005,  115,
-      115,  990, 1161, 1013,  477, 1161, 1161,  115,  479, 1010,
-      115,  115,  115, 1161, 1161,  115,  115,  115,  961, 1014,
-      478, 1027,  115,  998,  948,  998, 1005, 1015,  115,  203,
-      115,  480, 1013,  115,  115,  115,  479,  481,  115,  115,
-      115,  484,  483,  484,  488,  115,  488, 1014,  188, 1027,
-
-      482,  485,  115,  115,  489, 1017, 1015, 1018,  115,  480,
-     1161, 1161,  115,  115, 1035, 1021,  481,  115,  115, 1036,
-      115,  483,  203, 1028,  115,  115, 1031,  115,  482,  115,
-      115,  115,  115, 1016, 1017,  486, 1018, 1161,  490,  115,
-      492, 1032, 1035,  115, 1021,  487,  115, 1036,  491,  115,
-     1043, 1161, 1028,  115,  115, 1031,  115, 1161,  115, 1022,
-      115,  115, 1016,  486,  493,  115,  490,  115,  492, 1033,
-     1032,  115,  115,  487,  115, 1034,  491,  115, 1043,  115,
-      115,  115, 1045,  188,  495,  115,  115, 1161, 1022,  115,
-     1046,  494,  496,  493,  115, 1161, 1161,  115, 1033,  115,
-
-      115,  115,  115, 1050, 1034, 1161,  115,  115, 1161,  115,
-      115, 1045, 1049,  495,  115,  115,  115,  115, 1046,  494,
-      496,  497,  115, 1041,  948, 1041,  115,  115,  115, 1051,
-      498,  115, 1050,  115,  115, 1161,  115,  500,  115,  115,
-     1049,  499,  115,  852,  115,  852,  115, 1052, 1161,  497,
-     1161,  115,  115,  115,  115, 1161,  115, 1051,  498,  115,
-     1053, 1161,  115,  115,  115, 1061,  500,  115,  115, 1060,
-      499,  115,  501,  115,  115, 1161, 1052,  115,  925,  115,
-      115,  115,  115,  115,  115,  203, 1064,  502,  115, 1053,
-      503,  926, 1065,  115, 1061, 1161,  115, 1060,  504, 1066,
-
-      501,  115,  203,  115,  115,  211,  115,  925,  115,  115,
-      505,  115, 1161, 1161, 1064,  502, 1072, 1056,  503,  926,
-     1065,  115, 1076,  115,  115,  115,  504, 1066, 1161,  115,
-      115, 1161,  507,  115,  115, 1161,  506,  115,  115,  505,
-      508, 1057,  115, 1161,  115, 1072, 1056, 1055,  115, 1075,
-     1076,  115, 1161,  211,  115, 1079,  115,  509,  115,  115,
-      115,  507,  115,  115,  506,  115,  115,  115,  508,  115,
-     1057,  115,  115, 1078,  115, 1055,  115,  512, 1075,  115,
-      510,  115,  511, 1079,  115,  509, 1161, 1161,  115,  115,
-     1161,  115,  115, 1058,  115,  115,  115,  115,  115,  513,
-
-      115, 1161, 1078,  115, 1085,  515,  512,  115,  510,  115,
-      511,  115,  115, 1161,  115,  115,  115,  115,  115,  514,
-      115,  115, 1058,  115,  115,  516,  115, 1086,  513,  115,
-      211,  517, 1085,  515,  115, 1161,  203,  115,  115,  115,
-     1161,  115,  115,  115,  115,  115,  115,  115,  514,  115,
-      115,  211,  115,  521,  516,  521, 1086,  518, 1161,  517,
-      519,  115,  115,  522,  115,  115,  115,  115, 1070,  948,
-     1070, 1081,  115, 1161,  115, 1084, 1089, 1161,  520,  115,
-      115, 1090,  115,  203, 1083,  518,  115,  115,  519,  523,
-      115,  115,  115,  115, 1094,  115, 1161, 1096,  115,  524,
-
-     1081,  115,  115, 1084, 1089,  115,  520,  115,  115, 1097,
-     1090,  115,  115, 1083,  526,  115,  115, 1082,  523,  115,
-      115,  115,  115, 1094,  115, 1096, 1099,  115,  524,  115,
-     1161,  115,  525,  115, 1161, 1161,  115, 1097,  115,  115,
-      115, 1103,  526, 1161,  115,  115, 1082, 1111,  115,  115,
-      115, 1161,  211,  115, 1099, 1104,  527, 1107,  115,  211,
-      525,  947,  948,  947,  528, 1161,  115, 1161,  115,  949,
-     1103,  203,  950,  115,  115,  531, 1111,  539, 1161,  115,
-      947,  948,  947, 1104,  527, 1107,  115, 1023,  949, 1024,
-     1161,  950,  528,  540,  540,  540,  540,  540,  540,  540,
-
-      540,  540,  540,  541,  947,  948,  947, 1101, 1161,  176,
-     1161, 1102,  949, 1161,  188,  950, 1023, 1161, 1024,  540,
-      540,  540,  540,  540,  540,  540,  540,  540,  540,  541,
-     1000, 1001, 1000, 1161, 1161,  176, 1101,  188, 1002, 1102,
-     1161, 1003, 1092,  948, 1092,  540,  540,  540,  540,  540,
-      540,  540,  540,  540,  540,  541, 1109,  948, 1109, 1098,
-     1115,  176,  115,  115, 1161,  550,  548,  115,  115,  110,
-      115,  545,  545,  545,  545,  545,  545,  545,  545,  545,
-      545,  115,  549, 1114,  115,  115,  551, 1098, 1115, 1120,
-      115,  115,  115,  554,  550,  548,  115,  115, 1121,  115,
-
-     1161,  115, 1161, 1161,  115,  552,  115, 1161, 1161,  115,
-      549, 1114,  115, 1127,  115,  551, 1123, 1120,  482,  115,
-      115,  115, 1161,  115,  115,  553,  115, 1121,  115,  115,
-      115,  203,  115, 1161,  552,  115,  947,  948,  947, 1129,
-      115, 1127,  115,  115,  949, 1123,  482,  950,  115, 1161,
-      115,  203,  115,  115,  553,  115,  211,  115,  115, 1161,
-     1161, 1000, 1001, 1000, 1161, 1161, 1116, 1129,  115, 1002,
-      115,  115, 1003,  383,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  211, 1161, 1000, 1001, 1000, 1117, 1118,
-     1117, 1161,  565, 1002, 1132, 1116, 1003, 1131, 1136, 1161,
-
-      566,  566,  566,  566,  566,  566,  566,  566,  566,  566,
-      211, 1161, 1042, 1001, 1042, 1117, 1118, 1117, 1142,  567,
-      949,  565, 1132,  950, 1161, 1131, 1136,  383,  383,  383,
-      383,  383,  383,  383,  383,  383,  383,  405,  405,  405,
-      405,  405,  405,  405,  405,  405,  405, 1142,  567,  405,
-      405,  405,  405,  405,  405,  405,  405,  405,  405,  407,
-      407,  407,  407,  407,  407,  407,  407,  407,  407,  407,
-      407,  407,  407,  407,  407,  407,  407,  407,  407,  409,
-      409,  409,  409,  409,  409,  409,  409,  409,  409,  409,
-      409,  409,  409,  409,  409,  409,  409,  409,  409,  424,
-
-      424,  424,  424,  424,  424,  424,  424,  424,  424,  424,
-      424,  424,  424,  424,  424,  424,  424,  424,  424,  426,
-      426,  426,  426,  426,  426,  426,  426,  426,  426,  426,
-      426,  426,  426,  426,  426,  426,  426,  426,  426,  428,
-      428,  428,  428,  428,  428,  428,  428,  428,  428,  428,
-      428,  428,  428,  428,  428,  428,  428,  428,  428,  588,
-      211,  588, 1161, 1161,  589,  589,  589,  589,  589,  589,
-      589,  589,  589,  589,  430,  430,  430,  430,  430,  430,
-      430,  430,  430,  430, 1161,  115, 1161,  115, 1161,  590,
-      115,  590,  115,  429,  591,  591,  591,  591,  591,  591,
-
-      591,  591,  591,  591,  115,  592,  115,  115,  115,  593,
-      203, 1119,  115,  115,  115, 1161,  115, 1141,  188,  115,
-     1161,  115,  429, 1161,  115, 1161,  115,  115,  594,  115,
-      115, 1161,  115,  592,  115,  115,  115,  115,  593, 1119,
-     1161,  115,  115,  115, 1161, 1141,  115,  203,  595,  115,
-     1149,  115, 1161,  115,  115,  115, 1146,  594,  115,  115,
-     1161, 1161,  596, 1161,  115,  115,  188,  115,  115,  115,
-     1161,  115,  597,  115,  115,  115,  595,  115,  188, 1149,
-      115,  115, 1161,  598, 1146,  115,  203,  115,  115,  115,
-      115,  596, 1144,  115,  115,  188,  115,  115,  115,  203,
-
-      599,  597,  115,  115,  115,  115, 1161,  188,  115,  115,
-      115,  598, 1161,  600,  115,  115,  115, 1130,  115,  115,
-     1144,  115,  115,  115,  115,  601,  115,  115,  599, 1143,
-      115, 1157,  115,  602,  115,  115,  115, 1148, 1161,  115,
-      115,  115,  600,  603, 1145, 1130, 1124,  948, 1124,  115,
-      115,  115,  115, 1161,  601,  115,  115, 1143, 1151,  115,
-     1157,  602,  115, 1161,  115, 1148,  188,  115,  115,  115,
-      115,  603, 1145,  605,  115,  115,  203,  115,  606,  115,
-     1161,  115, 1161, 1161,  203,  608, 1151,  608, 1161,  115,
-     1161,  115,  607,  115, 1161, 1161,  115, 1161, 1161,  115,
-
-     1161,  605, 1147,  115,  115, 1161, 1161,  606,  115,  115,
-      115, 1153, 1154, 1153,  115,  115, 1161,  115,  115,  115,
-      607,  115, 1161,  115, 1161, 1155,  609, 1161,  619,  115,
-      620, 1147, 1161,  115, 1161, 1152, 1161,  115, 1161,  115,
-      610,  115, 1161,  115,  115,  115,  621,  115,  115, 1161,
-      115, 1161,  115, 1155,  203,  609,  619,  115,  620,  622,
-      115,  115,  115, 1152,  115,  115, 1161,  115,  610,  455,
-      115,  455, 1161, 1161,  115,  621, 1153, 1154, 1153,  115,
-     1161,  629, 1161, 1161,  115, 1161, 1161,  622,  115,  115,
-     1156,  115,  115, 1159, 1160, 1159,  115, 1159, 1160, 1159,
-
-      456,  623, 1161,  115, 1161,  611,  115,  612, 1161,  629,
-      613,  115,  203,  115,  614, 1161, 1161,  615,  115, 1156,
-      616,  617, 1161, 1161,  618,  115, 1161, 1161, 1161,  623,
-      626,  115, 1161, 1161,  611,  115,  612, 1161,  115,  613,
-      115, 1161,  614,  115, 1161,  615,  115, 1161,  616,  617,
-      624,  115,  618,  115,  115,  115, 1161,  637,  626,  115,
-      115,  627, 1161, 1158, 1161,  115,  625,  115, 1161, 1161,
-     1161, 1161,  115,  115,  115,  115,  628, 1161, 1161,  624,
-      115, 1161, 1161,  115,  115,  637, 1161, 1161,  115,  115,
-      627, 1158, 1161,  115,  625, 1161, 1161, 1161, 1161, 1161,
-
-     1161,  115,  115, 1161,  628,  630,  630,  630,  630,  630,
-      630,  630,  630,  630,  630,  630, 1161,  630,  630,  630,
-      630,  630,  631,  630,  632,  632,  632,  632,  632,  632,
-      632,  632,  632,  632,  630,  630,  630,  630,  630,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  633,  633,  630,  630,  633,  633,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  630,  115, 1161,  635,  638,  635,  115,
-
-     1161, 1161,  115,  115, 1000, 1001, 1000, 1161,  115, 1161,
-     1161,  634, 1002,  115, 1161, 1003,  115, 1161, 1161, 1161,
-     1161, 1161,  639,  115, 1161, 1161,  638,  636,  115,  115,
-      115,  115,  115, 1161,  115,  115, 1161,  115,  115,  634,
-     1161,  115, 1161,  115,  115, 1161,  641, 1161,  115,  115,
-      639, 1161, 1161, 1161, 1161, 1161, 1161,  115,  115,  115,
-      115, 1161, 1161,  115,  115,  115, 1161,  115,  115, 1161,
-     1161, 1161,  115,  115, 1161,  641,  115,  115, 1161,  115,
-      642, 1161, 1161, 1161, 1161,  115, 1161,  643, 1161,  115,
-      115, 1161, 1161, 1161,  115,  115, 1161,  115,  644,  115,
-
-     1161, 1161,  115, 1161,  115,  645, 1161,  115,  642,  115,
-     1161, 1161,  646, 1161, 1161,  643, 1161, 1161,  115,  115,
-     1161, 1000, 1001, 1000,  115, 1161, 1161,  644,  115, 1002,
-      115,  650, 1003,  115,  645,  115,  115,  115,  647,  115,
-      646,  648,  115, 1161,  115, 1161,  115,  115, 1161,  115,
-      115, 1161, 1161, 1161, 1161, 1161,  649, 1161,  115,  115,
-      650,  115, 1161, 1161,  115,  115, 1161,  647,  115,  115,
-      648,  115, 1161,  115,  115,  652,  115,  115,  115, 1161,
-      115, 1161, 1161,  651,  649, 1161,  115, 1161,  115,  115,
-     1161,  115, 1161, 1161,  115,  115,  115, 1161,  115, 1161,
-
-      115, 1161,  653,  115,  652, 1161,  654,  115, 1161,  115,
-      115,  651,  115, 1161,  115, 1161,  115, 1161,  115, 1161,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1161,  115,
-      653, 1161,  115, 1161,  654,  655,  115,  115,  115,  115,
-     1161,  115,  115,  115,  115, 1161,  115,  115,  115, 1161,
-      115, 1161,  115, 1161,  115,  115,  115, 1161,  115, 1161,
-     1161,  115,  115, 1161,  655,  115,  115, 1161,  115,  659,
-      115,  115,  115,  115,  115,  115, 1161,  115, 1161,  115,
-      656, 1161,  657, 1161,  115,  115,  115,  115, 1161,  115,
-      115,  658,  115,  115, 1161,  115,  661,  659,  115,  115,
-
-      115,  115, 1161, 1161,  115, 1161,  115, 1161,  656, 1161,
-      657, 1161,  660,  115, 1161,  115,  115,  115,  115,  115,
-      658,  115,  115,  115,  115,  661, 1161,  115, 1161,  664,
-      115, 1071,  948, 1071,  115,  662, 1161,  115,  115,  949,
-      660,  115,  950,  115, 1161, 1161,  115,  115,  115,  663,
-      115, 1161,  115,  115, 1161,  115, 1161,  115, 1161, 1161,
-      115, 1161,  115,  662, 1161,  115,  115, 1161, 1161,  115,
-      115, 1161, 1161, 1161,  665,  115,  115, 1161,  663,  115,
-     1161, 1161,  115, 1161,  115, 1161,  115,  115,  115,  115,
-      115,  115, 1161,  666,  115,  115, 1161,  115, 1161, 1161,
-
-     1161,  115,  665,  668,  115, 1161,  667, 1161,  115,  115,
-     1161,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,
-      115,  666,  115,  115,  115,  115, 1161,  115,  115,  115,
-      669,  668, 1161,  115,  667, 1161,  115,  115,  670,  115,
-     1161,  115, 1161, 1161, 1161,  115, 1161,  115, 1161,  115,
-      115,  115, 1161,  115,  115, 1161,  115,  115,  115,  669,
-     1161,  115,  115, 1161,  115,  115,  115,  115, 1161,  115,
-      115, 1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115,
-      115, 1161,  115, 1161,  115, 1161,  115,  115,  115, 1161,
-      115,  115,  115,  115,  115,  115, 1161, 1161, 1161,  115,
-
-      115, 1161,  671, 1161, 1161,  115, 1161,  115,  115,  115,
-     1161, 1161,  115,  672,  115,  115, 1161,  115,  115, 1161,
-      115,  115,  115,  115, 1161, 1161,  115, 1161,  115, 1161,
-      671, 1161, 1161,  115, 1161,  115, 1161,  115,  115, 1161,
-      115,  115,  672,  115,  115,  673,  115,  115,  674,  115,
-      115, 1161,  115, 1161, 1161,  115,  115, 1161, 1161, 1161,
-      115,  698, 1161,  115, 1161,  115,  115, 1161,  115, 1161,
-      115, 1161, 1161,  115,  673,  115, 1161,  674,  115,  677,
-      115,  684, 1161, 1161, 1161, 1093,  948, 1093,  115, 1161,
-      698,  115, 1161,  949, 1161,  115,  950,  685,  685,  685,
-
-      685,  685,  685,  685,  685,  685,  685,  686,  115, 1110,
-      948, 1110, 1161,  176, 1161, 1161, 1161,  949, 1161, 1161,
-      950, 1161, 1161,  685,  685,  685,  685,  685,  685,  685,
-      685,  685,  685,  686,  693, 1161,  693, 1161, 1161,  176,
-     1161, 1161, 1161, 1161,  694, 1161, 1161, 1161, 1161,  685,
-      685,  685,  685,  685,  685,  685,  685,  685,  685,  686,
-      697, 1161,  697, 1161, 1161,  176,  696,  115, 1161, 1161,
-      695,  115,  115,  110,  600,  690,  690,  690,  690,  690,
-      690,  690,  690,  690,  690,  115,  115, 1161, 1161, 1161,
-     1161, 1161, 1161,  115, 1161,  696,  115, 1161,  115,  695,
-
-      115,  115,  115,  600, 1161,  115, 1161,  115,  645,  732,
-      115, 1161,  115,  115,  115,  646, 1161, 1161,  700,  699,
-      700,  115,  115, 1161,  115, 1161, 1161,  115,  701, 1161,
-     1161,  115,  702, 1161,  115, 1161,  115,  645,  732,  115,
-      115,  211, 1161,  646, 1161, 1161, 1161,  699, 1161,  115,
-     1161,  115,  115,  709, 1161,  709,  115, 1161,  710,  710,
-      710,  710,  710,  710,  710,  710,  710,  710, 1161,  211,
-      115, 1126,  948, 1126, 1161, 1161, 1161, 1161, 1161,  949,
-      115, 1161,  950, 1161, 1161,  115,  566,  566,  566,  566,
-      566,  566,  566,  566,  566,  566,  211, 1161,  115, 1161,
-
-     1161,  947,  948,  947, 1161,  565, 1161, 1161,  711,  949,
-      711, 1161,  950,  712,  712,  712,  712,  712,  712,  712,
-      712,  712,  712,  589,  589,  589,  589,  589,  589,  589,
-      589,  589,  589, 1161,  565,  589,  589,  589,  589,  589,
-      589,  589,  589,  589,  589,  591,  591,  591,  591,  591,
-      591,  591,  591,  591,  591,  591,  591,  591,  591,  591,
-      591,  591,  591,  591,  591,  733, 1161, 1161,  115, 1161,
-      115, 1161, 1161,  115,  947,  948,  947, 1161, 1000, 1001,
-     1000, 1161,  949,  737,  115,  950, 1002,  115, 1161, 1003,
-     1161, 1161, 1161, 1161,  733, 1161, 1161,  115, 1161,  115,
-
-     1161, 1161,  115, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161,  737,  115,  718,  718,  115,  718,  718,  718,  718,
-      718,  718,  718,  718,  718,  718,  718,  718,  718,  718,
-      734,  718,  735,  735,  735,  735,  735,  735,  735,  735,
-      735,  735,  718,  718,  718,  718,  718,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-      736,  736,  736,  718,  718,  736,  736,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-
-      736,  718,  115,  115,  738,  115,  115,  115,  115,  115,
-      115,  115, 1161,  740,  115, 1161, 1161, 1161,  739,  741,
-     1161,  115,  115, 1161,  115,  115, 1161, 1161,  115, 1161,
-     1161,  115,  115,  738,  115,  115,  115,  115,  115,  115,
-      115, 1161,  740,  115, 1161, 1161,  739,  741, 1161,  115,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1161,  115,
-      115,  115,  115, 1161, 1161,  745,  115, 1161, 1161,  742,
-     1161, 1161, 1161,  115,  115,  743,  115, 1161, 1161, 1161,
-      115, 1161, 1161,  115,  115, 1161,  115,  115,  115,  115,
-      115,  115,  115, 1161,  745,  115, 1161,  742,  746, 1161,
-
-     1161,  115,  115,  743,  115, 1161,  115, 1161,  115,  115,
-      115, 1161, 1161,  115,  750,  115,  115,  747,  115, 1161,
-      751,  115, 1161, 1161, 1161, 1161,  746, 1161,  115,  115,
-     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
-      115,  115,  115,  750,  115, 1161,  747,  115, 1161,  751,
-     1161, 1161, 1161, 1161,  115,  115,  115,  115,  115, 1161,
-      115, 1161, 1161,  115,  115,  115, 1161, 1161, 1161,  115,
-      115,  761, 1161, 1161,  115,  115, 1161,  115,  762,  115,
-      115, 1161,  115,  115, 1161, 1161, 1161,  115,  763, 1161,
-     1161,  115,  115,  115,  115, 1161,  115, 1161, 1161,  761,
-
-     1161, 1161,  764,  115,  115,  115, 1161,  762,  115,  115,
-      115, 1161,  115,  765,  115, 1161,  763,  115,  768,  115,
-      115,  115,  115,  115, 1161,  115, 1161, 1161, 1161,  766,
-      764,  115, 1161,  115, 1161,  115, 1161,  115,  115,  767,
-      115,  115,  765,  115, 1161, 1161,  115,  768,  115, 1161,
-     1161, 1161,  115,  769,  115,  769, 1161,  766, 1161,  115,
-     1161,  115, 1161,  258,  115,  115, 1161, 1161,  767,  115,
-      257,  257,  257,  257,  257,  257,  257,  257,  257,  257,
-      115, 1161,  115,  115,  770,  115,  115,  115,  115,  115,
-     1161,  115,  115, 1161,  115, 1161, 1161, 1161, 1161,  115,
-
-      771, 1161,  115, 1161, 1161,  115,  115, 1161,  115,  115,
-     1161, 1161,  115, 1161,  115,  115,  115,  115,  115,  115,
-      115,  115, 1161,  115,  115, 1161, 1161,  115,  771, 1161,
-      115, 1161, 1161,  115,  115,  115,  115, 1161,  772,  115,
-      115,  774,  115,  773,  115,  775,  115,  115,  115, 1161,
-     1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115, 1161,
-     1161,  115,  115, 1161,  115,  115,  772,  115,  115,  115,
-      774,  115,  773,  115,  775,  115,  115, 1161, 1161,  776,
-      115,  115,  115,  115, 1161,  115,  115,  777,  115,  115,
-      115,  115,  115,  115,  780, 1161,  115,  115, 1161,  115,
-
-     1161, 1161,  115, 1161,  778,  779, 1161,  776, 1161,  115,
-     1161,  115,  115,  115,  115, 1161,  777,  115, 1161,  115,
-     1161,  115, 1161,  780, 1161, 1161,  115, 1161,  115,  115,
-      115,  781,  778,  779,  115,  115, 1161, 1161, 1161,  115,
-      115,  115, 1161, 1161, 1161, 1161,  782, 1161,  115, 1161,
-     1161, 1161, 1161, 1161,  115, 1161, 1161, 1161,  115, 1161,
-      781,  115, 1161,  115,  115,  115,  115,  783, 1161,  115,
-      115, 1161,  784,  115,  782, 1161,  115,  785,  115, 1161,
-      115, 1161,  115, 1161,  115, 1161, 1161, 1161, 1161, 1161,
-      115, 1161,  115, 1161,  115,  115,  783, 1161,  115,  115,
-
-      784, 1161,  115,  787, 1161,  115,  785,  115,  115,  115,
-      115, 1161,  115,  786,  115, 1161, 1161,  115, 1161, 1161,
-      115, 1161,  788, 1161,  115,  115, 1161,  115,  115,  789,
-      115, 1161,  787, 1161,  115, 1161,  115, 1161,  115,  115,
-     1161,  115,  786,  115,  115,  115, 1161, 1161,  115, 1161,
-      788, 1161,  115,  115,  115,  115,  115,  115,  789,  115,
-     1161,  790,  115, 1161, 1161,  115, 1161,  115,  115,  792,
-      115, 1161,  115,  115,  115, 1161,  115,  115, 1161, 1161,
-     1161, 1161,  115,  115, 1161, 1161,  115,  791,  115, 1161,
-      790,  115, 1161, 1161,  115,  115,  793,  115,  792,  115,
-
-      115,  115,  115,  115,  115,  115,  115, 1161, 1161, 1161,
-     1161, 1161, 1161,  115, 1161,  791,  115, 1161,  795,  115,
-      796, 1161, 1161,  115, 1161,  793,  115, 1161,  115,  115,
-      115,  115, 1161, 1161,  115,  115, 1161,  115, 1161,  797,
-      798,  115,  115, 1161, 1161,  115,  795,  115,  796,  115,
-     1161, 1161, 1161,  115,  115,  115,  115,  115,  115, 1161,
-      115, 1161,  115, 1161, 1161, 1161,  115,  797,  799,  798,
-     1161,  115,  801,  115,  115, 1161,  115,  800,  115,  115,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1161, 1161,
-     1161,  115, 1161,  115, 1161, 1161,  799, 1161, 1161,  115,
-
-      801, 1161, 1161,  115,  115,  800, 1161, 1161,  115,  115,
-     1161, 1161,  176, 1161,  115, 1161, 1161, 1161,  176,  115,
-     1161,  115, 1161,  816,  115, 1161,  110,  115,  111,  111,
-      111,  111,  111,  111,  111,  111,  111,  111,  115,  115,
-      115,  115, 1161, 1161,  115,  115,  819,  817,  115, 1161,
-     1161,  818,  816,  115, 1161, 1161, 1161, 1161,  115,  115,
-      115, 1161, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,
-      115, 1161,  211,  115,  115,  819,  817, 1161, 1161,  818,
-     1161, 1161,  211, 1161, 1161, 1161,  115,  115,  115,  710,
-      710,  710,  710,  710,  710,  710,  710,  710,  710,  710,
-
-      710,  710,  710,  710,  710,  710,  710,  710,  710,  211,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,  211,
-     1161, 1161, 1161, 1161, 1161, 1161,  712,  712,  712,  712,
-      712,  712,  712,  712,  712,  712,  712,  712,  712,  712,
-      712,  712,  712,  712,  712,  712,  823,  823,  211,  823,
-      823,  823,  823,  823,  823,  823,  823,  823,  823,  823,
-      823,  823,  823,  828,  823,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  823,  823,  823,  823,  823,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-
-      830,  830,  830,  830,  830,  830,  823,  823,  830,  830,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-      830,  830,  830,  830,  823,  832,   77,  832, 1161, 1161,
-      833,  833, 1161,  833, 1161, 1161, 1161,  833,  833, 1161,
-     1161,  833, 1161, 1161,  833,  833,  833,  833,  833,  833,
-      833,  833,  833,  831,  831, 1161,  831,  831,  831,  831,
-      831,  831,  831,  831,  831,  831,  831,  831,  831,  831,
-      841,  831,  842,  842,  842,  842,  842,  842,  842,  842,
-      842,  842,  831,  831,  831,  831,  831,  843,  843,  843,
-
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  843,  843,  831,  831,  843,  843,  843,  843,  843,
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  831,  115, 1161, 1161,  258, 1161,  115,  257,  257,
-      257,  257,  257,  257,  257,  257,  257,  257,  115,  845,
-     1161,  844,  115,  115,  115,  115, 1161,  115, 1161, 1161,
-      115,  115, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
-     1161,  115, 1161, 1161,  846,  115, 1161,  115,  845,  844,
-
-      115,  115,  115,  115,  115, 1161,  115,  115, 1161,  115,
-     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
-     1161, 1161,  846,  115,  115, 1161,  115, 1161, 1161,  115,
-      847, 1161, 1161, 1161, 1161, 1161,  115,  115,  848, 1161,
-     1161,  115,  115,  115, 1161,  849, 1161,  115,  115, 1161,
-      115,  115,  115, 1161,  115,  115,  115, 1161,  847,  850,
-     1161,  852,  115,  852, 1161,  115,  848, 1161, 1161,  115,
-      115, 1161,  115,  115,  849, 1161, 1161,  115,  115,  115,
-      115, 1161,  115, 1161,  115,  115,  855,  115,  850, 1161,
-      115, 1161,  115, 1161,  115, 1161,  853,  115,  115,  115,
-
-     1161,  115,  115, 1161, 1161, 1161, 1161,  115, 1161,  854,
-     1161,  115, 1161,  115,  115,  855,  115, 1161,  858,  115,
-      115, 1161, 1161,  115, 1161,  853,  115, 1161,  115,  115,
-     1161,  115, 1161,  115,  115, 1161,  866,  854, 1161,  115,
-     1161,  115, 1161,  115, 1161,  115,  867,  858,  115, 1161,
-     1161,  115, 1161,  115, 1161,  115,  115,  868, 1161, 1161,
-      115,  115, 1161,  115, 1161,  866, 1161, 1161,  115, 1161,
-      115,  115,  115,  115,  867,  869,  115,  115,  115, 1161,
-      115,  115,  871,  115, 1161,  115,  868, 1161, 1161,  870,
-      115,  115, 1161, 1161,  874, 1161, 1161,  115,  115,  115,
-
-      115,  115, 1161,  115,  869,  115,  115,  115,  115, 1161,
-      115,  871,  115,  115,  875,  115,  875,  870,  115,  115,
-      872,  873,  115,  874,  876,  115,  115, 1161,  115,  115,
-     1161,  115,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
-      877,  115, 1161, 1161,  115,  115,  115,  115,  872,  873,
-      115,  115,  115, 1161,  878,  115, 1161,  115,  115, 1161,
-      115, 1161,  879,  115, 1161,  115,  115,  115,  877,  115,
-     1161,  880,  115,  115,  115,  115,  115,  115, 1161, 1161,
-      115,  115, 1161,  878, 1161, 1161,  115,  115,  115, 1161,
-      115,  879,  115,  115,  115,  115,  115, 1161,  115,  115,
-
-      880,  115, 1161,  115,  115,  115, 1161,  881, 1161,  115,
-      115, 1161, 1161, 1161,  115,  115,  115,  882,  115,  115,
-     1161,  883,  115, 1161,  115, 1161, 1161,  115,  115,  115,
-     1161,  115, 1161,  115, 1161,  881,  115,  115, 1161,  115,
-     1161,  115,  115,  115,  115,  882,  115,  115,  115,  883,
-      115,  115, 1161,  884, 1161,  884,  115,  115, 1161, 1161,
-      115,  115,  115,  115, 1161,  115, 1161, 1161,  115,  115,
-     1161,  115,  115, 1161,  115, 1161,  115,  115,  115,  115,
-     1161,  886,  115,  888, 1161, 1161,  115, 1161,  115,  115,
-      115,  115,  115,  115,  115, 1161, 1161,  115,  887,  115,
-
-     1161,  885,  115,  115, 1161,  115, 1161, 1161,  115,  886,
-      115, 1161,  888,  889, 1161,  115, 1161,  115, 1161,  115,
-      115,  115, 1161,  115,  115, 1161,  887,  115,  115,  885,
-      115,  891,  115,  115, 1161, 1161,  890, 1161,  115,  115,
-     1161,  889, 1161, 1161,  115, 1161,  115, 1161,  115, 1161,
-     1161,  892, 1161,  115, 1161, 1161,  115, 1161,  115, 1161,
-      891,  115,  115, 1161,  890, 1161,  115,  115,  115, 1161,
-      115,  115, 1161,  115,  115,  115,  115, 1161,  895,  892,
-     1161,  115,  115, 1161, 1161, 1161,  115,  115, 1161,  115,
-      115,  115, 1161,  115, 1161,  896,  115,  896,  115,  115,
-
-      115,  115, 1161, 1161,  115,  115, 1161,  895, 1161,  115,
-     1161,  115,  115, 1161, 1161, 1161,  115,  115,  115,  115,
-      115, 1161,  115, 1161,  115,  115,  115,  115,  115,  115,
-      897,  906, 1161,  115, 1161, 1161, 1161, 1161,  898,  115,
-      115, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,  115,
-     1161,  115, 1161,  115,  115,  115,  115,  115, 1161,  897,
-      906, 1161,  115, 1161,  907, 1161,  898,  115, 1161,  908,
-      115,  908, 1161,  115,  258,  115,  802,   77,  804,  175,
-      115, 1161, 1161, 1161, 1161,  115, 1161, 1161, 1161, 1161,
-      909,  115,  907, 1161, 1161,  115,  115, 1161,  115, 1161,
-
-     1161, 1161,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
-      115,  177,  178, 1161, 1161,  179, 1161,  180, 1161,  909,
-      115,  115, 1161, 1161,  115,  115, 1161, 1161,  341,  182,
-     1161,  115, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
-      177,  178, 1161, 1161,  179, 1161,  180, 1161, 1161,  115,
-     1161, 1161, 1161, 1161, 1161, 1161,  341,  182,  912,  912,
-      211,  912,  912,  912,  912,  912,  912,  912,  912,  912,
-      912,  912,  912,  912,  912,  914,  912,  915,  915,  915,
-      915,  915,  915,  915,  915,  915,  915,  912,  912,  912,
-      912,  912,  916,  916,  916,  916,  916,  916,  916,  916,
-
-      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
-      916,  916,  916,  916,  916,  916,  916,  916,  912,  912,
-      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
-      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
-      916,  916,  916,  916,  916,  916,  912,  211,  257,  257,
-      257,  257,  257,  257,  257,  257,  257,  257, 1161, 1161,
-     1161, 1161, 1161, 1161,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  383,  374,  374,  211,  374,  374,  374,
-      374,  374,  374,  374,  374,  374,  374,  374,  374,  374,
-      374,  384,  374,  385,  385,  385,  385,  385,  385,  385,
-
-      385,  385,  385,  374,  374,  374,  374,  374,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  374,  374,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  374,  115, 1161,  917, 1161,  115,  115,  918,
-      115,  115,  115,  919,  115, 1161,  115, 1161,  920,  115,
-     1161, 1161,  115, 1161,  115, 1161,  115, 1161, 1161, 1161,
-      115, 1161,  115,  115,  917, 1161,  115,  115,  918,  115,
-
-      115,  115,  919,  115,  922,  115, 1161,  920,  115,  115,
-      115,  115,  115, 1161,  115,  921,  115, 1161,  115, 1161,
-      115,  115, 1161,  115, 1161,  115, 1161,  115, 1161, 1161,
-      115,  115,  115,  922,  923, 1161,  115, 1161,  115,  115,
-      115,  927, 1161, 1161,  921,  115,  115, 1161,  928,  115,
-      115,  115,  115, 1161,  115, 1161,  115,  115,  115, 1161,
-      115,  115,  923,  115, 1161,  115, 1161,  115,  115,  927,
-     1161,  115,  115, 1161,  115, 1161,  928,  115,  115, 1161,
-      930,  115,  115,  115, 1161, 1161,  115, 1161,  115, 1161,
-     1161,  938,  115, 1161,  939, 1161, 1161,  115, 1161,  115,
-
-     1161,  115,  115, 1161,  115, 1161,  115, 1161,  930,  115,
-      115, 1161,  115,  115, 1161,  941, 1161,  115,  115,  938,
-     1161,  940,  939,  115, 1161, 1161, 1161, 1161, 1161,  115,
-      115, 1161,  115,  115,  115,  115, 1161, 1161,  115, 1161,
-      115, 1161,  115,  942,  941, 1161, 1161,  115,  115,  940,
-     1161,  115, 1161, 1161,  115, 1161, 1161, 1161,  115, 1161,
-      115,  115, 1161,  115,  115,  943,  115, 1161,  115,  115,
-      115,  942,  944,  115, 1161,  115,  115, 1161, 1161, 1161,
-      115,  945,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
-      115,  115, 1161,  115,  943,  115,  115,  115,  115,  115,
-
-     1161,  944,  115, 1161,  115, 1161,  951, 1161,  115,  945,
-      952, 1161,  115,  115,  115,  115,  115,  115,  115,  115,
-      115,  115,  115, 1161, 1161,  115, 1161,  115, 1161, 1161,
-     1161, 1161,  115,  115,  951,  115,  115, 1161,  952, 1161,
-      115,  115,  115,  115,  953,  115, 1161,  115,  115, 1161,
-      115, 1161,  115,  115, 1161,  115, 1161,  115,  115,  115,
-      115,  115, 1161,  115,  115,  115, 1161, 1161, 1161, 1161,
-      115,  115,  956,  953, 1161, 1161,  955, 1161,  115,  115,
-     1161,  115,  115,  115,  115, 1161,  115,  115,  115, 1161,
-      115,  115, 1161,  115, 1161,  115,  115, 1161,  115,  115,
-
-      956,  957,  115, 1161,  955, 1161,  115,  115,  115,  115,
-      115,  115, 1161,  115, 1161,  958,  115, 1161, 1161,  115,
-      115,  115,  115,  962,  115,  115,  115,  115,  115,  957,
-      115,  115, 1161, 1161,  115, 1161,  115,  115,  115,  115,
-      115,  115,  115,  969,  958,  115, 1161, 1161,  115,  115,
-     1161,  115,  962,  115, 1161,  960,  115,  115,  115,  115,
-     1161, 1161,  115,  115,  115, 1161,  115,  963,  115,  115,
-      115,  115,  969, 1161, 1161, 1161, 1161,  115,  115, 1161,
-     1161,  115, 1161,  960,  970,  115, 1161, 1161,  115,  115,
-      115,  971, 1161,  115,  115,  115,  963, 1161, 1161, 1161,
-
-      115, 1161, 1161, 1161, 1161, 1161,  115,  211,  115, 1161,
-     1161, 1161,  970,  115, 1161, 1161,  115,  975,  115, 1161,
-      971,  115, 1161,  115,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  383, 1161,  115,  115,  115, 1161,  115,
-     1161, 1161,  115,  976,  115,  115,  975, 1161,  115, 1161,
-      115, 1161, 1161,  115, 1161, 1161,  115, 1161,  115, 1161,
-     1161, 1161, 1161,  115, 1161,  977,  115,  115,  115,  115,
-      115,  115,  976,  115,  115,  115, 1161,  115,  115, 1161,
-     1161, 1161,  115,  115,  115, 1161,  115, 1161,  115,  978,
-     1161,  979, 1161,  977, 1161,  115, 1161,  115,  115,  115,
-
-     1161,  115, 1161,  115,  115,  115,  115,  115, 1161,  983,
-      115, 1161,  115,  982, 1161, 1161,  115,  978, 1161,  979,
-      115,  115, 1161, 1161,  115,  115,  115,  115,  994,  992,
-      115,  985,  115,  115,  115,  115, 1161, 1161,  983,  115,
-      115,  982, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
-      115, 1161,  115, 1161, 1161,  115,  115,  994,  992,  115,
-      985,  115,  115,  993,  115,  115,  115, 1161,  115, 1161,
-      115,  115, 1161, 1161,  115,  115, 1161, 1161,  115, 1161,
-     1161, 1161,  115, 1161,  995,  115,  996,  115,  115, 1161,
-     1161,  115,  993,  115,  115,  115,  115, 1161, 1161,  115,
-
-      115,  115,  115, 1161,  997, 1161,  115,  115, 1161, 1161,
-      115,  115,  995,  115,  996, 1161,  115, 1161,  115, 1161,
-      115,  115,  115,  115, 1161,  115, 1161,  115, 1161,  115,
-     1161,  115,  997, 1161, 1161, 1161,  115,  115,  115,  115,
-     1161,  115, 1161,  115,  115, 1004, 1161,  115,  115,  115,
-     1161,  115,  115, 1006, 1161, 1161,  115, 1161,  115,  115,
-     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
-      115,  115,  115,  115, 1004,  115, 1161,  115,  115, 1161,
-     1161, 1006, 1161, 1161, 1161,  115,  115, 1007,  115,  115,
-      115, 1161,  115,  115, 1161,  115, 1009,  115, 1161,  115,
-
-      115, 1161, 1161,  115,  115, 1161,  115, 1161,  115,  115,
-     1161,  115, 1161,  115,  115, 1007, 1012,  115, 1161, 1161,
-     1161,  115,  115, 1161, 1161, 1009,  115, 1011,  115,  115,
-     1161, 1161,  115, 1161,  115,  115, 1161,  115,  115,  115,
-      115,  115, 1161,  115, 1012, 1020,  115, 1161,  115, 1019,
-      115, 1161,  115, 1161,  115, 1011,  115,  115,  115, 1161,
-      115,  115, 1161,  115,  115, 1161,  115, 1161,  115,  115,
-      115,  115, 1025,  115, 1020,  115,  115, 1019, 1161, 1161,
-      115,  115,  115, 1161,  115, 1161,  115,  115,  115,  115,
-      115, 1161, 1161,  115, 1161,  115, 1161,  115,  115,  115,
-
-     1025,  115,  115,  115,  115, 1026,  115, 1161,  115,  115,
-     1161, 1161,  115,  115, 1161,  115, 1161, 1161,  115, 1029,
-      115, 1161,  115,  115,  115, 1161, 1030,  115, 1161,  115,
-      115,  115, 1161,  115, 1026,  115, 1161, 1161,  115, 1161,
-      115,  115, 1161,  115,  115,  115,  115, 1029,  115,  115,
-      115,  115, 1161,  115, 1161, 1030, 1038, 1161,  115, 1037,
-      115,  115, 1161,  115,  115, 1161,  115,  115, 1161, 1161,
-      115,  115,  115,  115,  115,  115, 1161, 1161,  115,  115,
-      115, 1161, 1161, 1161, 1038, 1161, 1039, 1037,  115, 1161,
-      115,  115,  115,  115, 1161,  115,  115,  115,  115, 1040,
-
-      115,  115,  115, 1161,  115,  115, 1044, 1161,  115,  115,
-     1161, 1161,  115, 1161, 1039, 1161,  115, 1161, 1161,  115,
-      115, 1161,  115,  115, 1161,  115,  115,  115, 1040,  115,
-     1161,  115, 1161,  115,  115, 1044, 1161,  115,  115,  115,
-      115, 1047,  115, 1161,  115, 1161, 1161,  115, 1161,  115,
-     1161,  115, 1161,  115,  115, 1161,  115, 1048,  115, 1161,
-      115, 1161, 1161, 1161,  115,  115,  115,  115, 1161,  115,
-     1047,  115,  115, 1161, 1161, 1054,  115, 1161, 1161,  115,
-     1059,  115,  115,  115,  115,  115, 1048,  115, 1161,  115,
-      115, 1161, 1161,  115,  115,  115, 1161,  115,  115, 1161,
-
-      115, 1161,  115, 1054,  115,  115, 1161,  115, 1062, 1059,
-      115,  115, 1161, 1161,  115, 1161,  115, 1161, 1161,  115,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1063,  115,
-     1161,  115,  115, 1161, 1161, 1067, 1062, 1161, 1161,  115,
-     1161,  115, 1161,  115,  115, 1161, 1161,  115, 1161,  115,
-     1161,  115,  115,  115,  115, 1068,  115, 1063,  115,  115,
-     1161, 1161, 1161, 1067,  115, 1161,  115,  115,  115,  115,
-      115,  115, 1069,  115, 1073,  115,  115, 1161,  115, 1161,
-     1161,  115, 1161, 1161, 1068, 1161, 1161,  115,  115,  115,
-      115,  115, 1161,  115,  115,  115,  115,  115, 1161,  115,
-
-     1161, 1069,  115, 1073,  115, 1161,  115,  115, 1161,  115,
-     1080, 1161,  115, 1161, 1161,  115,  115,  115, 1161,  115,
-      115,  115, 1161,  115,  115,  115,  115, 1087,  115, 1161,
-     1161, 1161, 1161, 1161, 1088,  115,  115,  115, 1080,  115,
-     1161,  115,  115, 1161,  115,  115,  115, 1161,  115, 1161,
-      115,  115,  115,  115,  115, 1161, 1087,  115,  115, 1091,
-     1161, 1161, 1088,  115, 1161,  115, 1161,  115,  115,  115,
-      115,  115, 1095,  115,  115,  115,  115,  115, 1161, 1161,
-      115, 1161,  115, 1161, 1161, 1161,  115, 1091,  115, 1161,
-      115,  115, 1161,  115,  115,  115,  115, 1161,  115,  115,
-
-      115, 1095, 1106,  115, 1161,  115, 1161, 1161, 1161, 1161,
-      115, 1161, 1161,  115, 1105, 1161,  115,  115,  115, 1161,
-      115, 1108,  115,  115,  115,  115, 1161, 1161,  115,  115,
-     1161, 1106, 1161, 1161, 1161, 1161,  115, 1161,  115, 1161,
-      115,  115, 1105,  115, 1112,  115,  115,  115, 1161,  115,
-     1108,  115,  115,  115,  115, 1161, 1161, 1161,  115,  115,
-     1161, 1122, 1161, 1161,  115, 1161,  115, 1161,  115,  115,
-     1161,  115, 1112, 1161,  115, 1161,  115, 1161,  115, 1161,
-     1161,  115, 1161,  115, 1161, 1161, 1161,  115, 1161, 1122,
-     1161, 1161, 1161, 1161,  115, 1161,  115, 1124,  948, 1124,
-
-     1161, 1161, 1125, 1125, 1161, 1125, 1161, 1161, 1161, 1125,
-     1125, 1161, 1161, 1125, 1161, 1161, 1125, 1125, 1125, 1125,
-     1125, 1125, 1125, 1125, 1125,  115,  115, 1161, 1161, 1161,
-      115,  115, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1133,
-     1161, 1161, 1128, 1161,  115,  115, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161,  115,  115, 1161, 1161, 1161,  115,
-      115, 1161, 1161, 1161, 1161, 1161, 1161, 1133, 1161, 1161,
-     1128, 1161,  115,  115,  947,  948,  947, 1161, 1161, 1134,
-     1134, 1161, 1135, 1161,  115,  950, 1134, 1134, 1137,  115,
-     1134, 1161, 1161, 1134, 1134, 1134, 1134, 1134, 1134, 1134,
-
-     1134, 1134, 1161,  115,  115,  115, 1161, 1161, 1161,  115,
-      115, 1161, 1161,  115, 1161, 1161, 1161, 1137,  115, 1161,
-     1161, 1161, 1161,  115,  115, 1161, 1161, 1161, 1161, 1161,
-     1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115,  115,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161,  115,  115,   64,   64,   64,   64,   64,   64,   64,
-       64,   64,   64,   64,   64,   65,   65,   65,   65,   65,
-       65,   65,   65,   65,   65,   65,   65,   81,   81, 1161,
-       81,   81,   81,   81,   81,   81,   81,   81,   81,   84,
-       84, 1161,   84,   84,   84,   84,   84,   84,   84,   84,
-
-       84,   88,   88,   88,   88,   88,   88,   88,   88,   88,
-       88,   88,   88,   92,   92,   92,   92,   92,   92,   92,
-       92,   92,   92,   92,   92,  111,  111,  115,  115,  115,
-      115,  115,  115,  115,  115,  187,  187,  187,  187,  187,
-      187,  187,  187,  187,  187,  187,  187,  202,  202,  202,
-      202,  202,  202,  202,  202,  202,  202,  202,  202,  209,
-      209,  209,  209,  209,  209, 1161,  209,  209,  209, 1161,
-      209,  232,  232,  232,  232,  232,  232,  232,  232,  232,
-      232,  232,  232,  101, 1161, 1161,  101,  252,  252,  252,
-     1161, 1161,  252, 1161,  252,  252, 1161,  252,  252,  343,
-
-      343,  343,  343,  343,  343,  343,  343,  343,  343,  343,
-      343,  358,  358, 1161,  358,  358,  358,  358,  358,  358,
-      358,  358,  358,  371,  371,  371,  371,  371,  371, 1161,
-      371,  371,  371, 1161,  371,  374,  374,  374,  374,  374,
-      374,  374,  374,  374,  374,  374,  374,  379,  379,  379,
-      379,  379,  379,  379,  379,  379,  379,  379,  379,  422,
-     1161, 1161,  422,  276, 1161, 1161, 1161,  276, 1161, 1161,
-     1161, 1161, 1161,  276,  558,  558,  558,  558,  558,  558,
-      558,  558,  558,  558,  558,  558,  718,  718, 1161,  718,
-      718,  718,  718,  718,  718,  718,  718,  718,  721,  721,
-
-     1161,  721,  721,  721,  721,  721,  721,  721,  721,  721,
-      723,  723, 1161,  723,  723,  723,  723,  723,  723,  723,
-      723,  723,   88,   88,   88,   88,   88,   88,   88,   88,
-       88,   88,   88,   88,  726,  726,  726,  726,  726,  726,
-      726,  726,  726,  726,  726,  726,   92,   92,   92,   92,
-       92,   92,   92,   92,   92,   92,   92,   92,  728,  728,
-      728,  728,  728,  728,  728,  728,  728,  728,  728,  728,
-      812,  812,  812,  812,  812,  812,  812,  812,  812,  812,
-      812,  812,  814,  814, 1161,  814,  814,  814,  814,  814,
-      814,  814,  814,  814,  823,  823,  823,  823,  823,  823,
-
-      823,  823,  823,  823,  823,  823,  825,  825,  825,  825,
-      825,  825,  825,  825,  825,  825,  825,  825,  831,  831,
-     1161,  831,  831,  831,  831,  831,  831,  831,  831,  831,
-      834,  834, 1161,  834,  834,  834,  834,  834,  834,  834,
-      834,  834,   81,   81, 1161,   81,   81,   81,   81,   81,
-       81,   81,   81,   81,  835,  835, 1161,  835,  835,  835,
-      835,  835,  835,  835,  835,  835,   84,   84, 1161,   84,
-       84,   84,   84,   84,   84,   84,   84,   84,  837,  837,
-      837,  837,  837,  837,  837,  837,  837,  837,  837,  837,
-       88,   88,   88,   88,   88,   88,   88,   88,   88,   88,
-
-       88,   88,  838,  838,  838,  838,  838,  838,  838,  838,
-      838,  838,  838,  838,   92,   92,   92,   92,   92,   92,
-       92,   92,   92,   92,   92,   92,  187,  187,  187,  187,
-      187,  187,  187,  187,  187,  187,  187,  187,  904,  904,
-      904,  904,  904,  904,  904,  904,  904,  904,  904,  904,
-      358,  358, 1161,  358,  358,  358,  358,  358,  358,  358,
-      358,  358,  814,  814, 1161,  814,  814,  814,  814,  814,
-      814,  814,  814,  814,  202,  202,  202,  202,  202,  202,
-      202,  202,  202,  202,  202,  202,  912,  912,  912,  912,
-      912,  912,  912,  912,  912,  912,  912,  912,  374,  374,
-
-      374,  374,  374,  374,  374,  374,  374,  374,  374,  374,
-      379,  379,  379,  379,  379,  379,  379,  379,  379,  379,
-      379,  379,  825,  825,  825,  825,  825,  825,  825,  825,
-      825,  825,  825,  825,  946,  946,  946,  946,  946,  946,
-      946,  946,  946,  946,  946,  946,  999,  999,  999,  999,
-      999,  999,  999,  999,  999,  999,  999,  999,   13, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161
+       50,   51,   52,   42,   53,   42,   42,   54,   14,   55,
+       56,   57,   58,  222,   69,   68,   69,   70,   72,   76,
+
+       77,   76, 1094,   74,   78,   77,   78,   59,   59,   59,
+       59,   59,   59,   59,   59,   59,   59,   75,  205,   80,
+     1092,   73,  222,  208,   60,   61,  205,  223,   62,   70,
+       63,   71,   74,   81,   83,   74,   87,   74,   74,   91,
+       82,   64,   65,  691, 1070,   75,   92,   93,   80,   75,
+       73,   75,   75,   60,   61,  223,  225,   62,   70,   63,
+       71,   81,   83,   96,   74,  111,   74,   74,   84,   64,
+       65,  209,   74,   88,   74,   74,   94,   75,  226,   75,
+       75,   97,   85,  255,   74,  225,   75,   89,   75,   75,
+       95,  227,  107,   83,  239,   74, 1070,   84,   75,  209,
+
+      624,   74,   88,   74,   74,   94,  226,   74,  625,   75,
+       85,   74,  255,   74,   75,   89,   75,   75,   95,   74,
+      227,   75,  239, 1065,   74,   75,   75,   78,   77,   78,
+       76,   77,   76,   75,  240,  247,   74,   75,  248,  228,
+       74,  179,  206,  205,  206,  112, 1030,  179,   74,   75,
+       98,   74,   98,   75,   78,   77,   78,  224,   77,  224,
+     1027,   75,  240,  247,  963,   75,  248,  228,   99,   99,
+       99,   99,   99,   99,   99,   99,   99,   99,   74,  207,
+       74,  114,  115,  100,  261,  116,  116,  101,   74,  102,
+      212,  117,   75,   75,  103,  142,  104,  105,  118,  119,
+
+      121,  922,   75,  263,   87,  190,  106,   74,  207,   87,
+      114,  115,  100,  261,  116,  116,  101,   74,  102,  117,
+       75,  253,  103,  142,  104,  105,  118,  119,  121,   87,
+       75,  120,  263,  116,  106,  108,  116,  109,  109,  109,
+      109,  109,  109,  109,  109,  109,  109,  121,   83,  253,
+      121,   91,  511,  230,  512,  110,  110,   74,   92,   93,
+      120,  229,  116,  254,  256,  116,  245,  212,  110,  260,
+      262,   75,  268,  116, 1131,  121,  246,  175,  121,  127,
+      116,  230,  146,  128,  110,  110,   74,  121, 1131,  129,
+      229,  254,  256,  130,  121,  245,  110,  260,  262,   75,
+
+      122,  268,  116, 1131,  246,  116,  116,  123,  127,  116,
+      146,  124,  128,  212,  125,  121, 1131,  129,   91,  121,
+      121,  130,  121,  190,  126,   92,   93,  179,  190,  122,
+       78,   77,   78,  179,  116,  116,  123,  143,   87,  124,
+      275,  147,  125,   87,  144,  145,  116,  121,  121,  148,
+       83,  121,  126,  116,  753,  149,  211,  212,  211,  131,
+      121,  132,  133,  754,  134,  135,  143,  121,  213,  275,
+      147,  136,  144,  145,  264,  116,  241,   82,  148,  121,
+      795,  212,  116,  149,  366,  367,  366,  131,  121,  132,
+      133,  242,  134,  135,  214,  121,  259,  162,  116,  136,
+
+      116,  190,  264,  137,  762,  241,  138,  139,  215,  140,
+      150,  753,  121,  260,  121,  141,  271,  255,  151,  242,
+      754,  113,  152,  214,  153,  259,  162,  116,  257,  116,
+      154,  698,  137,  243,  138,  139,  215,  140,  258,  150,
+      121,  260,  121,  141,  271,  116,  255,  151,  244,  113,
+      152,  158,  153,  155,  272,  156,  116,  257,  154,  121,
+      157,  116,  243,  273,  274,  159,  258,  276,  160,  172,
+      121,  161,  179,   87,  116,  121,  244,  534,  179,  277,
+      158,  155,  272,  156,  534,  116,  278,  121,  157,  282,
+      116,  273,  274,  159,   91,  276,  160,  172,  121,  161,
+
+      163,   92,   93,  121,  164,  116,  169,  277,  165,  643,
+      116,  116,  173,  170,  278,  635,  166,  282,  285,  167,
+      168,  286,  174,  171,  121,  121,  378,   77,  378,  163,
+      560,  559,  295,  164,  116,  169,  287,  165,  290,  116,
+      116,  173,  170,  237,  166,  196,  285,  167,  168,  286,
+      174,  171,  121,  121,  176,   77,  177,  178,  186,  187,
+      190,  295,  179,  557,  287,  191,  290,  511,  283,  512,
+      296,  237,  197,  556,  284,  188,  188,  188,  188,  188,
+      188,  188,  188,  188,  188,  297,  198,  298,  310,  180,
+      181,  116,   74,  182,  116,  183,  283,  192,  296,  172,
+
+      200,  197,  284,  142,  203,  121,  184,  185,  121,  212,
+      299,  193,  534,  297,  198,  190,  298,  310,  180,  181,
+      116,   74,  182,  116,  183,  300,  192,  172,  200,  510,
+      400,  142,  203,  121,  184,  185,  121,  143,  299,  193,
+      194,  232,  233,  232,  144,  201,  179,  396,  395,  234,
+      235,  121,  394,  300,  108,  393,  195,  195,  195,  195,
+      195,  195,  195,  195,  195,  195,  143,  238,  238,  288,
+       91,  288,  144,  201,  110,  110,   74,   92,   93,  121,
+      238,  301,  265,  266,  302,  303,  304,  110,  267,  307,
+       75,  313,  212,  651,  319,  652,  238,  238,  320,  212,
+
+      323,  269,  236,  110,  110,   74,  270,  330,  238,  301,
+      265,  266,  302,  303,  304,  110,  267,  307,   75,  199,
+      313,  289,  319,  127,  116,  205,  320,  128,  323,  190,
+      269,  236,  190,  129,  344,  270,  330,  130,  121,  308,
+      169,  190,  309,  279,  321,  116,  291,  170,  199,  289,
+      280,  322,  127,  116,  281,  331,  128,  171,  292,  121,
+      293,  129,  344,  294,  202,  130,  121,  308,   87,  169,
+      309,   87,  279,  321,  116,  291,  170,   83,  280,  322,
+      205,  651,  281,  652,  331,  171,  292,  121,  293,  921,
+     1131,  294,  202,  210,  211,  212,  211,  210,  210,  210,
+
+      216,  210,  210,  210,  210,  210,  210,  210,  210,  210,
+      210,  210,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  210,  210,  210,  210,  210,  197,  217,  217,
+      217,  217,  218,  217,  123,  217,  217,  217,  219,  217,
+      217,  198,  217,  217,  217,  217,  220,  217,  217,  217,
+      217,  221,  217,  210,  210,  217,  197,  217,  217,  217,
+      217,  218,  217,  123,  217,  217,  219,  217,  217,  198,
+      217,  217,  217,  217,  220,  217,  217,  217,  217,  221,
+      217,  210,   98,  251,   98,  251,   68,  305,  252,  252,
+      252,  252,  252,  252,  252,  252,  252,  252,  311,  366,
+
+      367,  366,  306,  345,  312,  332,  667,  326,  667,  328,
+      333,  335, 1131,  329,  334,  100,  305,  347,  327,  101,
+      343,  102,  205,  669,  355,  669,  103,  311,  104,  105,
+      306,  345,  312,  314,  332,  315,  326,  328,  106,  333,
+      335,  329, 1131,  334,  100,  347,  327, 1131,  101,  343,
+      102,  316,  317,  355,  103,  318,  104,  105,  337,  358,
+      338, 1131,  314,  190,  315, 1131,  106,  250,  250,  250,
+      250,  250,  250,  250,  250,  250,  250,  324,  341,  316,
+      317,  223,  925,  318,  362,  110,  110,  358,  346,  190,
+      359,  325,  342,  190,  260,  351, 1131,  233,  110,  361,
+
+     1131,  205,  212, 1131,  385,  235,  324,  341, 1131,  223,
+      339,  186,  348,  362,  110,  110,  346,  205,  359,  325,
+      342,  352,  260, 1131,  351, 1131,  110,  361,  349,  349,
+      349,  349,  349,  349,  349,  349,  349,  349,  339,  350,
+      262,  770,  353,  771,  390,  179,  209,  356,  376,  363,
+      352,  369,  377, 1131, 1131,  349,  349,  349,  349,  349,
+      349,  349,  349,  349,  349,  350,  265,  357,  262,  212,
+      353,  179,  267,  390,  209,  356,  376, 1131,  363,  369,
+      377,  349,  349,  349,  349,  349,  349,  349,  349,  349,
+      349,  350,  205,  379,  265,  357,  212,  179, 1131,  391,
+
+      267,  368,  206,  205,  206,  108,  291,  354,  354,  354,
+      354,  354,  354,  354,  354,  354,  354,  380,  292,  399,
+      293,  379,   83,  360,   87,  110,  110,  364,  370,  371,
+      368,  375, 1131, 1131,  408,  291,  233,  392,  110,  207,
+       87, 1131,   83,  385,  235,  380,  292,  399,  293, 1131,
+      770,  360,  771, 1131,  110,  110,  364,  370,  371, 1131,
+      375,  397,  381,  408, 1131,  392,  110,  383,  207,  365,
+      365,  212,  365,  365,  365,  365,  365,  365,  365,  365,
+      365,  365,  365,  365,  365,  365,  365,  365,  371,  371,
+      381,  382,  384,  401,  398,  383,  404,  405,  365,  365,
+
+      365,  365,  365,  373,   91,  374,  232,  233,  232,  406,
+      407,   92,   93,  409,  234,  235, 1131,  371,  371,  382,
+      384,  401,  398, 1131,  404,  405,  232,  233,  232,  365,
+      365,  373, 1131,  374,  234,  235,   91,  406,  407, 1131,
+      388,  409,  388,   92,   93,  389,  389,  389,  389,  389,
+      389,  389,  389,  389,  389,  410,  387,  365,  365,  365,
+      212,  365,  365,  365,  365,  365,  365,  365,  365,  365,
+      365,  365,  365,  365,  365,  365,  365,  411,  412,  386,
+      547,   77,  547,  410,  387, 1131, 1131,  365,  365,  365,
+      365,  365,  372,  252,  252,  252,  252,  252,  252,  252,
+
+      252,  252,  252,  413,  414,  411,  412,  386,  252,  252,
+      252,  252,  252,  252,  252,  252,  252,  252,  365,  365,
+      402,  372,  402,  686,   77,  686, 1131, 1131,  417,  419,
+      403,  413,  414,  415,  420,  421,  416, 1131,  422,  423,
+      424,  425,  426, 1131, 1131,  418,  365,  250,  250,  250,
+      250,  250,  250,  250,  250,  250,  250,  417,  419,  439,
+      444,  415,  420,  421,  416,  238,  238,  422,  423,  424,
+      425,  426,  437,  418,  437,  445,  446,  440,  238,  440,
+     1131, 1131,  442,  443,  447,  448,  450,  448,  439,  444,
+      451, 1131,  453,  454,  238,  238,  455,  456,  288,  457,
+
+      288,  460, 1131,  438,  445,  446,  238,  427,  441,  427,
+      442,  443,  447,  458,  450,  470,  449, 1131,  469,  451,
+      453,  454, 1131,  471,  455,  456,  459,  457,  474, 1131,
+      460,  461,  472,  461,  472, 1131,  475,  465,  428,  465,
+      476,  462,  458,  429,  470,  430,  469,  466,  431, 1131,
+      452,  471,  432,  478,  459,  433,  477,  474,  434,  435,
+      479, 1131,  436,  473,  475,  480,  481,  484,  476,  485,
+      488,  482,  429,  489,  430,  463,  490,  431,  452,  483,
+      432,  467,  478,  433,  477,  464,  434,  435,  491,  479,
+      436,  468,  486,  480,  481,  492,  484,  485,  488,  482,
+
+      487,  489,  493,  463,  490,  494,  495,  483,  496,  467,
+      497,  498,  499,  464,  502,  503,  500,  491,  500,  468,
+      504,  486,  505,  506,  492,  507,  501,  508,  487,  509,
+      346,  493,  513,  494,  514,  495,  496,  515,  497,  498,
+      499,  516,  517,  502,  503,  518,  519,  190,  504, 1131,
+      505,  506, 1131,  507,  190,  508,  205,  509,  346,  511,
+      513,  520,  514,  190, 1131,  515,  527,  528,  530,  516,
+      517,  417,  531,  518,  545,  519,  212,  521,  521,  521,
+      521,  521,  521,  521,  521,  521,  521,  522,  529,  212,
+      524,  533,  523,  179,  535,  527,  528,  530,  371, 1131,
+
+      417,  531,  545,  521,  521,  521,  521,  521,  521,  521,
+      521,  521,  521,  522,  212,  525,  529,  212,  524,  179,
+      533,  523,  546,  535,  548,   87, 1131,  371,  539,  521,
+      521,  521,  521,  521,  521,  521,  521,  521,  521,  190,
+     1131,  532,  371,  525,  522,  536,  205,  536,   83,  927,
+      179,  546,  548,  541,  459,  540,  539,  538,  108,  371,
+      526,  526,  526,  526,  526,  526,  526,  526,  526,  526,
+      532,  371,  371,  549,   87,  552,   83,  542,  110,  110,
+     1131,  541,  459,  371,  540,  538,  537,  562,  371,  233,
+      558,  110,  543,  561,  544,  550,  385,  235,  667, 1029,
+
+      667,  371,  549,  552, 1131,  542,   91,  110,  110,  551,
+      553, 1131,  371,   92,   93,  537,  562,   91,  558,  110,
+      543,  561,  544,  550,   92,   93,  389,  389,  389,  389,
+      389,  389,  389,  389,  389,  389,  563,  564,  551,  553,
+      389,  389,  389,  389,  389,  389,  389,  389,  389,  389,
+      402,  565,  402,  555,  566, 1131,  554,  567, 1131,  568,
+      403,  569,  570,  571,  572,  563,  564,  573,  574,  575,
+      576,  577,  578,  589,  578,  590,  591, 1131,  592,  565,
+      593,  596,  555,  566,  554,  597,  567,  568,  594,  569,
+      570,  598,  571,  572,  599,  573,  574,  575,  576,  577,
+
+      437,  589,  437,  590,  595,  591,  592,  602,  593,  596,
+      440,  605,  440,  579,  597,  606,  603,  594,  603,  598,
+      607,  448,  599,  448,  212,  608,  609,  580,  610, 1131,
+      613,  438,  595,  611,  612,  602,  614,  616,  617,  605,
+      619,  441,  579,  615,  606,  618,  621,  604,  620,  607,
+     1131,  622,  449,  608,  609,  580,  427,  610,  427,  613,
+      623,  611,  612, 1131,  629,  614,  616,  617,  461,  619,
+      461,  615,  465,  618,  465,  621,  620,  627,  462,  622,
+      632,  472,  466,  472, 1033,  628,  630,  428,  623,  631,
+      633,  624,  581,  629,  582,  634,  640,  583,  645,  625,
+
+      636,  584, 1131,  637,  585,  627,  638,  586,  587,  632,
+      639,  588,  473,  628,  630, 1131, 1131,  631,  633, 1131,
+      646,  581,  646,  582,  634,  640,  583,  645,  636,  584,
+      626,  637,  585,  644,  638,  586,  587, 1131,  639,  588,
+      600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
+      600,  647,  600,  600,  600,  600,  600,  600,  600,  626,
+      648,  644,  649,  650,  641,  500,  641,  500,  653,  600,
+      600,  600,  600,  600,  642,  501,  654,  655,  656,  657,
+      658,  190,  190,  669,  205,  669,  190, 1131,  667,  648,
+      667,  649,  650,  651,  668,  659,  666,  653,  701,  205,
+
+      600,  600,  571,  212,  654,  670,  655,  656,  657,  658,
+      205,  660,  660,  660,  660,  660,  660,  660,  660,  660,
+      660,  661,  664,  668,  666,  684,  701,  179,  600,  703,
+      662,  571,  663,  675,  670, 1131, 1131,  660,  660,  660,
+      660,  660,  660,  660,  660,  660,  660,  661, 1131,  212,
+      212,  664,  679,  179,  684,  676,  705,  703,  662, 1050,
+      663,  675, 1131,  660,  660,  660,  660,  660,  660,  660,
+      660,  660,  660,  661,  614,  536,  205,  536, 1131,  179,
+      679,  615,  687,  676,  705,  671,  678,  108,  371,  665,
+      665,  665,  665,  665,  665,  665,  665,  665,  665,  677,
+
+      672, 1131,  672,  614,   87,   83,  680,  110,  110,  615,
+      673,  687,  699,  671,  674,  678,  537,  371,  371, 1131,
+      110,  371,  681,   91,  371,  682,  700,  677,  683,  704,
+       92,   93,  706,  712,  680,   91,  110,  110,  689,  713,
+      692,  699,  696,  697,  707,  537,  708,  371,  110,  709,
+      371,  681,  710,  371,  682,  700,  711,  683,  704,  694,
+     1131,  706,  712,  718,  770,  186,  775,  689,  713,  692,
+     1131,  578,  707,  578,  708, 1131,  641,  709,  641,  716,
+      710,  717, 1131,  719,  711,  720,  642,  721,  694,  685,
+      685,  718,  685,  685,  685,  685,  685,  685,  685,  685,
+
+      685,  685,  685,  685,  685,  685,  685,  685,  716,  722,
+      717,  719,  714,  723,  720,  721,  725,  726,  685,  685,
+      685,  685,  685,  727,  728, 1131,  715,  729,  730,  724,
+      731, 1131,  732,  733,  734,  739,  735,  722,  735, 1131,
+      737,  714,  723,  603,  725,  603,  726,  738,  742,  685,
+      685,  727,  740,  728,  715,  729,  730,  724,  741,  731,
+      732,  743,  733,  734,  739,  744,  745,  736,  737,  746,
+      747, 1131,  748,  749,  604,  738,  742,  685,  750,  751,
+      752,  740,  755, 1131,  756,  757,  758,  741,  759,  760,
+      743,  761,  766,  744,  745,  763,  764,  765,  746,  747,
+
+      748,  767,  749,  768,  769,  646,  750,  646,  751,  752,
+      772,  755,  756,  773,  757,  758,  759,  774,  760,  190,
+      761,  766,  190,  763,  764,  765,  779,  780,  669,  767,
+      669,  768,  769,  672,  781,  672,  647,  782,  672,  772,
+      672,  205,  773,  673,  371,  774,  205,  674,  673,  674,
+      371,  674,  674,  212,  212,  779,  780,  801,  777,  776,
+       91, 1131,  781,  674,   91,  371,  782,  798,  799,  788,
+       91,   92,   93,  371,  802,  803, 1131,   92,   93,  371,
+      770,  833,  771,  833,  190,  801,  783,  777,  776,  179,
+      785,  834,  784,  787,  371,  179, 1131,  804,  788,  805,
+
+      806,  807,  802,  108,  803,  109,  109,  109,  109,  109,
+      109,  109,  109,  109,  109,  783,  808, 1131,  809,  785,
+      784,  810,  787,  110,  110,  804,  814,  805,  806,  807,
+      815,  816, 1131,  817,  818, 1131,  110,  851, 1131,  851,
+      770,  864,  770,  864, 1093,  808,  809,  852, 1131,  864,
+      810,  864,  110,  110,  811,  814,  811,  819,  820,  815,
+      816,  817,  821,  818,  110,  786,  786,  212,  786,  786,
+      786,  786,  786,  786,  786,  786,  786,  786,  786,  786,
+      786,  786,  786,  786,  822,  819,  820,  823,  824,  812,
+      826,  821,  825,  827,  786,  786,  786,  786,  786,  828,
+
+      829, 1131,  813,  830,  831,  735,  832,  735,  205,  835,
+      836,  837,  822,  838, 1131,  839,  823,  824,  812,  826,
+      825,  840,  827,  841,  844,  786,  786,  828,  846,  829,
+      813,  830,  831, 1131, 1131,  832,  736,  835, 1131,  836,
+      837,  845,  838,  839,  847,  770,  186,  775,  833,  840,
+      833,  841,  844,  786,  791,   77,  791,  846,  834,  792,
+      792,  842,  792,  842, 1131, 1131,  792,  792, 1095,  845,
+      792, 1131,  847,  792,  792,  792,  792,  792,  792,  792,
+      792,  792,  790,  790,  190,  790,  790,  790,  790,  790,
+      790,  790,  790,  790,  790,  790,  790,  790,  790,  790,
+
+      790,  848,  849,  205,  850,  853, 1131,  856,  858,  843,
+      857,  790,  790,  790,  790,  790,  854,  859,  854,  862,
+      865,  860,  205,  212,  863,  371,  791,   77,  791,  848,
+      873,  849,  850,  879,  853,  856,  858,  843,  874,  857,
+      866, 1131,  790,  790,  875,  876,  859,  877,  862,  865,
+      860,  855,  863,  878,  371,   91,  882,   91,  867,  873,
+      869,  879,   92,   93,   92,   93,  864,  874,  864,  866,
+      790, 1131, 1131,  875,  876, 1131,  877,  811, 1131,  811,
+      855,  871,  878,  883,  882,  872,  884,  867,  885,  869,
+      868,  868,  212,  868,  868,  868,  868,  868,  868,  868,
+
+      868,  868,  868,  868,  868,  868,  868,  868,  868,  886,
+      871,  883,  880,  888,  872,  884,  885,  887,  889,  868,
+      868,  868,  868,  868,  890,  881,  891, 1131,  892,  893,
+      894,  895,  896, 1131,  897,  898,  899,  908,  886,  900,
+      212,  880,  888,  906,  907,  887,  842,  889,  842,  910,
+      868,  868,  890,  881,  911,  891,  892,  893,  894,  895,
+      912,  896,  897,  913,  898,  899,  908,  900,  902,  903,
+      902,  906,  907,  851,  914,  851,  904,  910,  868,  905,
+      915,  917,  911,  852,  854,  918,  854,  919,  912,  920,
+      205,  924,  913,  923,  909,  371,  928, 1131,  929,  930,
+
+     1096,  931,  932,  914,  933,  934,  935,  936,  915,  937,
+      917,  938, 1131,  939,  918,  919,  940,  944,  920,  916,
+      924,  923,  909,  941,  371,  928,  929,  942,  930,  931,
+      932,  943,  933,  934,  935,  936,  945,  937,  950,  926,
+      938,  939,  946,  947,  948,  940,  944,  949,  916,  951,
+      952,  941,  902,  903,  902,  942,  953,  903,  953,  943,
+      904,  960, 1131,  905,  945,  961,  950,  926, 1131,  959,
+      964,  946,  947,  948,  962,  965,  949,  951,  952,  902,
+      903,  902,  966,  955,  956,  955,  967,  904,  968,  960,
+      905,  957,  969,  961,  958,  902,  903,  902,  959,  964,
+
+      190,  971,  962,  904,  965,  972,  905,  205,  205,  212,
+      966,  976,  977,  978,  967, 1131,  968,  979, 1131,  980,
+      981,  969,  982,  983,  984,  987,  985,  988,  985,  989,
+      971,  990,  991,  992,  972,  970,  986,  993,  994,  976,
+      977,  978,  995,  973,  975,  974,  979,  980, 1131,  981,
+      982, 1131,  983,  984,  987,  999,  988,  998,  989,  990,
+      991,  992, 1131, 1131,  970,  993,  994,  996,  903,  996,
+     1001,  995,  973,  975,  974,  955,  956,  955,  190,  955,
+      956,  955, 1000,  957,  999,  998,  958,  957, 1002,  205,
+      958,  997,  956,  997, 1003,  955,  956,  955, 1001,  904,
+
+     1004,  212,  905,  957, 1006,  205,  958,  955,  956,  955,
+     1010, 1000, 1011, 1013, 1011,  957, 1014, 1002,  958, 1131,
+     1015, 1016, 1012, 1003, 1005,  985,  985,  985,  985, 1004,
+     1017, 1018, 1006, 1019, 1007,  986,  986, 1008, 1021, 1010,
+     1020, 1013, 1022,  205,  205, 1014, 1131, 1009, 1015, 1025,
+     1016, 1131, 1005, 1023,  903, 1023, 1026, 1028, 1017, 1018,
+     1036, 1019, 1007, 1039, 1037, 1038, 1008, 1021, 1020, 1040,
+     1041, 1022, 1024,  903, 1024, 1009, 1042, 1032, 1025, 1031,
+      904,  205, 1011,  905, 1011, 1026, 1028, 1034, 1036, 1034,
+     1045, 1039, 1012, 1037, 1038, 1046,  190, 1040, 1047, 1041,
+
+     1035, 1049, 1035,  212, 1042, 1056, 1032, 1055, 1031, 1043,
+      903, 1043, 1044,  903, 1044, 1131, 1057, 1051, 1035, 1045,
+      904, 1058, 1060,  905, 1046, 1034, 1047, 1034, 1063, 1049,
+     1059,  190, 1053, 1056, 1053,  212, 1055, 1064, 1035,  205,
+     1035, 1048, 1073, 1054, 1057, 1035, 1051, 1035, 1052, 1075,
+     1058, 1060, 1061,  903, 1061, 1067, 1035, 1063, 1059, 1062,
+      903, 1062, 1053, 1035, 1053, 1064, 1072,  904, 1074, 1048,
+      905, 1073, 1079, 1054, 1068,  205, 1052, 1066, 1075, 1080,
+     1081, 1071, 1131, 1067, 1078,  903, 1078,  190,  212, 1083,
+     1131, 1086,  904, 1131, 1072,  905, 1074, 1087, 1131, 1090,
+
+     1079,  190,  205, 1068,  190, 1066, 1131, 1080, 1081, 1071,
+     1076,  903, 1076,  205, 1131, 1077, 1077, 1083, 1077, 1086,
+     1097, 1084, 1077, 1077, 1091, 1087, 1077, 1090, 1098, 1077,
+     1077, 1077, 1077, 1077, 1077, 1077, 1077, 1077, 1082, 1085,
+     1076,  903, 1076,  902,  903,  902, 1131, 1100, 1097, 1084,
+     1103,  904,  212, 1091,  905, 1099, 1108, 1098, 1101,  205,
+      212,  205, 1113, 1131,  190, 1131, 1082, 1085,  902,  903,
+      902, 1104,  205, 1088, 1088, 1100, 1089,  190, 1103,  905,
+     1088, 1088,  212, 1099, 1088, 1108, 1101, 1088, 1088, 1088,
+     1088, 1088, 1088, 1088, 1088, 1088,  902,  903,  902, 1104,
+
+      955,  956,  955, 1102,  904, 1105,  190,  905,  957, 1106,
+     1112,  958, 1109, 1107,  212, 1115, 1116,  212, 1110, 1119,
+     1120, 1119,  205, 1117, 1121, 1122, 1121, 1124, 1125, 1124,
+      205, 1102,  205, 1105, 1119, 1120, 1119, 1106, 1111, 1112,
+     1109,  205, 1107, 1115, 1116, 1131, 1114, 1110, 1121, 1122,
+     1121, 1117, 1124, 1125, 1124, 1129, 1130, 1129, 1129, 1130,
+     1129, 1131, 1131, 1131, 1127, 1131, 1126, 1111, 1118, 1131,
+     1131, 1123, 1131, 1131, 1131, 1114, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1128, 1127, 1131, 1126, 1118, 1131, 1131, 1123,
+
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1128,   66,   66,   66,   66,   66,   66,   66,   66,   66,
+       66,   66,   66,   66,   67,   67,   67,   67,   67,   67,
+       67,   67,   67,   67,   67,   67,   67,   79, 1131,   79,
+       79,   79,   79,   79,   79,   79,   79,   79,   79,   79,
+       82,   82,   82,   82,   82,   82,   82,   82,   82,   82,
+       82,   82,   82,   86,   86,   86,   86,   86,   86,   86,
+       86,   86,   86,   86,   86,   86,   90,   90,   90,   90,
+       90,   90,   90,   90,   90,   90,   90,   90,   90,  113,
+
+      113,  113,  113,  113,  113,  113,  113,  113,  189,  189,
+      189,  189,  189,  189,  189,  189,  189,  189,  189,  189,
+      189,  204,  204,  204,  204,  204,  204,  204,  204,  204,
+      204,  204,  204,  204,  210,  210,  210,  210,  210, 1131,
+      210,  210,  210, 1131,  210, 1131,  210,  231,  231,  231,
+      231,  231,  231,  231,  231,  231,  231,  231,  231,  231,
+       99, 1131, 1131, 1131, 1131, 1131, 1131, 1131,   99,  249,
+      249, 1131,  249,  249, 1131,  249, 1131, 1131,  249,  249,
+     1131,  249,  336,  336,  336,  336,  340,  340,  340,  340,
+      340,  340,  340,  340,  340,  340,  340,  340,  340,  365,
+
+      365,  365,  365,  365,  365,  365,  365,  365,  365,  365,
+      365,  365,  371,  371,  371,  371,  371,  371,  371,  371,
+      371,  371,  371,  371,  371,  601,  601,  601, 1131,  601,
+      601,  601,  601,  601,  601,  601,  601,  601,  685, 1131,
+      685,  685,  685,  685,  685,  685,  685,  685,  685,  685,
+      685,  688, 1131,  688,  688,  688,  688,  688,  688,  688,
+      688,  688,  688,  688,  690,  690,  690,  690,  690,  690,
+      690,  690,  690,  690,  690,  690,  690,  693,  693,  693,
+      693,  693,  693,  693,  693,  693,  693,  693,  693,  693,
+      695,  695,  695,  695,  695,  695,  695,  695,  695,  695,
+
+      695,  695,  695,  702, 1131,  702,  702,  702,  702,  702,
+      702,  702,  702,  702,  702,  702,  778,  778,  778,  778,
+      778,  778,  778,  778,  778,  778,  778,  778,  778,  786,
+      786,  786,  786,  786,  786,  786,  786,  786,  786,  786,
+      786,  786,  789,  789,  789,  789,  789,  789,  789,  789,
+      789,  789,  789,  789,  789,  790, 1131,  790,  790,  790,
+      790,  790,  790,  790,  790,  790,  790,  790,  793, 1131,
+      793,  793,  793,  793,  793,  793,  793,  793,  793,  793,
+      793,  794,  794,  794,  794,  794,  794,  794,  794,  794,
+      794,  794,  794,  794,  796,  796,  796,  796,  796,  796,
+
+      796,  796,  796,  796,  796,  796,  796,  797,  797,  797,
+      797,  797,  797,  797,  797,  797,  797,  797,  797,  797,
+      800, 1131,  800,  800,  800,  800,  800,  800,  800,  800,
+      800,  800,  800,  861,  861,  861,  861,  861,  861,  861,
+      861,  861,  861,  861,  861,  861,  868,  868,  868,  868,
+      868,  868,  868,  868,  868,  868,  868,  868,  868,  870,
+      870,  870,  870,  870,  870,  870,  870,  870,  870,  870,
+      870,  870,  901,  901,  901,  901,  901,  901,  901,  901,
+      901,  901,  901,  901,  901,  954,  954,  954,  954,  954,
+      954,  954,  954,  954,  954,  954,  954,  954, 1069, 1069,
+
+     1069, 1069, 1069, 1069, 1069, 1069, 1069, 1069, 1069, 1069,
+     1069,   13, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+
+     1131
     } ;
 
-static yyconst flex_int16_t yy_chk[9249] =
+static yyconst flex_int16_t yy_chk[4102] =
     {   0,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
@@ -8737,77 +7708,94 @@
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    2,
-        2,    2,    2,   10,    8,    8,    8,    8,   15,   15,
-
-       15,   68, 1129,   14,   10, 1119,   68,    2,    2,    2,
-        2,    2,    2,    2,    2,    2,    2,   14,   16,   16,
-       16,   54,   54,   54,    2,    2,   18,   10,    2,   19,
-        2,    8,   14,   17,   17,   17,   15,   20,   21, 1096,
-       18,    2,    2,  176,   22,   14, 1084,   25,   26,  176,
-       15,   20,   21,    2,    2,   18,   10,    2,   75,    2,
-        8,   25,   42,   19,   69,   15,   20,   21,   18,    2,
-        2,   17,   24,   27,   26,   23,   25,   19,   15,   20,
-       21,   22,   23,   23,   29,   17,   75,   27,   26,   25,
-     1045,   42,   19,   24,  959,   22,   30,  339,   74,  339,
-
-       17,   82,   27,   26,  340,   19,  340,   24,   83,   69,
-       22,   29,   23,   17,   31,   27,   26,   32,   30,   34,
-       41,  178,   24,   22,  916,   29,   23,   74,   31,  912,
-       82,   32,   30,   34,   41,   24,   83,   69,   49,  685,
-       29,   23,   49,   31,  905,  685,   32,   30,   34,   41,
-      178,  207,   33,   29,   23,   28,   31,   28,   33,   32,
-       30,   34,   41,   76,   76,   76,  242,   49,   67,   67,
-       67,   49,   33,   28,   28,   28,   28,   28,   28,   28,
-       28,   28,   28,   86,   43,   63,  207,   33,   28,   43,
-       44,  350,   28,   28,   28,  242,   43,   43,  904,   28,
-
-       33,   28,   28,   63,   44,   67,   91,   28,   77,   77,
-       77,   28,   86,   43,   63,  207,  837,   28,   43,   44,
-      350,   28,   28,   28,   43,   43,   87,   28,  360,   28,
-       28,   63,   44,  835,   67,   28,   78,   78,   78,   28,
-       35,   86,   35,   35,   35,   35,   35,   35,   35,   35,
-       35,   35,   38,   40,  830,   91,   38,  360,   35,   35,
-       38,   40,   35,  903,   40,  102,   38,   40,   35,  103,
-       38,  107,   87,   40,   90,   35,   35,   79,   79,   79,
-      825,   38,   40,   91,  342,   38,  342,   35,   35,   38,
-       40,   35,   40,  102,   38,   40,   35,  103,   38,  107,
-
-       87,   40,  108,   35,   35,   36,   90,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,  179,   37,  359,
-       39,  359,   36,  903,  823,   37,   45,   36,  822,   37,
-      108,   39,   37,   39,   45,   90,   39,   39,   46,  205,
-       45,   36,   37,   39,  812,  179,   46,   37,  393,   39,
-      180,   36,   46,  182,   37,   45,   36,   37,   46,   39,
-       37,   39,   48,   45,   39,   39,   51,   46,   45,   36,
-       37,   39,   47,   51,  811,   46,   48,  393,  180,   48,
-       46,  182,   48,   51,  205,   47,   46,   47,  104,   50,
-      220,   48,   47,   50,  529,   51,  529,   50,  396,   52,
-
-      450,   47,   51,  104,   48,   50,   52,   48,   50,   50,
-       48,   51,  205,   47,  532,   47,   52,  104,   50,  804,
-       47,  220,   50,   80,   80,   80,   50,  396,   52,  450,
-      530,  104,  530,   50,   92,   52,   50,   50,   55,   55,
-       55,   92,   92,  532,   52,   53,   53,   53,   53,  220,
-       56,  223,  531,   53,  531,   56,   55,   55,   55,   55,
-       55,   55,   55,   55,   55,   55,  184,  184,  184,   94,
-       70,   70,   70,   71,   71,   71,   94,   94,   60,  223,
-       53,   53,   70,   53,   53,   71,   53,   56,  726,   60,
-      106,  191,   60,  686,   93,   93,   93,   53,   53,  686,
-
-      106,   56,   93,   93,  181,   70,  725,   60,   71,   53,
-       53,  181,   53,   53,  723,   53,   56,   60,  722,  106,
-       60,   72,   72,   72,  910,   53,   53,  214,  106,   56,
-       57,   58,  181,   72,   70,   96,   57,   71,  222,  181,
-      191,  716,   96,   96,   57,  189,   57,   57,   57,   57,
-       57,   57,   57,   57,   57,   57,   59,  222,   58,   72,
-       59,  208,  208,  208,   59,   58,   57,   96,  191,   58,
-       59,  190,   58,   72,   59,  714,  214,  189,   61,  206,
-       57,  706,   58,   61,  910,   59,  222,   58,   72,   59,
-       61,   61,   62,   59,   58,   57,   96,   58,   59,   62,
-
-       58,   72,   59,  190,  214,  224,  189,   61,   57,   62,
-       58,  206,   61,  210,  210,  210,   62,  689,   61,   61,
-      664,   62,  225,  225,  225,  585,  580,  232,   62,  578,
-      558,  235,  190,  224,  232,  232,  554,   62,  235,  235,
-      206,  372,  372,  372,   62,   73,   73,   73,   73,   73,
+        2,    2,    2,   74,    8,    8,    8,    8,   10,   15,
+
+       15,   15, 1083,   14,   16,   16,   16,    2,    2,    2,
+        2,    2,    2,    2,    2,    2,    2,   14,   70,   17,
+     1081,   10,   74,   70,    2,    2,   71,   75,    2,    8,
+        2,    8,   14,   17,   18,   19,   21,   15,   20,   22,
+      551,    2,    2,  551, 1069,   14,   22,   22,   17,   19,
+       10,   15,   20,    2,    2,   75,   80,    2,    8,    2,
+        8,   17,   84,   23,   19,   30,   15,   20,   18,    2,
+        2,   71,   24,   21,   26,   30,   22,   19,   81,   15,
+       20,   25,   18,  116,   23,   80,   24,   21,   26,   30,
+       22,   84,   28,   85,  100,   31, 1051,   18,   23,   71,
+
+      624,   24,   21,   26,   30,   22,   81,   25,  624,   31,
+       18,   32,  116,   23,   24,   21,   26,   30,   22,   28,
+       84,   25,  100, 1047,   31,   32,   23,   56,   56,   56,
+       76,   76,   76,   28,  101,  105,   25,   31,  106,   85,
+       32,  179,   69,   69,   69,   33, 1006,  179,   28,   25,
+       27,   33,   27,   32,   77,   77,   77,   78,   78,   78,
+     1000,   28,  101,  105,  914,   33,  106,   85,   27,   27,
+       27,   27,   27,   27,   27,   27,   27,   27,   34,   69,
+       33,   35,   35,   27,  120,   35,   41,   27,   27,   27,
+      868,   35,   34,   33,   27,   41,   27,   27,   35,   35,
+
+       41,  862,   27,  123,   89,  861,   27,   34,   69,  796,
+       35,   35,   27,  120,   35,   41,   27,   27,   27,   35,
+       34,  114,   27,   41,   27,   27,   35,   35,   41,   88,
+       27,   36,  123,   42,   27,   29,   36,   29,   29,   29,
+       29,   29,   29,   29,   29,   29,   29,   42,  794,  114,
+       36,   90,  337,   89,  337,   29,   29,   29,   90,   90,
+       36,   88,   42,  115,  117,   36,  104,  786,   29,  121,
+      122,   29,  126,   44,  109,   42,  104,   54,   36,   38,
+       38,   89,   44,   38,   29,   29,   29,   44,  109,   38,
+       88,  115,  117,   38,   38,  104,   29,  121,  122,   29,
+
+       37,  126,   44,  109,  104,   37,   54,   37,   38,   38,
+       44,   37,   38,  785,   37,   44,  109,   38,   92,   37,
+       54,   38,   38,  778,   37,   92,   92,  660,  777,   37,
+      186,  186,  186,  660,   37,   54,   37,   43,  693,   37,
+      132,   45,   37,  692,   43,   43,   45,   37,   54,   45,
+      690,   43,   37,   39,  625,   45,   72,   72,   72,   39,
+       45,   39,   39,  625,   39,   39,   43,   39,   72,  132,
+       45,   39,   43,   43,  124,   45,  102,  689,   45,   43,
+      689,  678,   39,   45,  211,  211,  211,   39,   45,   39,
+       39,  102,   39,   39,   72,   39,  119,   49,   49,   39,
+
+       40,  664,  124,   40,  635,  102,   40,   40,   72,   40,
+       46,  753,   49,  119,   40,   40,  128,  143,   46,  102,
+      753,   46,   46,   72,   46,  119,   49,   49,  118,   40,
+       46,  558,   40,  103,   40,   40,   72,   40,  118,   46,
+       49,  119,   40,   40,  128,   47,  143,   46,  103,   46,
+       46,   48,   46,   47,  129,   47,   48,  118,   46,   47,
+       47,   52,  103,  130,  131,   48,  118,  133,   48,   52,
+       48,   48,  661,  553,   47,   52,  103,  534,  661,  134,
+       48,   47,  129,   47,  519,   48,  135,   47,   47,  137,
+       52,  130,  131,   48,   95,  133,   48,   52,   48,   48,
+
+       50,   95,   95,   52,   50,   50,   51,  134,   50,  496,
+       53,   51,   53,   51,  135,  487,   50,  137,  139,   50,
+       50,  140,   53,   51,   53,   51,  224,  224,  224,   50,
+      401,  399,  146,   50,   50,   51,  141,   50,  144,   53,
+       51,   53,   51,   95,   50,   60,  139,   50,   50,  140,
+       53,   51,   53,   51,   55,   55,   55,   55,   57,   57,
+       58,  146,   55,  392,  141,   58,  144,  338,  138,  338,
+      147,   95,   60,  390,  138,   57,   57,   57,   57,   57,
+       57,   57,   57,   57,   57,  148,   60,  149,  159,   55,
+       55,   65,   55,   55,   62,   55,  138,   58,  147,   65,
+
+       62,   60,  138,   62,   65,   65,   55,   55,   62,  365,
+      150,   58,  362,  148,   60,  340,  149,  159,   55,   55,
+       65,   55,   55,   62,   55,  151,   58,   65,   62,  336,
+      247,   62,   65,   65,   55,   55,   62,   63,  150,   58,
+       59,   91,   91,   91,   63,   63,   59,  244,  243,   91,
+       91,   63,  242,  151,   59,  241,   59,   59,   59,   59,
+       59,   59,   59,   59,   59,   59,   63,   99,   99,  142,
+       94,  142,   63,   63,   59,   59,   59,   94,   94,   63,
+       99,  152,  125,  125,  153,  154,  155,   59,  125,  157,
+       59,  161,  213,  511,  163,  511,   99,   99,  164,  210,
+
+      166,  127,   94,   59,   59,   59,  127,  170,   99,  152,
+      125,  125,  153,  154,  155,   59,  125,  157,   59,   61,
+      161,  142,  163,   61,   61,  204,  164,   61,  166,  860,
+      127,   94,  189,   61,  182,  127,  170,   61,   61,  158,
+       64,  178,  158,  136,  165,   64,  145,   64,   61,  142,
+      136,  165,   61,   61,  136,  171,   61,   64,  145,   64,
+      145,   61,  182,  145,   64,   61,   61,  158,   87,   64,
+      158,   86,  136,  165,   64,  145,   64,   82,  136,  165,
+       67,  512,  136,  512,  171,   64,  145,   64,  145,  860,
+       13,  145,   64,   73,   73,   73,   73,   73,   73,   73,
+
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
@@ -8815,934 +7803,352 @@
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
        73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   97,  101,  101,  105,  204,  204,
-      204,   97,   97,  226,  538,  227,  213,  675,  101,  675,
-      534,  111,  105,  111,  111,  111,  111,  111,  111,  111,
-      111,  111,  111,  421,  101,  101,  105,  375,  375,  375,
-      419,  226,  173,  227,  173,  204,  101,  114,  213,  534,
-      105,  219,  412,   97,  113,  113,  113,  113,  113,  113,
-      113,  113,  113,  113,  114,  228,  115,  118,  219,  114,
-
-      116,  115,  118,  125,  204,  116,  410,  213,  125,  231,
-      173,   97,  100,  114,  100,  115,  118,  229,  116,  116,
-      386,  221,  125,  114,  173,  115,  118,  219,  114,  116,
-      115,  118,  125,  379,  116,  228,  249,  125,  230,  173,
-      374,  114,  251,  115,  118,  100,  116,  116,  117,  100,
-      125,  100,  173,  117,  243,  221,  100,  276,  100,  100,
-      248,  231,  117,  228,  249,  401,  229,  117,  100,  294,
-      251,  294,  401,  401,  100,  371,  343,  117,  100,  294,
-      100,  230,  117,  221,  100,  276,  100,  100,  535,  231,
-      117,  250,  243,  248,  229,  117,  100,  110,  110,  110,
-
-      110,  110,  110,  110,  110,  110,  110,  119,  121,  230,
-      913,  247,  119,  121,  120,  110,  110,  535,  119,  120,
-      243,  248,  120,  246,  400,  121,  119,  121,  110,  245,
-      233,  233,  233,  120,  341,  277,  119,  121,  233,  233,
-      344,  119,  121,  120,  110,  110,  119,  122,  120,  122,
-      244,  120,  122,  121,  119,  121,  110,  177,  123,  218,
-      400,  120,  341,  123,  212,  345,  122,  346,  344,  354,
-      913,  177,  277,  347,  209,  123,  122,  123,  122,  124,
-      202,  122,  348,  126,  124,  187,  177,  123,  126,  400,
-      124,  349,  123,  345,  122,  346,  183,  126,  124,  177,
-
-      277,  347,  126,  123,  676,  123,  676,  354,  124,  127,
-      348,  175,  126,  124,  127,  174,  237,  126,  124,  349,
-       89,  127,  127,  237,  237,  126,  124,  127,  127,  128,
-      126,  128,  129,  389,  128,  130,  354,  129,  127,  292,
-      130,  292,  361,  127,  234,  234,  234,  130,  128,  127,
-      127,  129,  234,  234,  130,  127,  127,  536,  128,  237,
-      128,  129,   88,  128,  130,  388,  129,   84,  389,  130,
-      361,  380,  380,  380,  356,  130,  128,   65,   13,  129,
-      378,  238,  130,  131,  355,  131,  536,  237,  238,  238,
-      369,  292, 1051,  388,  390,  133,  389,  392,    9,  131,
-
-      133,  131,  131,  131,  131,  131,  131,  131,  131,  131,
-      131,  132, 1081,  133,  133,  134,  132,    7,  134,  292,
-      134,  388,  132,  398,  133,  392,  356,  355,  369,  133,
-      132,  390,  378,  238,  134,  677,  131,  677,  131, 1130,
-      132,  133,  133,  381,  134,  132,  136,  134,  135,  134,
-      132,  136, 1051,  135,  356,  355,  398,  369,  132,  390,
-      378,  238,  134,  136,  131,  136,  131,  135,  135,  139,
-      377,  137, 1081,  138,  139,  136,  137,  135,  138,  137,
-      136,  381,  135,  139,  138,  398,  137,  395,  139,    0,
-      137,  136,  138,  136,  418,  135,  135,  397,  139, 1130,
-
-      137,  382,  138,  139,  140,  137,  475,  138,  137,  140,
-      381,  139,  138,  377,  137,  395,  139,  142,  137,  142,
-      138,  140,  418,  140,  141,  399,  143,  144,  143,  141,
-     1131,  537,  144,  140,  475,    0,  143,  141,  140,  391,
-      533,  377,  144,  141,  397,  382,  144,    0,  543,  140,
-      142,  140,  466,  141,  466,  142,  144,  146,  141,  143,
-      537,  144,  146,  146,  143,  141,    0,  391,  533,  142,
-      144,  141,  397,  382,  144,  399,  146,    0,  143,  142,
-      145,    0,  145,  466,  142,  145,  146,  680,  143,  680,
-     1131,  146,  146,  143,  145,  391,  145,  142,  543,  145,
-
-      147,    0,  148,  399,  146,  147,  143,  148,  557,  145,
-      484,  145,  484,  546,  145,  148,  394,  394,  394,  147,
-      484,  148,  145,  147,  145,  149,  543,  145,  149,  147,
-      149,  148,  572,  150,  147, 1148,  148,  151,  150,    0,
-        0,  546,  151,  148,  149,  150,  547,  147,    0,  148,
-      151,  147,  150,  557,  149,    0,  151,  149,    0,  149,
-      544,  572,  150,  152,  153,    0,  151,  150,  152,  153,
-        0,  151,  149,  150,  547,  153,  152,  488,  151,  488,
-      150,  557,  152,  153,  151,    0,  155,  488,    0,  154,
-      155,  155,  152,  153,  154, 1148,  544,  152,  153,  521,
-
-      154,  521,    0,  153,  152,  155,  611,    0,  154,  521,
-      152,  153,  156,  253,  253,  155,  158,  156,  154,  155,
-      155,  158,  402,  154,  158,  544,  253,    0,  154,  402,
-      402,  156,  157,  155,  611,  158,  154,  157,  559,  559,
-      559,  156,  253,  253,    0,  158,  156,  612,    0,  157,
-      158,  157,  157,  158,  253,  160,  160,  159,    0,  156,
-      160,  157,  159,  158,  614,  159,  157,  370,  370,  370,
-      615,  159,  402,  561,  160,  612,  159,  157,    0,  157,
-      157,  194,  162,  194,  160,  160,  159,  162,  161,  160,
-      161,  159,  614,  161,  159,  556,  556,  556,  615,  159,
-
-      402,  162,  160,  162,  159,    0,  161,  161,  370,  542,
-      161,  162,  575,  163,  194,  564,  162,  161,  163,  161,
-      164,  555,  161,  561,  163,  164,  164,  563,  194,  162,
-        0,  162,  163,  164,  161,  161,  556,  370,  161,  164,
-      165,  575,  163,  194,  568,  165,  692,  163,  692,  164,
-      617,  561,  163,  562,  164,  164,  194,  165,  542,  165,
-      163,  164,  564,  166,  403,  556,  682,  164,  166,  165,
-      555,  403,  403,  577,  165,  569,  563,  166,  617,  568,
-      166,    0,  166,  167,  167,  165,  542,  165,  167,  562,
-      564,  697,  166,  697,  682,  167,  569,  166,  555,  744,
-
-      403,    0,  167,  570,  563,  166,  577,  568,  166,  168,
-      166,  579,  167,  167,  168,  169,    0,  167,  562,  169,
-      169,    0,  168,  167,  570,  569,  168,  744,  168,  403,
-      167,  571,  170,    0,  169,  577,  753,  170,  168,    0,
-      170,  171,    0,  168,  169,  171,  171,  579,  169,  169,
-      168,  170,  571,  570,  168,    0,  168,  574,  574,  574,
-      171,  170,  169,  172,  753,  581,  170,  604,  172,  170,
-      171,  172,  581,  581,  171,  171,  579,  582,  613,  170,
-      618,  571,  172,  687,  582,  582,    0,    0,  171,  678,
-        0,  678,  172,  185,  185,  185,  604,  172,  756,  678,
-
-      172,  581,  679,  635,  815,  635,  815,  613,  757,  618,
-      172,  185,  185,  185,  185,  185,  185,  185,  185,  185,
-      185,  186,  681,  687,    0,  678,  756,  186,  713,    0,
-      581,  679,  691,  608,  635,  608,  757,  186,  186,  186,
-      186,  186,  186,  186,  186,  186,  186,  192,  683,  713,
-      683,  681,  687,  192,  678,  684,  684,  684,  683,    0,
-      703,  691,  683,  192,  192,  192,  192,  192,  192,  192,
-      192,  192,  192,  193,  608,  215,  215,  215,  713,  193,
-      708,  708,  708,  748,  826,  826,  826,  193,  608,  193,
-      193,  193,  193,  193,  193,  193,  193,  193,  193,  195,
-
-      703,  196,  197,  608,  195,  749,  196,  197,  215,    0,
-      195,  616,  748,  196,  196,  688,  608,  195,  195,  196,
-      196,  197,  215,  832,  832,  832,  704,  616,  195,  703,
-      196,  197,  707,  195,  749,  196,  197,  215,  195,  198,
-      616,  196,  196,    0,  198,  195,  195,  196,  196,  197,
-      215,  688,  702,  198,  702,  616,  200,    0,  198,  201,
-      199,  200,  199,  201,  201,  199,  702,  755,  198,  758,
-        0,  200,  707,  198,  199,  200,  199,  704,  201,  199,
-      688,  198,  759,  807,    0,  200,  198,    0,  201,  199,
-      200,  199,  201,  201,  199,  216,  755,    0,  758,  200,
-
-        0,  707,  199,  200,  199,  704,  201,  199,    0,    0,
-      759,  807,  216,  216,  216,  216,  216,  216,  216,  216,
-      216,  216,  217,  217,  217,  217,  217,  217,  217,  217,
+       73,   73,   98,  110,   98,  110,    7,  156,  110,  110,
+      110,  110,  110,  110,  110,  110,  110,  110,  160,  366,
+
+      366,  366,  156,  183,  160,  172,  528,  168,  528,  169,
+      173,  174,    0,  169,  173,   98,  156,  185,  168,   98,
+      181,   98,  866,  530,  196,  530,   98,  160,   98,   98,
+      156,  183,  160,  162,  172,  162,  168,  169,   98,  173,
+      174,  169,    0,  173,   98,  185,  168,    0,   98,  181,
+       98,  162,  162,  196,   98,  162,   98,   98,  176,  199,
+      176,    0,  162,  191,  162,    0,   98,  108,  108,  108,
+      108,  108,  108,  108,  108,  108,  108,  167,  180,  162,
+      162,  184,  866,  162,  203,  108,  108,  199,  184,  192,
+      200,  167,  180,  193,  167,  191,  176,  231,  108,  202,
+
+        0,  207,  215,    0,  231,  231,  167,  180,    0,  184,
+      176,  187,  187,  203,  108,  108,  184,  208,  200,  167,
+      180,  192,  167,    0,  191,  176,  108,  202,  187,  187,
+      187,  187,  187,  187,  187,  187,  187,  187,  176,  188,
+      197,  651,  193,  651,  239,  188,  207,  197,  222,  208,
+      192,  215,  223,    0,    0,  188,  188,  188,  188,  188,
+      188,  188,  188,  188,  188,  194,  198,  198,  197,  214,
+      193,  194,  198,  239,  207,  197,  222,    0,  208,  215,
+      223,  194,  194,  194,  194,  194,  194,  194,  194,  194,
+      194,  195,  209,  225,  198,  198,  216,  195,    0,  240,
+
+      198,  214,  206,  206,  206,  195,  201,  195,  195,  195,
+      195,  195,  195,  195,  195,  195,  195,  226,  201,  246,
+      201,  225,  227,  201,  229,  195,  195,  209,  216,  221,
+      214,  221,    0,    0,  258,  201,  234,  240,  195,  206,
+      230,    0,  228,  234,  234,  226,  201,  246,  201,    0,
+      652,  201,  652,    0,  195,  195,  209,  216,  221,    0,
+      221,  245,  227,  258,    0,  240,  195,  229,  206,  217,
       217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  239,    0,  239,  860,  760,  239,  239,  239,  239,
-      239,  239,  239,  239,  239,  239,  240,    0,  240,  863,
-      805,  240,  240,  240,  240,  240,  240,  240,  240,  240,
-      240,  241,  860,  241,  760,  806,  241,  241,  241,  241,
-      241,  241,  241,  241,  241,  241,  254,  863,  254,  805,
-        0,  254,  254,  254,  254,  254,  254,  254,  254,  254,
-      254,  255,    0,  255,  806,    0,  255,  255,  255,  255,
-      255,  255,  255,  255,  255,  255,  256,  808,  256,  259,
-      865,  256,  256,  256,  256,  256,  256,  256,  256,  256,
-
-      256,  257,  257,  257,  257,  257,  257,  257,  257,  257,
-      257,    0,  259,  769,  260,  769,  808,  259,  865,  260,
-      257,  258,  258,  258,  258,  258,  258,  258,  258,  258,
-      258,  259,  260,  260,  261,  813,  901,  262,  901,  261,
-      258,  259,  262,  260,  769,  261,  259,  727,  260,  257,
-      908,  262,  908,  261,  727,  727,  262,  263,  705,  259,
-      260,  260,  263,  261,  813,  693,  262,  693,  261,  258,
-      263,  262,    0,  261,    0,  693,  263,  264,  266,  262,
-      265,  261,  264,  266,  262,  265,  263,  803,  266,  803,
-      264,  263,    0,    0,  705,  803,  264,  266,  263,  265,
-
-      265,  693,  851,  268,  263,  810,  264,  266,  268,  265,
-      267,  264,  266,    0,  265,  267,  266,    0,  264,    0,
-      268,  267,  268,  705,  264,  266,    0,  265,  265,  267,
-      693,  851,  268,  269,    0,  271,  821,  268,  269,  267,
-      271,  270,  810,    0,  267,  700,  270,  700,  268,  267,
-      268,  269,  269,  270,  271,  700,  270,  267,  272,  700,
-      270,    0,  269,  272,  271,  272,  728,  269,    0,  271,
-      270,  810,  821,  728,  728,  270,    0,  272,  273,  269,
-      269,  270,  271,  273,  270,  274,    0,  272,  270,  273,
-      274,  729,  272,  794,  272,  794,  274,  273,  729,  729,
-
-        0,  821,    0,  794,  274,  272,    0,  273,  278,  278,
-      857,  275,  273,  278,  274,  275,  275,  273,  900,  274,
-      859,  809,  809,  809,  274,  273,  820,  278,  279,  809,
-      275,  280,  274,  279,  824,  279,  280,  278,  278,  857,
-      275,  284,  278,  284,  275,  275,  900,  279,  281,  859,
-      280,  861,  281,  281,    0,  278,  862,  279,  275,  864,
-      280,  925,  279,  820,  279,  280,    0,  281,  283,    0,
-        0,  824,  284,  283,  284,  279,  283,  281,  280,  284,
-      861,  281,  281,  838,  875,  862,  875,  283,  864,  925,
-      838,  838,  820,  284,  875,  281,  282,  283,  282,  285,
-
-      824,  894,  283,  284,  285,  283,  286,  899,  284,  422,
-      422,  286,  839,  902,  893,  283,  893,  285,  285,  839,
-      839,  284,  422,    0,  893,  286,    0,  282,  285,  282,
-      894,  911,  282,  285,  282,  286,  899,  282,  422,  422,
-      286,  282,  902,    0,  282,  285,  285,  282,  282,  289,
-      422,  282,  287,  286,  289,  288,  287,  287,  282,  288,
-      288,  282,  934,  282,  937,  884,  282,  884,  289,  282,
-        0,  287,  282,    0,  288,  282,  282,  926,  289,  282,
-      911,  287,  290,  289,  288,  287,  287,  290,  288,  288,
-      291,  934,  291,  937,  290,  291,  289,  929,  293,  287,
-
-      931,  290,  288,  293,  896,  926,  896,  932,  911,  291,
-        0,  290,  293,  884,    0,  296,  290,  293,  933,  291,
-      296,  291,  290,  935,  291,  929,  296,  293,  931,  290,
-      961,  297,  293,    0,  296,  932,  297,  291,  298,  896,
-      293,  884,  297,  298,  296,  293,  933,    0,  954,  296,
-      297,  935,    0,  964,  296,    0,    0,  298,  298,  961,
-      297,  299,  296,    0,    0,  297,  299,  298,  896,  965,
-      297,  980,  298,  948,  948,  948,  954,  966,  297,  972,
-      299,  299,  964,  300,  301,  298,  298,  300,  300,  301,
-      299,  302,  301,  302,  303,  299,  303,  965,  967,  980,
-
-      300,  302,  300,  301,  303,  968,  966,  968,  299,  299,
-        0,    0,  300,  301,  989,  972,  300,  300,  301,  990,
-      304,  301,  973,  981,  302,  304,  984,  303,  300,  302,
-      300,  301,  303,  967,  968,  302,  968,    0,  303,  304,
-      304,  986,  989,  302,  972,  302,  303,  990,  303,  304,
-     1005,    0,  981,  302,  304,  984,  303,    0,  302,  973,
-      305,  303,  967,  302,  305,  305,  303,  304,  304,  987,
-      986,  302,  306,  302,  303,  988,  303,  306, 1005,  305,
-      307,  308, 1008, 1016,  307,  307,  308,    0,  973,  305,
-     1010,  306,  308,  305,  305,    0,    0,  309,  987,  307,
-
-      308,  306,  309, 1015,  988,    0,  306,  305,    0,  307,
-      308, 1008, 1013,  307,  307,  308,  309,  310, 1010,  306,
-      308,  309,  310,  998,  998,  998,  309,  307,  308, 1016,
-      310,  309, 1015,  311,  312,    0,  310,  313,  311,  312,
-     1013,  311,  313,  852,  309,  852,  310, 1017,    0,  309,
-        0,  310,  311,  312,  314,    0,  313, 1016,  310,  314,
-     1018,    0,  311,  312,  310, 1028,  313,  311,  312, 1027,
-      311,  313,  314,  314,  315,    0, 1017,  316,  852,  315,
-      311,  312,  316,  314,  313, 1022, 1032,  315,  314, 1018,
-      316,  852, 1034,  315, 1028,    0,  316, 1027,  316, 1036,
-
-      314,  314, 1021,  315,  317, 1023,  316,  852,  315,  317,
-      317,  316,    0,    0, 1032,  315, 1043, 1022,  316,  852,
-     1034,  315, 1049,  317,  316,  318,  316, 1036,    0,  319,
-      318,    0,  319,  317,  319,    0,  318,  320,  317,  317,
-      319, 1023,  320,    0,  318, 1043, 1022, 1021,  319, 1046,
-     1049,  317,    0, 1024,  318, 1053,  320,  320,  319,  318,
-      321,  319,  322,  319,  318,  321,  320,  322,  319,  323,
-     1023,  320,  318, 1052,  323, 1021,  319,  323, 1046,  321,
-      321,  322,  322, 1053,  320,  320,    0,    0,  323,  321,
-        0,  322,  326, 1024,  321,  324,  322,  326,  323,  324,
-
-      324,    0, 1052,  323, 1060,  326,  323,  321,  321,  322,
-      322,  326,  328,    0,  324,  325,  323,  328,  327,  325,
-      325,  326, 1024,  327,  324,  327,  326, 1061,  324,  324,
-     1058,  328, 1060,  326,  325,    0, 1055,  327,  329,  326,
-        0,  328,  324,  329,  325,  330,  328,  327,  325,  325,
-      330, 1057,  327,  332,  327,  332, 1061,  329,    0,  328,
-      330,  331,  325,  332,  330,  327,  331,  329, 1041, 1041,
-     1041, 1055,  329,    0,  330, 1058, 1064,    0,  331,  330,
-      331, 1066,  333, 1056, 1057,  329,  332,  333,  330,  333,
-      331,  332,  330,  334, 1072,  331,    0, 1074,  334,  334,
-
-     1055,  333,  336, 1058, 1064,  332,  331,  336,  331, 1076,
-     1066,  333,  334, 1057,  336,  332,  333, 1056,  333,  335,
-      332,  336,  334, 1072,  335, 1074, 1078,  334,  334,  333,
-        0,  336,  335,  332,    0,    0,  336, 1076,  335,  337,
-      334, 1085,  336,    0,  337,  338, 1056, 1094,  335,  336,
-      338,    0,  974,  335, 1078, 1086,  337, 1090,  337, 1083,
-      335,  876,  876,  876,  338,    0,  335,    0,  337,  876,
-     1085, 1082,  876,  337,  338,  351, 1094,  351,    0,  338,
-      946,  946,  946, 1086,  337, 1090,  337,  974,  946,  974,
-        0,  946,  338,  351,  351,  351,  351,  351,  351,  351,
-
-      351,  351,  351,  352,  947,  947,  947, 1082,    0,  352,
-        0, 1083,  947,    0, 1077,  947,  974,    0,  974,  352,
-      352,  352,  352,  352,  352,  352,  352,  352,  352,  353,
-      949,  949,  949,    0,    0,  353, 1082, 1098,  949, 1083,
-        0,  949, 1070, 1070, 1070,  353,  353,  353,  353,  353,
-      353,  353,  353,  353,  353,  357, 1092, 1092, 1092, 1077,
-     1099,  357,  362,  363,    0,  364,  362,  362,  363,  357,
-      364,  357,  357,  357,  357,  357,  357,  357,  357,  357,
-      357,  362,  363, 1098,  364,  365,  365, 1077, 1099, 1103,
-      365,  362,  363,  368,  364,  362,  362,  363, 1104,  364,
-
-        0,  366,    0,    0,  365,  366,  366,    0,    0,  362,
-      363, 1098,  364, 1111,  365,  365, 1107, 1103,  366,  365,
-      366,  367,    0,  433,  368,  367,  367, 1104,  433,  368,
-      366, 1100,  365,    0,  366,  366,  950,  950,  950, 1113,
-      367, 1111,  433,  368,  950, 1107,  366,  950,  366,    0,
-      367, 1116,  433,  368,  367,  367,  383,  433,  368,    0,
-        0,  999,  999,  999,    0,    0, 1100, 1113,  367,  999,
-      433,  368,  999,  383,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  384,    0, 1000, 1000, 1000, 1101, 1101,
-     1101,    0,  383, 1000, 1121, 1100, 1000, 1116, 1127,    0,
-
-      384,  384,  384,  384,  384,  384,  384,  384,  384,  384,
-      387,    0, 1001, 1001, 1001, 1117, 1117, 1117, 1136,  384,
-     1001,  383, 1121, 1001,    0, 1116, 1127,  387,  387,  387,
-      387,  387,  387,  387,  387,  387,  387,  404,  404,  404,
-      404,  404,  404,  404,  404,  404,  404, 1136,  384,  405,
-      405,  405,  405,  405,  405,  405,  405,  405,  405,  406,
-      406,  406,  406,  406,  406,  406,  406,  406,  406,  407,
-      407,  407,  407,  407,  407,  407,  407,  407,  407,  408,
-      408,  408,  408,  408,  408,  408,  408,  408,  408,  409,
-      409,  409,  409,  409,  409,  409,  409,  409,  409,  423,
-
-      423,  423,  423,  423,  423,  423,  423,  423,  423,  424,
-      424,  424,  424,  424,  424,  424,  424,  424,  424,  425,
-      425,  425,  425,  425,  425,  425,  425,  425,  425,  426,
-      426,  426,  426,  426,  426,  426,  426,  426,  426,  427,
-      427,  427,  427,  427,  427,  427,  427,  427,  427,  428,
-      428,  428,  428,  428,  428,  428,  428,  428,  428,  429,
-     1102,  429,    0,    0,  429,  429,  429,  429,  429,  429,
-      429,  429,  429,  429,  430,  430,  430,  430,  430,  430,
-      430,  430,  430,  430,    0,  436,    0,  434,    0,  431,
-      436,  431,  434,  430,  431,  431,  431,  431,  431,  431,
-
-      431,  431,  431,  431,  436,  434,  434,  435,  437,  435,
-     1144, 1102,  435,  437,  436,    0,  434, 1132, 1147,  436,
-        0,  434,  430,    0,  438,    0,  435,  437,  438,  438,
-      439,    0,  436,  434,  434,  439,  435,  437,  435, 1102,
-        0,  435,  437,  438,    0, 1132,  440, 1140,  439,  439,
-     1147,  440,    0,  438,  435,  437, 1144,  438,  438,  439,
-        0,    0,  441,    0,  439,  440, 1114,  441,  442,  443,
-        0,  438,  442,  442,  443,  440,  439,  439, 1139, 1147,
-      440,  441,    0,  443, 1144,  446, 1146,  442,  443,  444,
-      446,  441, 1140,  440,  444, 1143,  441,  442,  443, 1156,
-
-      444,  442,  442,  443,  446,  445,    0, 1149,  444,  441,
-      445,  443,    0,  445,  446,  442,  443, 1114,  444,  446,
-     1140,  447,  448,  444,  445,  447,  447,  448,  444, 1139,
-      449, 1156,  446,  448,  445,  449,  444, 1146,    0,  445,
-      447,  448,  445,  449, 1143, 1114, 1124, 1124, 1124,  449,
-      447,  448,  445,    0,  447,  447,  448, 1139, 1149,  449,
-     1156,  448,  451,    0,  449, 1146, 1145,  451,  447,  448,
-      452,  449, 1143,  451,  453,  452, 1152,  449,  452,  453,
-        0,  451,    0,    0, 1150,  454, 1149,  454,    0,  452,
-        0,  451,  453,  453,    0,    0,  451,    0,    0,  452,
-
-        0,  451, 1145,  453,  452,    0,    0,  452,  453,  451,
-      458, 1151, 1151, 1151,  457,  458,    0,  452,  454,  457,
-      453,  453,    0,  454,    0, 1152,  454,    0,  457,  458,
-      458, 1145,    0,  457,    0, 1150,    0,  454,    0,  458,
-      454,  459,    0,  457,  458,  460,  459,  454,  457,    0,
-      460,    0,  454, 1152, 1155,  454,  457,  458,  458,  460,
-      459,  457,  468, 1150,  460,  454,    0,  468,  454,  455,
-      459,  455,    0,    0,  460,  459, 1153, 1153, 1153,  460,
-        0,  468,    0,    0,  461,    0,    0,  460,  459,  461,
-     1155,  468,  460, 1158, 1158, 1158,  468, 1159, 1159, 1159,
-
-      455,  461,    0,  461,    0,  455,  463,  455,    0,  468,
-      455,  463, 1157,  461,  455,    0,    0,  455,  461, 1155,
-      455,  455,    0,    0,  455,  463,    0,    0,    0,  461,
-      463,  461,    0,    0,  455,  463,  455,    0,  472,  455,
-      463,    0,  455,  472,    0,  455,  462,    0,  455,  455,
-      462,  462,  455,  463,  464,  465,    0,  472,  463,  464,
-      465,  464,    0, 1157,    0,  462,  462,  472,    0,    0,
-        0,    0,  472,  464,  465,  462,  465,    0,    0,  462,
-      462,    0,    0,  464,  465,  472,    0,    0,  464,  465,
-      464, 1157,    0,  462,  462,    0,    0,    0,    0,    0,
-
-        0,  464,  465,    0,  465,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,    0,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  470,    0,  471,  473,  471,  470,
-
-        0,    0,  473,  474, 1002, 1002, 1002,    0,  474,    0,
-        0,  470, 1002,  470,    0, 1002,  473,    0,    0,    0,
-        0,    0,  474,  470,    0,    0,  473,  471,  470,  471,
-      476,  473,  474,    0,  471,  476,    0,  474,  477,  470,
-        0,  470,    0,  477,  473,    0,  477,    0,  471,  476,
-      474,    0,    0,    0,    0,    0,    0,  477,  471,  476,
-      478,    0,    0,  471,  476,  478,    0,  477,  479,    0,
-        0,    0,  477,  479,    0,  477,  471,  476,    0,  478,
-      478,    0,    0,    0,    0,  477,    0,  479,    0,  478,
-      480,    0,    0,    0,  478,  480,    0,  479,  480,  481,
-
-        0,    0,  479,    0,  481,  481,    0,  478,  478,  480,
-        0,    0,  481,    0,    0,  479,    0,    0,  481,  480,
-        0, 1003, 1003, 1003,  480,    0,    0,  480,  481, 1003,
-      482,  487, 1003,  481,  481,  482,  487,  480,  482,  483,
-      481,  483,  486,    0,  483,    0,  481,  486,    0,  482,
-      487,    0,    0,    0,    0,    0,  486,    0,  483,  482,
-      487,  486,    0,    0,  482,  487,    0,  482,  483,  490,
-      483,  486,    0,  483,  490,  491,  486,  482,  487,    0,
-      491,    0,    0,  490,  486,    0,  483,    0,  490,  486,
-        0,  492,    0,    0,  491,  493,  492,    0,  490,    0,
-
-      493,    0,  492,  490,  491,    0,  493,  494,    0,  491,
-      492,  490,  494,    0,  493,    0,  490,    0,  495,    0,
-      492,    0,  491,  495,  493,  492,  494,  496,    0,  493,
-      492,    0,  496,    0,  493,  496,  494,  495,  492,  497,
-        0,  494,  493,  498,  497,    0,  496,  495,  498,    0,
-      502,    0,  495,    0,  494,  502,  496,    0,  497,    0,
-        0,  496,  498,    0,  496,  495,  499,    0,  497,  502,
-      500,  499,  498,  497,  496,  500,    0,  498,    0,  502,
-      499,    0,  500,    0,  502,  499,  497,  501,    0,  500,
-      498,  501,  501,  503,    0,  499,  504,  502,  503,  500,
-
-      499,  504,    0,    0,  500,    0,  501,    0,  499,    0,
-      500,    0,  503,  499,    0,  504,  501,  500,  505,  507,
-      501,  501,  503,  505,  507,  504,    0,  503,    0,  508,
-      504, 1042, 1042, 1042,  501,  505,    0,  505,  507, 1042,
-      503,  506, 1042,  504,    0,    0,  506,  505,  507,  506,
-      508,    0,  505,  507,    0,  508,    0,  509,    0,    0,
-      506,    0,  509,  505,    0,  505,  507,    0,    0,  508,
-      506,    0,    0,    0,  509,  506,  509,    0,  506,  508,
-        0,    0,  510,    0,  508,    0,  509,  510,  506,  511,
-      512,  509,    0,  510,  511,  512,    0,  508,    0,    0,
-
-        0,  510,  509,  512,  509,    0,  511,    0,  511,  512,
-        0,  510,    0,    0,    0,    0,  510,    0,  511,  512,
-      513,  510,  515,  511,  512,  513,    0,  515,  514,  510,
-      514,  512,    0,  514,  511,    0,  511,  512,  517,  513,
-        0,  515,    0,    0,    0,  516,    0,  514,    0,  513,
-      516,  515,    0,  518,  513,    0,  515,  514,  518,  514,
-        0,  517,  514,    0,  516,  519,  517,  513,    0,  515,
-      519,    0,  518,    0,  516,  514,    0,    0,    0,  516,
-      517,    0,  518,    0,  519,    0,  523,  518,  520,    0,
-      517,  523,  516,  520,  519,  517,    0,    0,    0,  519,
-
-      518,    0,  520,    0,    0,  523,    0,  520,  517,  524,
-        0,    0,  519,  524,  524,  523,    0,  520,  525,    0,
-      523,  526,  520,  525,    0,    0,  526,    0,  524,    0,
-      520,    0,    0,  523,    0,  520,    0,  525,  524,    0,
-      526,  527,  524,  524,  528,  527,  527,  525,  528,  528,
-      526,    0,  525,    0,    0,  526,  524,    0,    0,    0,
-      527,  551,    0,  528,    0,  525,  551,    0,  526,    0,
-      527,    0,    0,  528,  527,  527,    0,  528,  528,  539,
-      551,  539,    0,    0,    0, 1071, 1071, 1071,  527,    0,
-      551,  528,    0, 1071,    0,  551, 1071,  539,  539,  539,
-
-      539,  539,  539,  539,  539,  539,  539,  540,  551, 1093,
-     1093, 1093,    0,  540,    0,    0,    0, 1093,    0,    0,
-     1093,    0,    0,  540,  540,  540,  540,  540,  540,  540,
-      540,  540,  540,  541,  548,    0,  548,    0,    0,  541,
-        0,    0,    0,    0,  548,    0,    0,    0,    0,  541,
-      541,  541,  541,  541,  541,  541,  541,  541,  541,  545,
-      550,    0,  550,    0,    0,  545,  549,  548,    0,    0,
-      548,  549,  548,  545,  549,  545,  545,  545,  545,  545,
-      545,  545,  545,  545,  545,  549,  548,    0,    0,    0,
-        0,    0,    0,  550,    0,  549,  548,    0,  550,  548,
-
-      549,  548,  552,  549,    0,  592,    0,  552,  552,  592,
-      592,    0,  550,  549,  548,  552,    0,    0,  553,  552,
-      553,  552,  550,    0,  592,    0,    0,  550,  553,    0,
-        0,  552,  553,    0,  592,    0,  552,  552,  592,  592,
-      550,  565,    0,  552,    0,    0,    0,  552,    0,  552,
-        0,  553,  592,  565,    0,  565,  553,    0,  565,  565,
-      565,  565,  565,  565,  565,  565,  565,  565,    0,  566,
-      553, 1110, 1110, 1110,    0,    0,    0,    0,    0, 1110,
-      553,    0, 1110,    0,    0,  553,  566,  566,  566,  566,
-      566,  566,  566,  566,  566,  566,  567,    0,  553,    0,
-
-        0, 1125, 1125, 1125,    0,  566,    0,    0,  567, 1125,
-      567,    0, 1125,  567,  567,  567,  567,  567,  567,  567,
-      567,  567,  567,  588,  588,  588,  588,  588,  588,  588,
-      588,  588,  588,    0,  566,  589,  589,  589,  589,  589,
-      589,  589,  589,  589,  589,  590,  590,  590,  590,  590,
-      590,  590,  590,  590,  590,  591,  591,  591,  591,  591,
-      591,  591,  591,  591,  591,  593,    0,    0,  595,    0,
-      593,    0,    0,  595, 1134, 1134, 1134,    0, 1135, 1135,
-     1135,    0, 1134,  595,  593, 1134, 1135,  595,    0, 1135,
-        0,    0,    0,    0,  593,    0,    0,  595,    0,  593,
-
-        0,    0,  595,    0,    0,    0,    0,    0,    0,    0,
-        0,  595,  593,  594,  594,  595,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-
-      594,  594,  596,  597,  596,  598,  600,  596,  597,  599,
-      598,  600,    0,  599,  599,    0,    0,    0,  598,  600,
-        0,  596,  597,    0,  598,  600,    0,    0,  599,    0,
-        0,  596,  597,  596,  598,  600,  596,  597,  599,  598,
-      600,    0,  599,  599,    0,    0,  598,  600,    0,  596,
-      597,    0,  598,  600,  601,  602,  599,  603,    0,  601,
-      602,  605,  603,    0,    0,  605,  605,    0,    0,  602,
-        0,    0,    0,  601,  602,  603,  603,    0,    0,    0,
-      605,    0,    0,  601,  602,    0,  603,  606,  601,  602,
-      605,  603,  606,    0,  605,  605,    0,  602,  606,    0,
-
-        0,  601,  602,  603,  603,    0,  606,    0,  605,  609,
-      607,    0,    0,  610,  609,  607,  606,  607,  610,    0,
-      610,  606,    0,    0,    0,    0,  606,    0,  609,  607,
-        0,    0,  610,    0,  606,  619,  621,    0,  609,  607,
-      619,  621,  610,  609,  607,    0,  607,  610,    0,  610,
-        0,    0,    0,    0,  619,  621,  609,  607,  620,    0,
-      610,    0,    0,  620,  619,  621,    0,    0,    0,  619,
-      621,  620,    0,    0,  623,  622,    0,  620,  622,  623,
-      622,    0,  619,  621,    0,    0,    0,  620,  623,    0,
-        0,  624,  620,  623,  622,    0,  624,    0,    0,  620,
-
-        0,    0,  624,  623,  622,  620,    0,  622,  623,  622,
-      624,    0,  625,  625,  626,    0,  623,  625,  628,  626,
-      624,  623,  622,  628,    0,  624,    0,    0,    0,  626,
-      624,  625,    0,  626,    0,  627,    0,  628,  624,  627,
-      627,  625,  625,  626,    0,    0,  625,  628,  626,    0,
-        0,    0,  628,  629,  627,  629,    0,  626,    0,  625,
-        0,  626,    0,  632,  627,  628,    0,    0,  627,  627,
-      631,  631,  631,  631,  631,  631,  631,  631,  631,  631,
-      632,    0,  627,  633,  629,  632,  629,  634,  633,  637,
-        0,  629,  634,    0,  637,    0,    0,    0,    0,  632,
-
-      634,    0,  633,    0,    0,  629,  634,    0,  637,  632,
-        0,    0,  633,    0,  632,  629,  634,  633,  637,  638,
-      629,  634,    0,  637,  638,    0,    0,  632,  634,    0,
-      633,    0,    0,  629,  634,  639,  637,    0,  638,  641,
-      639,  641,  642,  639,  641,  642,  643,  642,  638,    0,
-        0,  643,    0,  638,  639,    0,    0,    0,  641,    0,
-        0,  642,  644,    0,  639,  643,  638,  644,  641,  639,
-      641,  642,  639,  641,  642,  643,  642,    0,    0,  644,
-      643,  644,  639,  645,    0,  646,  641,  645,  645,  642,
-      646,  644,  647,  643,  648,    0,  644,  647,    0,  648,
-
-        0,    0,  645,    0,  646,  647,    0,  644,    0,  644,
-        0,  647,  645,  648,  646,    0,  645,  645,    0,  646,
-        0,  647,    0,  648,    0,    0,  647,    0,  648,  649,
-      645,  649,  646,  647,  649,  650,    0,    0,    0,  647,
-      650,  648,    0,    0,    0,    0,  650,    0,  649,    0,
-        0,    0,    0,    0,  650,    0,    0,    0,  649,    0,
-      649,  652,    0,  649,  650,  651,  652,  651,    0,  650,
-      651,    0,  652,  653,  650,    0,  649,  653,  653,    0,
-      652,    0,  650,    0,  651,    0,    0,    0,    0,    0,
-      652,    0,  653,    0,  651,  652,  651,    0,  655,  651,
-
-      652,    0,  653,  655,    0,  654,  653,  653,  652,  656,
-      654,    0,  651,  654,  656,    0,    0,  655,    0,    0,
-      653,    0,  656,    0,  654,  657,    0,  655,  656,  657,
-      657,    0,  655,    0,  654,    0,  658,    0,  656,  654,
-        0,  658,  654,  656,  657,  655,    0,    0,  660,    0,
-      656,    0,  654,  660,  657,  658,  656,  659,  657,  657,
-        0,  659,  659,    0,    0,  658,    0,  660,  661,  662,
-      658,    0,  657,  661,  662,    0,  659,  660,    0,    0,
-        0,    0,  660,  658,    0,    0,  659,  661,  662,    0,
-      659,  659,    0,    0,  663,  660,  663,  661,  662,  663,
-
-      665,  666,  661,  662,  659,  665,  666,    0,    0,    0,
-        0,    0,    0,  663,    0,  661,  662,    0,  665,  665,
-      666,    0,    0,  663,    0,  663,  667,    0,  663,  665,
-      666,  667,    0,    0,  665,  666,    0,  668,    0,  667,
-      668,  663,  668,    0,    0,  667,  665,  665,  666,  669,
-        0,    0,    0,  672,  669,  667,  668,  671,  672,    0,
-      667,    0,  671,    0,    0,    0,  668,  667,  669,  668,
-        0,  668,  672,  667,  673,    0,  671,  671,  669,  673,
-      674,    0,  672,  669,  668,  674,  671,  672,    0,    0,
-        0,  671,    0,  673,    0,    0,  669,    0,    0,  674,
-
-      672,    0,    0,  673,  671,  671,    0,    0,  673,  674,
-        0,    0,  690,    0,  674,    0,    0,    0,  690,  695,
-        0,  673,    0,  695,  695,    0,  690,  674,  690,  690,
-      690,  690,  690,  690,  690,  690,  690,  690,  695,  696,
-      698,  699,    0,    0,  696,  698,  699,  696,  695,    0,
-        0,  698,  695,  695,    0,    0,    0,    0,  696,  698,
-      699,    0,    0,    0,    0,    0,  695,    0,  696,  698,
-      699,    0,  709,  696,  698,  699,  696,    0,    0,  698,
-        0,    0,  710,    0,    0,    0,  696,  698,  699,  709,
-      709,  709,  709,  709,  709,  709,  709,  709,  709,  710,
-
-      710,  710,  710,  710,  710,  710,  710,  710,  710,  711,
-        0,    0,    0,    0,    0,    0,    0,    0,    0,  712,
-        0,    0,    0,    0,    0,    0,  711,  711,  711,  711,
-      711,  711,  711,  711,  711,  711,  712,  712,  712,  712,
-      712,  712,  712,  712,  712,  712,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  719,  719,  719,    0,    0,
-      719,  719,    0,  719,    0,    0,    0,  719,  719,    0,
-        0,  719,    0,    0,  719,  719,  719,  719,  719,  719,
-      719,  719,  719,  732,  732,    0,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  733,    0,    0,  735,    0,  733,  734,  734,
-      734,  734,  734,  734,  734,  734,  734,  734,  736,  737,
-        0,  733,  735,  736,  737,  738,    0,  735,    0,    0,
-      738,  733,    0,    0,    0,    0,  733,  736,  737,    0,
-        0,  735,    0,    0,  738,  739,    0,  736,  737,  733,
-
-      739,  735,  736,  737,  738,    0,  735,  740,    0,  738,
-        0,    0,  740,    0,  739,  736,  737,    0,  741,  735,
-        0,    0,  738,  741,  739,    0,  740,    0,    0,  739,
-      740,    0,    0,    0,    0,    0,  740,  741,  741,    0,
-        0,  740,  739,  742,    0,  742,    0,  741,  742,    0,
-      747,  743,  741,    0,  740,  747,  743,    0,  740,  743,
-        0,  745,  742,  745,    0,  741,  741,    0,    0,  747,
-      743,    0,  742,  750,  742,    0,    0,  742,  750,  747,
-      743,    0,  746,    0,  747,  743,  746,  746,  743,    0,
-      742,    0,  750,    0,  745,    0,  745,  747,  743,  745,
-
-        0,  746,  750,    0,    0,    0,    0,  750,    0,  745,
-        0,  746,    0,  745,  751,  746,  746,    0,  751,  751,
-      750,    0,    0,  745,    0,  745,  762,    0,  745,  746,
-        0,  762,    0,  751,  761,    0,  761,  745,    0,  761,
-        0,  745,    0,  751,    0,  762,  762,  751,  751,    0,
-        0,  763,    0,  761,    0,  762,  763,  763,    0,    0,
-      762,  751,    0,  761,    0,  761,    0,    0,  761,    0,
-      763,  764,  765,  762,  762,  764,  764,  765,  766,    0,
-      763,  761,  766,  766,    0,  763,  763,    0,    0,  765,
-      764,  765,    0,    0,  771,    0,    0,  766,  763,  771,
-
-      764,  765,    0,  767,  764,  764,  765,  766,  767,    0,
-      768,  766,  766,  771,  772,  768,  772,  765,  764,  765,
-      767,  768,  767,  771,  772,  766,  773,    0,  771,  768,
-        0,  773,  767,    0,    0,    0,    0,  767,    0,  768,
-      773,  771,    0,    0,  768,  773,  774,  772,  767,  768,
-      767,  774,  772,    0,  774,  773,    0,  768,  775,    0,
-      773,    0,  775,  775,    0,  774,  772,  776,  773,  778,
-        0,  776,  776,  773,  778,  774,  772,  775,    0,    0,
-      774,  772,    0,  774,    0,    0,  776,  775,  778,    0,
-      777,  775,  775,  774,  772,  777,  776,    0,  778,  779,
-
-      776,  776,    0,  778,  779,  775,    0,  777,    0,  777,
-      780,    0,    0,    0,  776,  780,  778,  779,  779,  777,
-        0,  780,  781,    0,  777,    0,    0,  781,  779,  780,
-        0,  782,    0,  779,    0,  777,  782,  777,    0,  780,
-        0,  781,  783,  784,  780,  779,  779,  783,  784,  780,
-      782,  781,    0,  785,    0,  785,  781,  780,    0,    0,
-      782,  783,  784,  786,    0,  782,    0,    0,  786,  781,
-        0,  783,  784,    0,  787,    0,  783,  784,  782,  787,
-        0,  786,  786,  788,    0,    0,  785,    0,  788,  783,
-      784,  785,  786,  787,  789,    0,    0,  786,  787,  789,
-
-        0,  785,  788,  787,    0,  785,    0,    0,  787,  786,
-      786,    0,  788,  789,    0,  785,    0,  788,    0,  790,
-      785,  787,    0,  789,  790,    0,  787,  791,  789,  785,
-      788,  791,  791,  785,    0,    0,  790,    0,  790,  792,
-        0,  789,    0,    0,  792,    0,  791,    0,  790,    0,
-        0,  792,    0,  790,    0,    0,  791,    0,  792,    0,
-      791,  791,  793,    0,  790,    0,  790,  793,  792,    0,
-      795,  796,    0,  792,  791,  795,  796,    0,  795,  792,
-        0,  793,  797,    0,    0,    0,  792,  797,    0,  795,
-      796,  793,    0,  798,    0,  799,  793,  799,  798,  795,
-
-      796,  797,    0,    0,  795,  796,    0,  795,    0,  793,
-        0,  797,  798,    0,    0,    0,  797,  795,  796,  800,
-      801,    0,  798,    0,  800,  801,  816,  798,  799,  797,
-      799,  816,    0,  799,    0,    0,    0,    0,  800,  801,
-      798,    0,    0,    0,    0,  816,    0,  799,  800,  801,
-        0,  817,    0,  800,  801,  816,  817,  799,    0,  799,
-      816,    0,  799,    0,  817,    0,  800,  801,    0,  818,
-      817,  818,    0,  816,  842,  799,  802,  802,  802,  802,
-      817,    0,    0,    0,    0,  817,    0,    0,    0,    0,
-      819,  842,  817,    0,    0,  819,  842,    0,  817,    0,
-
-        0,    0,  818,    0,    0,    0,    0,  818,    0,  819,
-      842,  802,  802,    0,    0,  802,    0,  802,    0,  819,
-      842,  818,    0,    0,  819,  842,    0,    0,  802,  802,
-        0,  818,    0,    0,    0,    0,  818,  819,  842,    0,
-      802,  802,    0,    0,  802,    0,  802,    0,    0,  818,
-        0,    0,    0,    0,    0,    0,  802,  802,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  828,  841,  841,
-      841,  841,  841,  841,  841,  841,  841,  841,    0,    0,
-        0,    0,    0,    0,  828,  828,  828,  828,  828,  828,
-      828,  828,  828,  828,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  843,    0,  844,    0,  847,  843,  844,
-      844,  845,  847,  845,  846,    0,  845,    0,  846,  846,
-        0,    0,  843,    0,  844,    0,  847,    0,    0,    0,
-      845,    0,  843,  846,  844,    0,  847,  843,  844,  844,
-
-      845,  847,  845,  846,  849,  845,    0,  846,  846,  849,
-      843,  848,  844,    0,  847,  848,  848,    0,  845,    0,
-      850,  846,    0,  849,    0,  850,    0,  853,    0,    0,
-      848,  854,  853,  849,  850,    0,  854,    0,  849,  850,
-      848,  853,    0,    0,  848,  848,  853,    0,  854,  850,
-      854,  849,  855,    0,  850,    0,  853,  855,  848,    0,
-      854,  853,  850,  858,    0,  854,    0,  850,  858,  853,
-        0,  855,  866,    0,  853,    0,  854,  866,  854,    0,
-      858,  855,  858,  867,    0,    0,  855,    0,  867,    0,
-        0,  866,  858,    0,  867,    0,    0,  858,    0,  855,
-
-        0,  866,  867,    0,  868,    0,  866,    0,  858,  868,
-      858,    0,  867,  869,    0,  869,    0,  867,  869,  866,
-        0,  868,  867,  868,    0,    0,    0,    0,    0,  870,
-      867,    0,  869,  868,  870,  871,    0,    0,  868,    0,
-      871,    0,  869,  870,  869,    0,    0,  869,  870,  868,
-        0,  868,    0,    0,  871,    0,    0,    0,  870,    0,
-      869,  872,    0,  870,  871,  872,  872,    0,  873,  871,
-      874,  870,  873,  873,    0,  874,  870,    0,    0,    0,
-      872,  874,  871,    0,    0,    0,    0,  873,    0,  874,
-      872,  878,    0,  877,  872,  872,  878,  873,  877,  874,
-
-        0,  873,  873,    0,  874,    0,  877,    0,  872,  874,
-      878,    0,  877,  879,  880,  873,  881,  874,  879,  880,
-      878,  881,  877,    0,    0,  878,    0,  877,    0,    0,
-        0,    0,  879,  880,  877,  881,  882,    0,  878,    0,
-      877,  882,  879,  880,  882,  881,    0,  879,  880,    0,
-      881,    0,  883,  886,    0,  882,    0,  883,  886,  885,
-      879,  880,    0,  881,  885,  882,    0,    0,    0,    0,
-      882,  883,  886,  882,    0,    0,  885,    0,  885,  887,
-        0,  883,  886,  882,  887,    0,  883,  886,  885,    0,
-      888,  890,    0,  885,    0,  888,  890,    0,  887,  883,
-
-      886,  888,  891,    0,  885,    0,  885,  891,  887,  888,
-      890,  889,    0,  887,    0,  889,  889,    0,    0,  888,
-      890,  891,  892,  897,  888,  890,  887,  892,  897,  888,
-      889,  891,    0,    0,  895,    0,  891,  888,  890,  895,
-      889,  892,  897,  906,  889,  889,    0,    0,  906,  891,
-        0,  892,  897,  895,    0,  895,  892,  897,  889,  898,
-        0,    0,  906,  895,  898,    0,  907,  898,  895,  892,
-      897,  907,  906,    0,    0,    0,    0,  906,  898,    0,
-        0,  895,    0,  895,  907,  907,    0,    0,  898,  909,
-      906,  909,    0,  898,  909,  907,  898,    0,    0,    0,
-
-      907,    0,    0,    0,    0,    0,  898,  914,  909,    0,
-        0,    0,  907,  907,    0,    0,  917,  917,  909,    0,
-      909,  917,    0,  909,  914,  914,  914,  914,  914,  914,
-      914,  914,  914,  914,    0,  917,  909,  918,    0,  919,
-        0,    0,  918,  919,  919,  917,  917,    0,  920,    0,
-      917,    0,    0,  920,    0,    0,  918,    0,  919,    0,
-        0,    0,    0,  917,    0,  920,  918,  920,  919,  921,
-      922,  918,  919,  919,  921,  922,    0,  920,  923,    0,
-        0,    0,  920,  923,  918,    0,  919,    0,  921,  922,
-        0,  923,    0,  920,    0,  920,    0,  923,  921,  922,
-
-        0,  927,    0,  921,  922,  928,  927,  923,    0,  928,
-      928,    0,  923,  927,    0,    0,  921,  922,    0,  923,
-      927,  938,    0,    0,  928,  923,  938,  930,  940,  938,
-      927,  930,  930,  940,  928,  927,    0,    0,  928,  928,
-      938,  927,    0,    0,    0,    0,  930,  940,  927,    0,
-      938,    0,  928,    0,    0,  938,  930,  940,  938,  939,
-      930,  930,  940,  939,  939,  941,  942,    0,  938,    0,
-      941,  942,    0,    0,  930,  940,    0,    0,  939,    0,
-        0,    0,  943,    0,  941,  942,  942,  943,  939,    0,
-        0,  944,  939,  939,  941,  942,  944,    0,    0,  941,
-
-      942,  943,  945,    0,  944,    0,  939,  945,    0,    0,
-      944,  943,  941,  942,  942,    0,  943,    0,  951,    0,
-      944,  945,  952,  951,    0,  944,    0,  952,    0,  943,
-        0,  945,  944,    0,    0,    0,  945,  951,  944,  955,
-        0,  952,    0,  953,  955,  953,    0,  951,  953,  945,
-        0,  952,  951,  955,    0,    0,  952,    0,  955,  956,
-        0,    0,  953,    0,  956,  951,  957,    0,  955,  952,
-      958,  957,  953,  955,  953,  958,    0,  953,  956,    0,
-        0,  955,    0,    0,    0,  957,  955,  958,  956,  958,
-      953,    0,  960,  956,    0,  957,  960,  960,    0,  958,
-
-      957,    0,    0,  963,  958,    0,  956,    0,  963,  962,
-        0,  960,    0,  957,  962,  958,  963,  958,    0,    0,
-        0,  960,  963,    0,    0,  960,  960,  962,  962,  969,
-        0,    0,  963,    0,  969,  970,    0,  963,  962,  960,
-      970,  971,    0,  962,  963,  971,  971,    0,  969,  969,
-      963,    0,  976,    0,  970,  962,  962,  976,  969,    0,
-      971,  975,    0,  969,  970,    0,  975,    0,  977,  970,
-      971,  976,  975,  977,  971,  971,  969,  969,    0,    0,
-      975,  976,  970,    0,  979,    0,  976,  977,  971,  979,
-      975,    0,    0,  985,    0,  975,    0,  977,  985,  976,
-
-      975,  978,  977,  979,  982,  978,  978,    0,  975,  982,
-        0,    0,  985,  979,    0,  977,    0,    0,  979,  982,
-      978,    0,  985,  982,  983,    0,  983,  985,    0,  983,
-      978,  979,    0,  982,  978,  978,    0,    0,  982,    0,
-      985,  993,    0,  983,  994,  992,  993,  982,  978,  994,
-      992,  982,    0,  983,    0,  983,  994,    0,  983,  992,
-      993,  995,    0,  994,  992,    0,  995,  996,    0,    0,
-      993,  983,  996,  994,  992,  993,    0,    0,  994,  992,
-      995,    0,    0,    0,  994,    0,  996,  992,  993,    0,
-      995,  994,  992, 1004,    0,  995,  996,  997, 1004,  997,
-
-     1007,  996,  997,    0, 1006, 1007, 1006,    0,  995, 1006,
-        0,    0, 1004,    0,  996,    0,  997,    0,    0, 1007,
-     1009,    0, 1004, 1006,    0, 1009,  997, 1004,  997, 1007,
-        0,  997,    0, 1006, 1007, 1006,    0, 1011, 1006, 1009,
-     1004, 1011, 1011,    0,  997,    0,    0, 1007,    0, 1009,
-        0, 1006,    0, 1012, 1009,    0, 1011, 1012, 1012,    0,
-     1020,    0,    0,    0, 1019, 1020, 1011, 1009,    0, 1019,
-     1011, 1011, 1012,    0,    0, 1019, 1025,    0,    0, 1020,
-     1025, 1025, 1012, 1019, 1011, 1026, 1012, 1012,    0, 1020,
-     1026,    0,    0, 1019, 1020, 1025,    0, 1029, 1019,    0,
-
-     1012,    0, 1029, 1019, 1026, 1025,    0, 1020, 1029, 1025,
-     1025, 1019,    0,    0, 1026,    0, 1029,    0,    0, 1026,
-     1030,    0, 1037, 1025, 1038, 1030, 1029, 1037, 1030, 1038,
-        0, 1029, 1026,    0,    0, 1037, 1029,    0,    0, 1030,
-        0, 1037,    0, 1038, 1029,    0,    0, 1039,    0, 1030,
-        0, 1037, 1039, 1038, 1030, 1039, 1037, 1030, 1038, 1047,
-        0,    0,    0, 1037, 1047,    0, 1039, 1030, 1040, 1037,
-     1044, 1038, 1040, 1040, 1044, 1044, 1039,    0, 1047,    0,
-        0, 1039,    0,    0, 1039,    0,    0, 1040, 1047, 1044,
-     1048, 1054,    0, 1047, 1039, 1048, 1054, 1040,    0, 1044,
-
-        0, 1040, 1040, 1044, 1044,    0, 1047, 1059,    0, 1048,
-     1054,    0, 1059,    0,    0, 1040, 1063, 1044,    0, 1048,
-     1054, 1063,    0, 1062, 1048, 1054, 1059, 1062, 1062,    0,
-        0,    0,    0,    0, 1063, 1063, 1059, 1048, 1054, 1067,
-        0, 1059, 1062,    0, 1067, 1063, 1068,    0, 1069,    0,
-     1063, 1068, 1062, 1069, 1059,    0, 1062, 1062, 1067, 1068,
-        0,    0, 1063, 1063,    0, 1068,    0, 1069, 1067, 1073,
-     1062, 1080, 1073, 1067, 1073, 1068, 1080, 1069,    0,    0,
-     1068,    0, 1069,    0,    0,    0, 1067, 1068, 1073,    0,
-     1080, 1087,    0, 1068, 1088, 1069, 1087,    0, 1073, 1088,
-
-     1080, 1073, 1088, 1073,    0, 1080,    0,    0,    0,    0,
-     1087,    0,    0, 1088, 1087,    0, 1073, 1091, 1080,    0,
-     1087, 1091, 1091, 1088, 1095, 1087,    0,    0, 1088, 1095,
-        0, 1088,    0,    0,    0,    0, 1091,    0, 1087,    0,
-     1105, 1088, 1087, 1095, 1095, 1105, 1091, 1106,    0, 1108,
-     1091, 1091, 1106, 1095, 1108,    0,    0,    0, 1095, 1105,
-        0, 1106,    0,    0, 1091,    0, 1106,    0, 1108, 1105,
-        0, 1095, 1095,    0, 1105,    0, 1106,    0, 1108,    0,
-        0, 1106,    0, 1108,    0,    0,    0, 1105,    0, 1106,
-        0,    0,    0,    0, 1106,    0, 1108, 1109, 1109, 1109,
-
-        0,    0, 1109, 1109,    0, 1109,    0,    0,    0, 1109,
-     1109,    0,    0, 1109,    0,    0, 1109, 1109, 1109, 1109,
-     1109, 1109, 1109, 1109, 1109, 1112, 1122,    0,    0,    0,
-     1112, 1122,    0,    0,    0,    0,    0,    0,    0, 1122,
-        0,    0, 1112,    0, 1112, 1122,    0,    0,    0,    0,
-        0,    0,    0,    0, 1112, 1122,    0,    0,    0, 1112,
-     1122,    0,    0,    0,    0,    0,    0, 1122,    0,    0,
-     1112,    0, 1112, 1122, 1126, 1126, 1126,    0,    0, 1126,
-     1126,    0, 1126,    0, 1128, 1126, 1126, 1126, 1128, 1128,
-     1126,    0,    0, 1126, 1126, 1126, 1126, 1126, 1126, 1126,
-
-     1126, 1126,    0, 1128, 1133, 1137,    0,    0,    0, 1133,
-     1137,    0,    0, 1128,    0,    0,    0, 1128, 1128,    0,
-        0,    0,    0, 1133, 1137,    0,    0,    0,    0,    0,
-        0, 1128,    0, 1133, 1137,    0,    0,    0, 1133, 1137,
+      217,  217,  217,  217,  217,  217,  217,  217,  220,  219,
+      227,  228,  230,  248,  245,  229,  254,  255,  217,  217,
+
+      217,  217,  217,  219,  237,  220,  232,  232,  232,  256,
+      257,  237,  237,  259,  232,  232,    0,  220,  219,  228,
+      230,  248,  245,    0,  254,  255,  233,  233,  233,  217,
+      217,  219,    0,  220,  233,  233,  236,  256,  257,    0,
+      238,  259,  238,  236,  236,  238,  238,  238,  238,  238,
+      238,  238,  238,  238,  238,  260,  237,  217,  218,  218,
+      218,  218,  218,  218,  218,  218,  218,  218,  218,  218,
+      218,  218,  218,  218,  218,  218,  218,  261,  262,  236,
+      378,  378,  378,  260,  237,    0,    0,  218,  218,  218,
+      218,  218,  218,  251,  251,  251,  251,  251,  251,  251,
+
+      251,  251,  251,  263,  264,  261,  262,  236,  252,  252,
+      252,  252,  252,  252,  252,  252,  252,  252,  218,  218,
+      253,  218,  253,  547,  547,  547,    0,    0,  266,  267,
+      253,  263,  264,  265,  268,  269,  265,    0,  270,  271,
+      272,  273,  274,    0,    0,  266,  218,  250,  250,  250,
+      250,  250,  250,  250,  250,  250,  250,  266,  267,  277,
+      281,  265,  268,  269,  265,  250,  250,  270,  271,  272,
+      273,  274,  276,  266,  276,  282,  283,  278,  250,  278,
+        0,    0,  279,  279,  284,  285,  286,  285,  277,  281,
+      287,    0,  289,  290,  250,  250,  291,  292,  288,  293,
+
+      288,  295,    0,  276,  282,  283,  250,  275,  278,  275,
+      279,  279,  284,  294,  286,  299,  285,    0,  298,  287,
+      289,  290,    0,  300,  291,  292,  294,  293,  302,    0,
+      295,  296,  301,  296,  301,    0,  303,  297,  275,  297,
+      304,  296,  294,  275,  299,  275,  298,  297,  275,    0,
+      288,  300,  275,  306,  294,  275,  305,  302,  275,  275,
+      308,    0,  275,  301,  303,  309,  310,  312,  304,  313,
+      315,  311,  275,  316,  275,  296,  317,  275,  288,  311,
+      275,  297,  306,  275,  305,  296,  275,  275,  318,  308,
+      275,  297,  314,  309,  310,  319,  312,  313,  315,  311,
+
+      314,  316,  320,  296,  317,  321,  322,  311,  323,  297,
+      324,  325,  326,  296,  328,  329,  327,  318,  327,  297,
+      330,  314,  331,  332,  319,  333,  327,  334,  314,  335,
+      339,  320,  341,  321,  342,  322,  323,  343,  324,  325,
+      326,  344,  345,  328,  329,  346,  347,  352,  330,    0,
+      331,  332,    0,  333,  351,  334,  363,  335,  339,  348,
+      341,  348,  342,  353,    0,  343,  355,  356,  358,  344,
+      345,  357,  359,  346,  376,  347,  369,  348,  348,  348,
+      348,  348,  348,  348,  348,  348,  348,  349,  357,  869,
+      352,  361,  351,  349,  363,  355,  356,  358,  371,    0,
+
+      357,  359,  376,  349,  349,  349,  349,  349,  349,  349,
+      349,  349,  349,  350,  368,  353,  357,  370,  352,  350,
+      361,  351,  377,  363,  379,  383,    0,  371,  369,  350,
+      350,  350,  350,  350,  350,  350,  350,  350,  350, 1005,
+        0,  360,  372,  353,  354,  364,  364,  364,  381,  869,
+      354,  377,  379,  372,  360,  370,  369,  368,  354,  373,
+      354,  354,  354,  354,  354,  354,  354,  354,  354,  354,
+      360,  372,  374,  380,  384,  383,  382,  373,  354,  354,
+        0,  372,  360,  375,  370,  368,  364,  406,  373,  385,
+      398,  354,  374,  405,  375,  381,  385,  385,  653, 1005,
+
+      653,  374,  380,  383,    0,  373,  386,  354,  354,  382,
+      384,    0,  375,  386,  386,  364,  406,  387,  398,  354,
+      374,  405,  375,  381,  387,  387,  388,  388,  388,  388,
+      388,  388,  388,  388,  388,  388,  408,  410,  382,  384,
+      389,  389,  389,  389,  389,  389,  389,  389,  389,  389,
+      402,  411,  402,  387,  413,    0,  386,  414,    0,  415,
+      402,  416,  417,  418,  420,  408,  410,  421,  422,  423,
+      424,  425,  426,  429,  426,  430,  431,    0,  432,  411,
+      433,  435,  387,  413,  386,  436,  414,  415,  434,  416,
+      417,  439,  418,  420,  442,  421,  422,  423,  424,  425,
+
+      437,  429,  437,  430,  434,  431,  432,  444,  433,  435,
+      440,  446,  440,  426,  436,  447,  445,  434,  445,  439,
+      450,  448,  442,  448, 1009,  451,  452,  426,  454,    0,
+      457,  437,  434,  455,  456,  444,  458,  459,  460,  446,
+      464,  440,  426,  458,  447,  463,  468,  445,  467,  450,
+        0,  469,  448,  451,  452,  426,  427,  454,  427,  457,
+      470,  455,  456,    0,  480,  458,  459,  460,  461,  464,
+      461,  458,  465,  463,  465,  468,  467,  478,  461,  469,
+      483,  472,  465,  472, 1009,  479,  481,  427,  470,  482,
+      484,  475,  427,  480,  427,  485,  493,  427,  503,  475,
+
+      488,  427,    0,  489,  427,  478,  490,  427,  427,  483,
+      491,  427,  472,  479,  481,    0,    0,  482,  484,    0,
+      506,  427,  506,  427,  485,  493,  427,  503,  488,  427,
+      475,  489,  427,  499,  490,  427,  427,    0,  491,  427,
+      443,  443,  443,  443,  443,  443,  443,  443,  443,  443,
+      443,  506,  443,  443,  443,  443,  443,  443,  443,  475,
+      507,  499,  508,  509,  494,  500,  494,  500,  513,  443,
+      443,  443,  443,  443,  494,  500,  514,  515,  516,  517,
+      518,  523,  524,  655,  535,  655,  525,    0,  667,  507,
+      667,  508,  509,  520,  529,  520,  527,  513,  563, 1031,
+
+      443,  443,  529,  540,  514,  531,  515,  516,  517,  518,
+      537,  520,  520,  520,  520,  520,  520,  520,  520,  520,
+      520,  521,  525,  529,  527,  545,  563,  521,  443,  565,
+      523,  529,  524,  535,  531,    0,    0,  521,  521,  521,
+      521,  521,  521,  521,  521,  521,  521,  522,    0,  538,
+      539,  525,  540,  522,  545,  537,  568,  565,  523, 1031,
+      524,  535,    0,  522,  522,  522,  522,  522,  522,  522,
+      522,  522,  522,  526,  532,  536,  536,  536,    0,  526,
+      540,  532,  548,  537,  568,  532,  539,  526,  541,  526,
+      526,  526,  526,  526,  526,  526,  526,  526,  526,  538,
+
+      533,    0,  533,  532,  552,  550,  541,  526,  526,  532,
+      533,  548,  561,  532,  533,  539,  536,  541,  542,    0,
+      526,  543,  542,  554,  544,  543,  562,  538,  544,  566,
+      554,  554,  569,  576,  541,  555,  526,  526,  550,  577,
+      552,  561,  555,  555,  570,  536,  571,  542,  526,  573,
+      543,  542,  574,  544,  543,  562,  575,  544,  566,  554,
+        0,  569,  576,  581,  659,  659,  659,  550,  577,  552,
+        0,  578,  570,  578,  571,    0,  641,  573,  641,  579,
+      574,  580,    0,  582,  575,  583,  641,  584,  554,  564,
+      564,  581,  564,  564,  564,  564,  564,  564,  564,  564,
+
+      564,  564,  564,  564,  564,  564,  564,  564,  579,  585,
+      580,  582,  578,  586,  583,  584,  587,  588,  564,  564,
+      564,  564,  564,  590,  592,    0,  578,  593,  594,  586,
+      595,    0,  596,  597,  598,  608,  599,  585,  599,    0,
+      602,  578,  586,  603,  587,  603,  588,  607,  613,  564,
+      564,  590,  610,  592,  578,  593,  594,  586,  611,  595,
+      596,  614,  597,  598,  608,  615,  616,  599,  602,  617,
+      618,    0,  619,  620,  603,  607,  613,  564,  621,  622,
+      623,  610,  626,    0,  627,  628,  630,  611,  632,  633,
+      614,  634,  639,  615,  616,  636,  637,  638,  617,  618,
+
+      619,  640,  620,  644,  645,  646,  621,  646,  622,  623,
+      654,  626,  627,  656,  628,  630,  632,  657,  633,  662,
+      634,  639,  663,  636,  637,  638,  666,  668,  669,  640,
+      669,  644,  645,  658,  670,  658,  646,  671,  672,  654,
+      672,  676,  656,  658,  681,  657,  675,  658,  672,  674,
+      683,  674,  672,  679,  677,  666,  668,  700,  663,  662,
+      694,    0,  670,  674,  695,  680,  671,  694,  694,  680,
+      696,  695,  695,  681,  701,  703,    0,  696,  696,  683,
+      771,  738,  771,  738, 1082,  700,  675,  663,  662,  665,
+      677,  738,  676,  679,  680,  665,    0,  704,  680,  706,
+
+      707,  708,  701,  665,  703,  665,  665,  665,  665,  665,
+      665,  665,  665,  665,  665,  675,  709,    0,  710,  677,
+      676,  711,  679,  665,  665,  704,  714,  706,  707,  708,
+      715,  717,    0,  719,  721,    0,  665,  762,    0,  762,
+      770,  781,  770,  781, 1082,  709,  710,  762,  770,  858,
+      711,  858,  665,  665,  712,  714,  712,  722,  723,  715,
+      717,  719,  724,  721,  665,  682,  682,  682,  682,  682,
+      682,  682,  682,  682,  682,  682,  682,  682,  682,  682,
+      682,  682,  682,  682,  725,  722,  723,  726,  727,  712,
+      729,  724,  728,  730,  682,  682,  682,  682,  682,  731,
+
+      732,    0,  712,  733,  734,  735,  737,  735, 1084,  739,
+      740,  741,  725,  742,    0,  743,  726,  727,  712,  729,
+      728,  745,  730,  746,  752,  682,  682,  731,  756,  732,
+      712,  733,  734,    0,    0,  737,  735,  739,    0,  740,
+      741,  755,  742,  743,  757,  775,  775,  775,  833,  745,
+      833,  746,  752,  682,  686,  686,  686,  756,  833,  686,
+      686,  751,  686,  751,    0,    0,  686,  686, 1084,  755,
+      686,    0,  757,  686,  686,  686,  686,  686,  686,  686,
+      686,  686,  699,  699,  776,  699,  699,  699,  699,  699,
+      699,  699,  699,  699,  699,  699,  699,  699,  699,  699,
+
+      699,  758,  759,  783,  760,  763,    0,  768,  773,  751,
+      772,  699,  699,  699,  699,  699,  767,  774,  767,  779,
+      782,  776,  784,  787,  780,  789,  791,  791,  791,  758,
+      802,  759,  760,  810,  763,  768,  773,  751,  803,  772,
+      783,    0,  699,  699,  804,  806,  774,  807,  779,  782,
+      776,  767,  780,  808,  789,  797,  812,  798,  784,  802,
+      787,  810,  797,  797,  798,  798,  864,  803,  864,  783,
+      699,    0,    0,  804,  806,    0,  807,  811,    0,  811,
+      767,  801,  808,  813,  812,  801,  815,  784,  816,  787,
+      788,  788,  788,  788,  788,  788,  788,  788,  788,  788,
+
+      788,  788,  788,  788,  788,  788,  788,  788,  788,  817,
+      801,  813,  811,  819,  801,  815,  816,  818,  820,  788,
+      788,  788,  788,  788,  821,  811,  822,    0,  823,  824,
+      825,  826,  827,    0,  828,  830,  831,  840,  817,  832,
+     1085,  811,  819,  835,  836,  818,  842,  820,  842,  843,
+      788,  788,  821,  811,  844,  822,  823,  824,  825,  826,
+      846,  827,  828,  847,  830,  831,  840,  832,  834,  834,
+      834,  835,  836,  851,  852,  851,  834,  843,  788,  834,
+      853,  855,  844,  851,  854,  856,  854,  857,  846,  859,
+      867,  865,  847,  863,  842,  870,  871,    0,  873,  874,
+
+     1085,  875,  876,  852,  878,  879,  880,  881,  853,  882,
+      855,  883,    0,  884,  856,  857,  885,  889,  859,  854,
+      865,  863,  842,  886,  870,  871,  873,  887,  874,  875,
+      876,  888,  878,  879,  880,  881,  890,  882,  896,  867,
+      883,  884,  892,  893,  894,  885,  889,  895,  854,  897,
+      899,  886,  901,  901,  901,  887,  903,  903,  903,  888,
+      901,  909,    0,  901,  890,  910,  896,  867,    0,  908,
+      915,  892,  893,  894,  913,  916,  895,  897,  899,  902,
+      902,  902,  917,  904,  904,  904,  918,  902,  919,  909,
+      902,  904,  920,  910,  904,  905,  905,  905,  908,  915,
+
+      921,  922,  913,  905,  916,  924,  905,  925,  926,  927,
+      917,  928,  929,  932,  918,    0,  919,  933,    0,  935,
+      936,  920,  937,  938,  939,  941,  940,  942,  940,  943,
+      922,  944,  945,  947,  924,  921,  940,  949,  951,  928,
+      929,  932,  952,  925,  927,  926,  933,  935,    0,  936,
+      937,    0,  938,  939,  941,  961,  942,  960,  943,  944,
+      945,  947,    0,    0,  921,  949,  951,  953,  953,  953,
+      965,  952,  925,  927,  926,  954,  954,  954,  970,  955,
+      955,  955,  963,  954,  961,  960,  954,  955,  966,  973,
+      955,  956,  956,  956,  967,  957,  957,  957,  965,  956,
+
+      969,  975,  956,  957,  971,  974,  957,  958,  958,  958,
+      976,  963,  977,  980,  977,  958,  981,  966,  958,    0,
+      982,  983,  977,  967,  970,  984,  985,  984,  985,  969,
+      987,  989,  971,  991,  973,  984,  985,  974,  994,  976,
+      992,  980,  995, 1008, 1007,  981,    0,  975,  982,  998,
+      983,    0,  970,  996,  996,  996,  999, 1001,  987,  989,
+     1013,  991,  973, 1016, 1014, 1015,  974,  994,  992, 1017,
+     1019,  995,  997,  997,  997,  975, 1021, 1008,  998, 1007,
+      997, 1032, 1011,  997, 1011,  999, 1001, 1012, 1013, 1012,
+     1025, 1016, 1011, 1014, 1015, 1026, 1029, 1017, 1027, 1019,
+
+     1012, 1030, 1012, 1033, 1021, 1037, 1008, 1036, 1007, 1023,
+     1023, 1023, 1024, 1024, 1024,    0, 1038, 1032, 1012, 1025,
+     1024, 1039, 1042, 1024, 1026, 1034, 1027, 1034, 1045, 1030,
+     1041, 1048, 1035, 1037, 1035, 1052, 1036, 1046, 1034, 1050,
+     1034, 1029, 1056, 1035, 1038, 1035, 1032, 1035, 1033, 1059,
+     1039, 1042, 1043, 1043, 1043, 1049, 1034, 1045, 1041, 1044,
+     1044, 1044, 1053, 1035, 1053, 1046, 1055, 1044, 1058, 1029,
+     1044, 1056, 1063, 1053, 1050, 1068, 1033, 1048, 1059, 1064,
+     1065, 1052,    0, 1049, 1062, 1062, 1062, 1066, 1071, 1067,
+        0, 1073, 1062,    0, 1055, 1062, 1058, 1074,    0, 1079,
+
+     1063, 1099, 1109, 1050, 1093, 1048,    0, 1064, 1065, 1052,
+     1061, 1061, 1061, 1095,    0, 1061, 1061, 1067, 1061, 1073,
+     1086, 1068, 1061, 1061, 1080, 1074, 1061, 1079, 1090, 1061,
+     1061, 1061, 1061, 1061, 1061, 1061, 1061, 1061, 1066, 1071,
+     1076, 1076, 1076, 1077, 1077, 1077,    0, 1094, 1086, 1068,
+     1099, 1077, 1096, 1080, 1077, 1093, 1104, 1090, 1095, 1101,
+     1102, 1105, 1109,    0, 1111,    0, 1066, 1071, 1078, 1078,
+     1078, 1100, 1113, 1078, 1078, 1094, 1078, 1103, 1099, 1078,
+     1078, 1078, 1106, 1093, 1078, 1104, 1095, 1078, 1078, 1078,
+     1078, 1078, 1078, 1078, 1078, 1078, 1088, 1088, 1088, 1100,
+
+     1089, 1089, 1089, 1096, 1088, 1101, 1107, 1088, 1089, 1102,
+     1108, 1089, 1105, 1103, 1110, 1111, 1112, 1114, 1106, 1115,
+     1115, 1115, 1117, 1113, 1116, 1116, 1116, 1118, 1118, 1118,
+     1123, 1096, 1126, 1101, 1119, 1119, 1119, 1102, 1107, 1108,
+     1105, 1127, 1103, 1111, 1112,    0, 1110, 1106, 1121, 1121,
+     1121, 1113, 1124, 1124, 1124, 1128, 1128, 1128, 1129, 1129,
+     1129,    0,    0,    0, 1126,    0, 1123, 1107, 1114,    0,
+        0, 1117,    0,    0,    0, 1110,    0,    0,    0,    0,
         0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-        0, 1133, 1137, 1162, 1162, 1162, 1162, 1162, 1162, 1162,
-     1162, 1162, 1162, 1162, 1162, 1163, 1163, 1163, 1163, 1163,
-     1163, 1163, 1163, 1163, 1163, 1163, 1163, 1164, 1164,    0,
-     1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1165,
-     1165,    0, 1165, 1165, 1165, 1165, 1165, 1165, 1165, 1165,
-
-     1165, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166,
-     1166, 1166, 1166, 1167, 1167, 1167, 1167, 1167, 1167, 1167,
-     1167, 1167, 1167, 1167, 1167, 1168, 1168, 1169, 1169, 1169,
-     1169, 1169, 1169, 1169, 1169, 1170, 1170, 1170, 1170, 1170,
-     1170, 1170, 1170, 1170, 1170, 1170, 1170, 1171, 1171, 1171,
-     1171, 1171, 1171, 1171, 1171, 1171, 1171, 1171, 1171, 1172,
-     1172, 1172, 1172, 1172, 1172,    0, 1172, 1172, 1172,    0,
-     1172, 1173, 1173, 1173, 1173, 1173, 1173, 1173, 1173, 1173,
-     1173, 1173, 1173, 1174,    0,    0, 1174, 1175, 1175, 1175,
-        0,    0, 1175,    0, 1175, 1175,    0, 1175, 1175, 1176,
-
-     1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176,
-     1176, 1177, 1177,    0, 1177, 1177, 1177, 1177, 1177, 1177,
-     1177, 1177, 1177, 1178, 1178, 1178, 1178, 1178, 1178,    0,
-     1178, 1178, 1178,    0, 1178, 1179, 1179, 1179, 1179, 1179,
-     1179, 1179, 1179, 1179, 1179, 1179, 1179, 1180, 1180, 1180,
-     1180, 1180, 1180, 1180, 1180, 1180, 1180, 1180, 1180, 1181,
-        0,    0, 1181, 1182,    0,    0,    0, 1182,    0,    0,
-        0,    0,    0, 1182, 1183, 1183, 1183, 1183, 1183, 1183,
-     1183, 1183, 1183, 1183, 1183, 1183, 1184, 1184,    0, 1184,
-     1184, 1184, 1184, 1184, 1184, 1184, 1184, 1184, 1185, 1185,
-
-        0, 1185, 1185, 1185, 1185, 1185, 1185, 1185, 1185, 1185,
-     1186, 1186,    0, 1186, 1186, 1186, 1186, 1186, 1186, 1186,
-     1186, 1186, 1187, 1187, 1187, 1187, 1187, 1187, 1187, 1187,
-     1187, 1187, 1187, 1187, 1188, 1188, 1188, 1188, 1188, 1188,
-     1188, 1188, 1188, 1188, 1188, 1188, 1189, 1189, 1189, 1189,
-     1189, 1189, 1189, 1189, 1189, 1189, 1189, 1189, 1190, 1190,
-     1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190,
-     1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191,
-     1191, 1191, 1192, 1192,    0, 1192, 1192, 1192, 1192, 1192,
-     1192, 1192, 1192, 1192, 1193, 1193, 1193, 1193, 1193, 1193,
-
-     1193, 1193, 1193, 1193, 1193, 1193, 1194, 1194, 1194, 1194,
-     1194, 1194, 1194, 1194, 1194, 1194, 1194, 1194, 1195, 1195,
-        0, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195,
-     1196, 1196,    0, 1196, 1196, 1196, 1196, 1196, 1196, 1196,
-     1196, 1196, 1197, 1197,    0, 1197, 1197, 1197, 1197, 1197,
-     1197, 1197, 1197, 1197, 1198, 1198,    0, 1198, 1198, 1198,
-     1198, 1198, 1198, 1198, 1198, 1198, 1199, 1199,    0, 1199,
-     1199, 1199, 1199, 1199, 1199, 1199, 1199, 1199, 1200, 1200,
-     1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200,
-     1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201,
-
-     1201, 1201, 1202, 1202, 1202, 1202, 1202, 1202, 1202, 1202,
-     1202, 1202, 1202, 1202, 1203, 1203, 1203, 1203, 1203, 1203,
-     1203, 1203, 1203, 1203, 1203, 1203, 1204, 1204, 1204, 1204,
-     1204, 1204, 1204, 1204, 1204, 1204, 1204, 1204, 1205, 1205,
-     1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205,
-     1206, 1206,    0, 1206, 1206, 1206, 1206, 1206, 1206, 1206,
-     1206, 1206, 1207, 1207,    0, 1207, 1207, 1207, 1207, 1207,
-     1207, 1207, 1207, 1207, 1208, 1208, 1208, 1208, 1208, 1208,
-     1208, 1208, 1208, 1208, 1208, 1208, 1209, 1209, 1209, 1209,
-     1209, 1209, 1209, 1209, 1209, 1209, 1209, 1209, 1210, 1210,
-
-     1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210,
-     1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211,
-     1211, 1211, 1212, 1212, 1212, 1212, 1212, 1212, 1212, 1212,
-     1212, 1212, 1212, 1212, 1213, 1213, 1213, 1213, 1213, 1213,
-     1213, 1213, 1213, 1213, 1213, 1213, 1214, 1214, 1214, 1214,
-     1214, 1214, 1214, 1214, 1214, 1214, 1214, 1214, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161
+        0,    0, 1127, 1126,    0, 1123, 1114,    0,    0, 1117,
+
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+     1127, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132,
+     1132, 1132, 1132, 1132, 1133, 1133, 1133, 1133, 1133, 1133,
+     1133, 1133, 1133, 1133, 1133, 1133, 1133, 1134,    0, 1134,
+     1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134,
+     1135, 1135, 1135, 1135, 1135, 1135, 1135, 1135, 1135, 1135,
+     1135, 1135, 1135, 1136, 1136, 1136, 1136, 1136, 1136, 1136,
+     1136, 1136, 1136, 1136, 1136, 1136, 1137, 1137, 1137, 1137,
+     1137, 1137, 1137, 1137, 1137, 1137, 1137, 1137, 1137, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1139, 1139,
+     1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139,
+     1139, 1140, 1140, 1140, 1140, 1140, 1140, 1140, 1140, 1140,
+     1140, 1140, 1140, 1140, 1141, 1141, 1141, 1141, 1141,    0,
+     1141, 1141, 1141,    0, 1141,    0, 1141, 1142, 1142, 1142,
+     1142, 1142, 1142, 1142, 1142, 1142, 1142, 1142, 1142, 1142,
+     1143,    0,    0,    0,    0,    0,    0,    0, 1143, 1144,
+     1144,    0, 1144, 1144,    0, 1144,    0,    0, 1144, 1144,
+        0, 1144, 1145, 1145, 1145, 1145, 1146, 1146, 1146, 1146,
+     1146, 1146, 1146, 1146, 1146, 1146, 1146, 1146, 1146, 1147,
+
+     1147, 1147, 1147, 1147, 1147, 1147, 1147, 1147, 1147, 1147,
+     1147, 1147, 1148, 1148, 1148, 1148, 1148, 1148, 1148, 1148,
+     1148, 1148, 1148, 1148, 1148, 1149, 1149, 1149,    0, 1149,
+     1149, 1149, 1149, 1149, 1149, 1149, 1149, 1149, 1150,    0,
+     1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150,
+     1150, 1151,    0, 1151, 1151, 1151, 1151, 1151, 1151, 1151,
+     1151, 1151, 1151, 1151, 1152, 1152, 1152, 1152, 1152, 1152,
+     1152, 1152, 1152, 1152, 1152, 1152, 1152, 1153, 1153, 1153,
+     1153, 1153, 1153, 1153, 1153, 1153, 1153, 1153, 1153, 1153,
+     1154, 1154, 1154, 1154, 1154, 1154, 1154, 1154, 1154, 1154,
+
+     1154, 1154, 1154, 1155,    0, 1155, 1155, 1155, 1155, 1155,
+     1155, 1155, 1155, 1155, 1155, 1155, 1156, 1156, 1156, 1156,
+     1156, 1156, 1156, 1156, 1156, 1156, 1156, 1156, 1156, 1157,
+     1157, 1157, 1157, 1157, 1157, 1157, 1157, 1157, 1157, 1157,
+     1157, 1157, 1158, 1158, 1158, 1158, 1158, 1158, 1158, 1158,
+     1158, 1158, 1158, 1158, 1158, 1159,    0, 1159, 1159, 1159,
+     1159, 1159, 1159, 1159, 1159, 1159, 1159, 1159, 1160,    0,
+     1160, 1160, 1160, 1160, 1160, 1160, 1160, 1160, 1160, 1160,
+     1160, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1162, 1162, 1162, 1162, 1162, 1162,
+
+     1162, 1162, 1162, 1162, 1162, 1162, 1162, 1163, 1163, 1163,
+     1163, 1163, 1163, 1163, 1163, 1163, 1163, 1163, 1163, 1163,
+     1164,    0, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164,
+     1164, 1164, 1164, 1165, 1165, 1165, 1165, 1165, 1165, 1165,
+     1165, 1165, 1165, 1165, 1165, 1165, 1166, 1166, 1166, 1166,
+     1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1167,
+     1167, 1167, 1167, 1167, 1167, 1167, 1167, 1167, 1167, 1167,
+     1167, 1167, 1168, 1168, 1168, 1168, 1168, 1168, 1168, 1168,
+     1168, 1168, 1168, 1168, 1168, 1169, 1169, 1169, 1169, 1169,
+     1169, 1169, 1169, 1169, 1169, 1169, 1169, 1169, 1170, 1170,
+
+     1170, 1170, 1170, 1170, 1170, 1170, 1170, 1170, 1170, 1170,
+     1170, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+
+     1131
     } ;
 
@@ -9750,6 +8156,6 @@
 static char *yy_last_accepting_cpos;
 
-extern int fortran_flex_debug;
-int fortran_flex_debug = 0;
+extern int fortran__flex_debug;
+int fortran__flex_debug = 0;
 
 /* The intent behind this definition is that it'll catch
@@ -9760,5 +8166,5 @@
 #define YY_MORE_ADJ 0
 #define YY_RESTORE_YY_MORE_OFFSET
-char *fortrantext;
+char *fortran_text;
 #line 1 "fortran.lex"
 /******************************************************************************/
@@ -9801,17 +8207,17 @@
 
 
-#line 41 "fortran.lex"
+#line 44 "fortran.lex"
 #include <math.h>
 #include <stdlib.h>
 #include <string.h>
-extern FILE * fortranin;
+extern FILE * fortran_in;
 #define MAX_INCLUDE_DEPTH 30
-#define tabsize 6
 YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
-int line_num_fortran=1;
-int line_num_fortran_common=1;
+int line_num_input = 1;
 int newlinef90 = 0;
-char *tmp;
 char tmpc;
+#define PRINT_LINE_NUM()     // { fprintf(stderr,"== Parsing l.%4d...\n", line_num_input); }
+#define INCREMENT_LINE_NUM() { line_num_input++; PRINT_LINE_NUM(); }
+
 /******************************************************************************/
 /**************PETITS PB NON PREVUS *******************************************/
@@ -9823,21 +8229,9 @@
 /*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
 /******************************************************************************/
-#define YY_USER_ACTION \
-        {\
-           if (firstpass == 0) \
-           {\
-              strcat(curbuf,fortrantext); \
-              Save_Length(curbuf,38); \
-              strcpy(motparse,fortrantext);\
-              Save_Length(motparse,32); \
-              colnum = colnum + strlen(motparse);\
-              ECHO; \
-           }\
-           strcpy(motparse1,fortrantext);\
-/*           printf("fortrantext = %s\n",fortrantext);*/\
-        /*if ( firstpass == 1 ) 
-                      printf("fortrantext = %s %d\n",fortrantext,strlen(fortrantext));*/\
-        }
-#line 2979 "fortran.yy.c"
+#define YY_USER_ACTION  if (firstpass == 0) ECHO;
+
+void out_of_donottreat(void);
+
+#line 1826 "fortran.yy.c"
 
 #define INITIAL 0
@@ -9865,29 +8259,29 @@
    These are made visible to non-reentrant scanners for convenience. */
 
-int fortranlex_destroy (void );
-
-int fortranget_debug (void );
-
-void fortranset_debug (int debug_flag  );
-
-YY_EXTRA_TYPE fortranget_extra (void );
-
-void fortranset_extra (YY_EXTRA_TYPE user_defined  );
-
-FILE *fortranget_in (void );
-
-void fortranset_in  (FILE * in_str  );
-
-FILE *fortranget_out (void );
-
-void fortranset_out  (FILE * out_str  );
-
-yy_size_t fortranget_leng (void );
-
-char *fortranget_text (void );
-
-int fortranget_lineno (void );
-
-void fortranset_lineno (int line_number  );
+int fortran_lex_destroy (void );
+
+int fortran_get_debug (void );
+
+void fortran_set_debug (int debug_flag  );
+
+YY_EXTRA_TYPE fortran_get_extra (void );
+
+void fortran_set_extra (YY_EXTRA_TYPE user_defined  );
+
+FILE *fortran_get_in (void );
+
+void fortran_set_in  (FILE * in_str  );
+
+FILE *fortran_get_out (void );
+
+void fortran_set_out  (FILE * out_str  );
+
+yy_size_t fortran_get_leng (void );
+
+char *fortran_get_text (void );
+
+int fortran_get_lineno (void );
+
+void fortran_set_lineno (int line_number  );
 
 /* Macros after this point can all be overridden by user definitions in
@@ -9897,7 +8291,7 @@
 #ifndef YY_SKIP_YYWRAP
 #ifdef __cplusplus
-extern "C" int fortranwrap (void );
+extern "C" int fortran_wrap (void );
 #else
-extern int fortranwrap (void );
+extern int fortran_wrap (void );
 #endif
 #endif
@@ -9933,5 +8327,5 @@
  * we now use fwrite().
  */
-#define ECHO fwrite( fortrantext, fortranleng, 1, fortranout )
+#define ECHO fwrite( fortran_text, fortran_leng, 1, fortran_out )
 #endif
 
@@ -9946,9 +8340,9 @@
 		yy_size_t n; \
 		for ( n = 0; n < max_size && \
-			     (c = getc( fortranin )) != EOF && c != '\n'; ++n ) \
+			     (c = getc( fortran_in )) != EOF && c != '\n'; ++n ) \
 			buf[n] = (char) c; \
 		if ( c == '\n' ) \
 			buf[n++] = (char) c; \
-		if ( c == EOF && ferror( fortranin ) ) \
+		if ( c == EOF && ferror( fortran_in ) ) \
 			YY_FATAL_ERROR( "input in flex scanner failed" ); \
 		result = n; \
@@ -9957,5 +8351,5 @@
 		{ \
 		errno=0; \
-		while ( (result = fread(buf, 1, max_size, fortranin))==0 && ferror(fortranin)) \
+		while ( (result = fread(buf, 1, max_size, fortran_in))==0 && ferror(fortran_in)) \
 			{ \
 			if( errno != EINTR) \
@@ -9965,5 +8359,5 @@
 				} \
 			errno=0; \
-			clearerr(fortranin); \
+			clearerr(fortran_in); \
 			} \
 		}\
@@ -9998,10 +8392,10 @@
 #define YY_DECL_IS_OURS 1
 
-extern int fortranlex (void);
-
-#define YY_DECL int fortranlex (void)
+extern int fortran_lex (void);
+
+#define YY_DECL int fortran_lex (void)
 #endif /* !YY_DECL */
 
-/* Code executed at the beginning of each rule, after fortrantext and fortranleng
+/* Code executed at the beginning of each rule, after fortran_text and fortran_leng
  * have been set up.
  */
@@ -10016,7 +8410,7 @@
 
 #define YY_RULE_SETUP \
-	if ( fortranleng > 0 ) \
+	if ( fortran_leng > 0 ) \
 		YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \
-				(fortrantext[fortranleng - 1] == '\n'); \
+				(fortran_text[fortran_leng - 1] == '\n'); \
 	YY_USER_ACTION
 
@@ -10029,10 +8423,10 @@
 	register int yy_act;
     
-#line 107 "fortran.lex"
+#line 97 "fortran.lex"
 
   if (infixed) BEGIN(fortran77style) ;
-  if (infree) BEGIN(fortran90style)  ;
-
-#line 3174 "fortran.yy.c"
+  if (infree)  BEGIN(fortran90style) ;
+
+#line 2021 "fortran.yy.c"
 
 	if ( !(yy_init) )
@@ -10047,17 +8441,17 @@
 			(yy_start) = 1;	/* first start state */
 
-		if ( ! fortranin )
-			fortranin = stdin;
-
-		if ( ! fortranout )
-			fortranout = stdout;
+		if ( ! fortran_in )
+			fortran_in = stdin;
+
+		if ( ! fortran_out )
+			fortran_out = stdout;
 
 		if ( ! YY_CURRENT_BUFFER ) {
-			fortranensure_buffer_stack ();
+			fortran_ensure_buffer_stack ();
 			YY_CURRENT_BUFFER_LVALUE =
-				fortran_create_buffer(fortranin,YY_BUF_SIZE );
+				fortran__create_buffer(fortran_in,YY_BUF_SIZE );
 		}
 
-		fortran_load_buffer_state( );
+		fortran__load_buffer_state( );
 		}
 
@@ -10066,5 +8460,5 @@
 		yy_cp = (yy_c_buf_p);
 
-		/* Support of fortrantext. */
+		/* Support of fortran_text. */
 		*yy_cp = (yy_hold_char);
 
@@ -10088,5 +8482,5 @@
 				{
 				yy_current_state = (int) yy_def[yy_current_state];
-				if ( yy_current_state >= 1162 )
+				if ( yy_current_state >= 1132 )
 					yy_c = yy_meta[(unsigned int) yy_c];
 				}
@@ -10094,5 +8488,5 @@
 			++yy_cp;
 			}
-		while ( yy_base[yy_current_state] != 9159 );
+		while ( yy_base[yy_current_state] != 4012 );
 
 yy_find_action:
@@ -10120,969 +8514,913 @@
 case 1:
 YY_RULE_SETUP
+#line 101 "fortran.lex"
+{ return TOK_REAL8; }
+	YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 102 "fortran.lex"
+{ return TOK_SUBROUTINE; }
+	YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 103 "fortran.lex"
+{ return TOK_PROGRAM; }
+	YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 104 "fortran.lex"
+{ inallocate = 1; return TOK_ALLOCATE; }
+	YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 105 "fortran.lex"
+{ return TOK_NULLIFY; }
+	YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 106 "fortran.lex"
+{ return TOK_NULL_PTR; }
+	YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 107 "fortran.lex"
+{ inallocate = 1; return TOK_DEALLOCATE; }
+	YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 108 "fortran.lex"
+{ return TOK_RESULT; }
+	YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 109 "fortran.lex"
+{ return TOK_FUNCTION; }
+	YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 110 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ENDPROGRAM;}
+	YY_BREAK
+case 11:
+YY_RULE_SETUP
 #line 111 "fortran.lex"
-return TOK_DEBUT;
-	YY_BREAK
-case 2:
+{ strcpy(yylval.na,fortran_text); return TOK_ENDMODULE; }
+	YY_BREAK
+case 12:
 YY_RULE_SETUP
 #line 112 "fortran.lex"
-return TOK_FIN;
-	YY_BREAK
-case 3:
+{ strcpy(yylval.na,fortran_text); return TOK_ENDSUBROUTINE;}
+	YY_BREAK
+case 13:
 YY_RULE_SETUP
 #line 113 "fortran.lex"
-return TOK_OMP;
-	YY_BREAK
-case 4:
+{ strcpy(yylval.na,fortran_text); return TOK_ENDFUNCTION;}
+	YY_BREAK
+case 14:
 YY_RULE_SETUP
 #line 114 "fortran.lex"
-return TOK_DOLLAR;
-	YY_BREAK
-case 5:
+{ strcpy(yylval.na,fortran_text); return TOK_ENDUNIT;}
+	YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 115 "fortran.lex"
+{ pos_curinclude = setposcur()-9; return TOK_INCLUDE;}
+	YY_BREAK
+case 16:
 YY_RULE_SETUP
 #line 116 "fortran.lex"
-{return TOK_REAL8;}
-	YY_BREAK
-case 6:
-YY_RULE_SETUP
-#line 117 "fortran.lex"
-{return TOK_SUBROUTINE;}
-	YY_BREAK
-case 7:
-YY_RULE_SETUP
-#line 118 "fortran.lex"
-{return TOK_PROGRAM;}
-	YY_BREAK
-case 8:
-YY_RULE_SETUP
-#line 119 "fortran.lex"
-{inallocate = 1; return TOK_ALLOCATE;}
-	YY_BREAK
-case 9:
-YY_RULE_SETUP
-#line 120 "fortran.lex"
-{return TOK_NULLIFY;}
-	YY_BREAK
-case 10:
-YY_RULE_SETUP
-#line 121 "fortran.lex"
-{inallocate = 1; return TOK_DEALLOCATE;}
-	YY_BREAK
-case 11:
+{ strcpy(yylval.na,fortran_text);
+                              tmpc = (char) input(); unput(tmpc);
+                              if ( ( tmpc >= 'a' && tmpc <= 'z' ) ||
+                                   ( tmpc >= 'A' && tmpc <= 'Z' )  )  return TOK_USE;
+                              else                                    return TOK_NAME;
+                            }
+	YY_BREAK
+case 17:
 YY_RULE_SETUP
 #line 122 "fortran.lex"
-{return TOK_RESULT;}
-	YY_BREAK
-case 12:
+{ return TOK_REWIND; }
+	YY_BREAK
+case 18:
 YY_RULE_SETUP
 #line 123 "fortran.lex"
-{return TOK_FUNCTION;}
-	YY_BREAK
-case 13:
+{ return TOK_IMPLICIT; }
+	YY_BREAK
+case 19:
 YY_RULE_SETUP
 #line 124 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDSUBROUTINE;}
-	YY_BREAK
-case 14:
+{ return TOK_NONE; }
+	YY_BREAK
+case 20:
 YY_RULE_SETUP
 #line 125 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDPROGRAM;}
-	YY_BREAK
-case 15:
+{ return TOK_CALL; }
+	YY_BREAK
+case 21:
 YY_RULE_SETUP
 #line 126 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDFUNCTION;}
-	YY_BREAK
-case 16:
+{ return TOK_TRUE; }
+	YY_BREAK
+case 22:
 YY_RULE_SETUP
 #line 127 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDUNIT;}
-	YY_BREAK
-case 17:
+{ return TOK_FALSE; }
+	YY_BREAK
+case 23:
 YY_RULE_SETUP
 #line 128 "fortran.lex"
-return TOK_INCLUDE;
-	YY_BREAK
-case 18:
+{ return TOK_POINT_TO; }
+	YY_BREAK
+case 24:
 YY_RULE_SETUP
 #line 129 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ASSIGNTYPE;}
+	YY_BREAK
+case 25:
+YY_RULE_SETUP
+#line 130 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DASTER; }
+	YY_BREAK
+case 26:
+YY_RULE_SETUP
+#line 131 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_EQV; }
+	YY_BREAK
+case 27:
+YY_RULE_SETUP
+#line 132 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_EQ;  }
+	YY_BREAK
+case 28:
+YY_RULE_SETUP
+#line 133 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_GT;  }
+	YY_BREAK
+case 29:
+YY_RULE_SETUP
+#line 134 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_GE;  }
+	YY_BREAK
+case 30:
+YY_RULE_SETUP
+#line 135 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_LT;  }
+	YY_BREAK
+case 31:
+YY_RULE_SETUP
+#line 136 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_LE;  }
+	YY_BREAK
+case 32:
+YY_RULE_SETUP
+#line 137 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NEQV;}
+	YY_BREAK
+case 33:
+YY_RULE_SETUP
+#line 138 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NE;  }
+	YY_BREAK
+case 34:
+YY_RULE_SETUP
+#line 139 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NOT; }
+	YY_BREAK
+case 35:
+YY_RULE_SETUP
+#line 140 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_OR;  }
+	YY_BREAK
+case 36:
+YY_RULE_SETUP
+#line 141 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_XOR; }
+	YY_BREAK
+case 37:
+YY_RULE_SETUP
+#line 142 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_AND; }
+	YY_BREAK
+case 38:
+YY_RULE_SETUP
+#line 143 "fortran.lex"
+{ return TOK_MODULE; }
+	YY_BREAK
+case 39:
+YY_RULE_SETUP
+#line 144 "fortran.lex"
+{ return TOK_WHILE; }
+	YY_BREAK
+case 40:
+YY_RULE_SETUP
+#line 145 "fortran.lex"
+{ return TOK_CONCURRENT; }
+	YY_BREAK
+case 41:
+YY_RULE_SETUP
+#line 146 "fortran.lex"
+{ return TOK_ENDDO; }
+	YY_BREAK
+case 42:
+YY_RULE_SETUP
+#line 147 "fortran.lex"
+{ return TOK_PLAINDO;}
+	YY_BREAK
+case 43:
+YY_RULE_SETUP
+#line 148 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_REAL; }
+	YY_BREAK
+case 44:
+YY_RULE_SETUP
+#line 149 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_INTEGER; }
+	YY_BREAK
+case 45:
+YY_RULE_SETUP
+#line 150 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_LOGICAL; }
+	YY_BREAK
+case 46:
+YY_RULE_SETUP
+#line 151 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_CHARACTER; }
+	YY_BREAK
+case 47:
+YY_RULE_SETUP
+#line 152 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_HEXA;}
+	YY_BREAK
+case 48:
+YY_RULE_SETUP
+#line 153 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DOUBLEPRECISION; }
+	YY_BREAK
+case 49:
+YY_RULE_SETUP
+#line 154 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DOUBLECOMPLEX; }
+	YY_BREAK
+case 50:
+YY_RULE_SETUP
+#line 155 "fortran.lex"
+{ return TOK_COMPLEX; }
+	YY_BREAK
+case 51:
+YY_RULE_SETUP
+#line 156 "fortran.lex"
+{ return TOK_ALLOCATABLE; }
+	YY_BREAK
+case 52:
+YY_RULE_SETUP
+#line 157 "fortran.lex"
+{ return TOK_CLOSE; }
+	YY_BREAK
+case 53:
+YY_RULE_SETUP
+#line 158 "fortran.lex"
+{ return TOK_INQUIRE; }
+	YY_BREAK
+case 54:
+YY_RULE_SETUP
+#line 159 "fortran.lex"
+{ return TOK_DIMENSION; }
+	YY_BREAK
+case 55:
+YY_RULE_SETUP
+#line 160 "fortran.lex"
+{ return TOK_PAUSE; }
+	YY_BREAK
+case 56:
+YY_RULE_SETUP
+#line 161 "fortran.lex"
+{ return TOK_EQUIVALENCE; }
+	YY_BREAK
+case 57:
+YY_RULE_SETUP
+#line 162 "fortran.lex"
+{ return TOK_STOP; }
+	YY_BREAK
+case 58:
+YY_RULE_SETUP
+#line 163 "fortran.lex"
+{ return TOK_WHERE; }
+	YY_BREAK
+case 59:
+YY_RULE_SETUP
+#line 164 "fortran.lex"
+{ return TOK_ENDWHERE; }
+	YY_BREAK
+case 60:
+YY_RULE_SETUP
+#line 165 "fortran.lex"
+{ return TOK_ELSEWHEREPAR; }
+	YY_BREAK
+case 61:
+YY_RULE_SETUP
+#line 166 "fortran.lex"
+{ return TOK_ELSEWHERE; }
+	YY_BREAK
+case 62:
+YY_RULE_SETUP
+#line 167 "fortran.lex"
+{ return TOK_CONTAINS; }
+	YY_BREAK
+case 63:
+YY_RULE_SETUP
+#line 168 "fortran.lex"
+{ return TOK_ONLY; }
+	YY_BREAK
+case 64:
+YY_RULE_SETUP
+#line 169 "fortran.lex"
+{ return TOK_PARAMETER; }
+	YY_BREAK
+case 65:
+YY_RULE_SETUP
+#line 170 "fortran.lex"
+{ return TOK_RECURSIVE; }
+	YY_BREAK
+case 66:
+YY_RULE_SETUP
+#line 171 "fortran.lex"
+{ return TOK_COMMON; }
+	YY_BREAK
+case 67:
+YY_RULE_SETUP
+#line 172 "fortran.lex"
+{ return TOK_GLOBAL; }
+	YY_BREAK
+case 68:
+YY_RULE_SETUP
+#line 173 "fortran.lex"
+{ return TOK_EXTERNAL; }
+	YY_BREAK
+case 69:
+YY_RULE_SETUP
+#line 174 "fortran.lex"
+{ return TOK_INTENT; }
+	YY_BREAK
+case 70:
+YY_RULE_SETUP
+#line 175 "fortran.lex"
+{ return TOK_POINTER; }
+	YY_BREAK
+case 71:
+YY_RULE_SETUP
+#line 176 "fortran.lex"
+{ return TOK_OPTIONAL; }
+	YY_BREAK
+case 72:
+YY_RULE_SETUP
+#line 177 "fortran.lex"
+{ return TOK_SAVE; }
+	YY_BREAK
+case 73:
+YY_RULE_SETUP
+#line 178 "fortran.lex"
+{ pos_cur_decl = setposcur()-5; return TOK_TYPEPAR; }
+	YY_BREAK
+case 74:
+YY_RULE_SETUP
+#line 179 "fortran.lex"
+{ return TOK_TYPE; }
+	YY_BREAK
+case 75:
+YY_RULE_SETUP
+#line 180 "fortran.lex"
+{ return TOK_ENDTYPE; }
+	YY_BREAK
+case 76:
+YY_RULE_SETUP
+#line 181 "fortran.lex"
+{ if (inallocate == 1) return TOK_STAT; else { strcpy(yylval.na,fortran_text); return TOK_NAME; } }
+	YY_BREAK
+case 77:
+YY_RULE_SETUP
+#line 182 "fortran.lex"
+{ return TOK_OPEN; }
+	YY_BREAK
+case 78:
+YY_RULE_SETUP
+#line 183 "fortran.lex"
+{ return TOK_RETURN; }
+	YY_BREAK
+case 79:
+/* rule 79 can match eol */
+YY_RULE_SETUP
+#line 184 "fortran.lex"
+{ return TOK_EXIT; }
+	YY_BREAK
+case 80:
+YY_RULE_SETUP
+#line 185 "fortran.lex"
+{ return TOK_PRINT; }
+	YY_BREAK
+case 81:
+YY_RULE_SETUP
+#line 186 "fortran.lex"
+{ return TOK_PROCEDURE; }
+	YY_BREAK
+case 82:
+YY_RULE_SETUP
+#line 187 "fortran.lex"
+{ return TOK_READ; }
+	YY_BREAK
+case 83:
+YY_RULE_SETUP
+#line 188 "fortran.lex"
+{ return TOK_NAMELIST; }
+	YY_BREAK
+case 84:
+YY_RULE_SETUP
+#line 189 "fortran.lex"
+{ return TOK_WRITE; }
+	YY_BREAK
+case 85:
+YY_RULE_SETUP
+#line 190 "fortran.lex"
+{ return TOK_FLUSH; }
+	YY_BREAK
+case 86:
+YY_RULE_SETUP
+#line 191 "fortran.lex"
+{ return TOK_TARGET; }
+	YY_BREAK
+case 87:
+YY_RULE_SETUP
+#line 192 "fortran.lex"
+{ return TOK_PUBLIC; }
+	YY_BREAK
+case 88:
+YY_RULE_SETUP
+#line 193 "fortran.lex"
+{ return TOK_PRIVATE; }
+	YY_BREAK
+case 89:
+YY_RULE_SETUP
+#line 194 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_IN; }
+	YY_BREAK
+case 90:
+YY_RULE_SETUP
+#line 195 "fortran.lex"
+{ pos_curdata = setposcur()-strlen(fortran_text); Init_List_Data_Var(); return TOK_DATA; }
+	YY_BREAK
+case 91:
+YY_RULE_SETUP
+#line 196 "fortran.lex"
+{ return TOK_CONTINUE; }
+	YY_BREAK
+case 92:
+YY_RULE_SETUP
+#line 197 "fortran.lex"
+{ return TOK_PLAINGOTO; }
+	YY_BREAK
+case 93:
+YY_RULE_SETUP
+#line 198 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_OUT; }
+	YY_BREAK
+case 94:
+YY_RULE_SETUP
+#line 199 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_INOUT; }
+	YY_BREAK
+case 95:
+YY_RULE_SETUP
+#line 200 "fortran.lex"
+{ return TOK_INTRINSIC; }
+	YY_BREAK
+case 96:
+YY_RULE_SETUP
+#line 201 "fortran.lex"
+{ return TOK_THEN; }
+	YY_BREAK
+case 97:
+YY_RULE_SETUP
+#line 202 "fortran.lex"
+{ return TOK_ELSEIF; }
+	YY_BREAK
+case 98:
+YY_RULE_SETUP
+#line 203 "fortran.lex"
+{ return TOK_ELSE; }
+	YY_BREAK
+case 99:
+YY_RULE_SETUP
+#line 204 "fortran.lex"
+{ return TOK_ENDIF; }
+	YY_BREAK
+case 100:
+YY_RULE_SETUP
+#line 205 "fortran.lex"
+{ return TOK_LOGICALIF; }
+	YY_BREAK
+case 101:
+YY_RULE_SETUP
+#line 206 "fortran.lex"
+{ return TOK_SUM; }
+	YY_BREAK
+case 102:
+YY_RULE_SETUP
+#line 207 "fortran.lex"
+{ return TOK_MAX; }
+	YY_BREAK
+case 103:
+YY_RULE_SETUP
+#line 208 "fortran.lex"
+{ return TOK_TANH; }
+	YY_BREAK
+case 104:
+YY_RULE_SETUP
+#line 209 "fortran.lex"
+{ return TOK_MAXVAL; }
+	YY_BREAK
+case 105:
+YY_RULE_SETUP
+#line 210 "fortran.lex"
+{ return TOK_TRIM; }
+	YY_BREAK
+case 106:
+YY_RULE_SETUP
+#line 211 "fortran.lex"
+{ return TOK_SQRT; }
+	YY_BREAK
+case 107:
+YY_RULE_SETUP
+#line 212 "fortran.lex"
+{ return TOK_SELECTCASE; }
+	YY_BREAK
+case 108:
+YY_RULE_SETUP
+#line 213 "fortran.lex"
+{ return TOK_CASE; }
+	YY_BREAK
+case 109:
+YY_RULE_SETUP
+#line 214 "fortran.lex"
+{ return TOK_DEFAULT; }
+	YY_BREAK
+case 110:
+YY_RULE_SETUP
+#line 215 "fortran.lex"
+{ return TOK_ENDSELECT; }
+	YY_BREAK
+case 111:
+YY_RULE_SETUP
+#line 216 "fortran.lex"
+{ return TOK_FILE; }
+	YY_BREAK
+case 112:
+YY_RULE_SETUP
+#line 217 "fortran.lex"
+{ return TOK_UNIT; }
+	YY_BREAK
+case 113:
+YY_RULE_SETUP
+#line 218 "fortran.lex"
+{ return TOK_FMT; }
+	YY_BREAK
+case 114:
+YY_RULE_SETUP
+#line 219 "fortran.lex"
+{ return TOK_NML; }
+	YY_BREAK
+case 115:
+YY_RULE_SETUP
+#line 220 "fortran.lex"
+{ return TOK_END; }
+	YY_BREAK
+case 116:
+YY_RULE_SETUP
+#line 221 "fortran.lex"
+{ return TOK_EOR; }
+	YY_BREAK
+case 117:
+YY_RULE_SETUP
+#line 222 "fortran.lex"
+{ return TOK_ERR; }
+	YY_BREAK
+case 118:
+YY_RULE_SETUP
+#line 223 "fortran.lex"
+{ return TOK_EXIST; }
+	YY_BREAK
+case 119:
+YY_RULE_SETUP
+#line 224 "fortran.lex"
+{ return TOK_MIN; }
+	YY_BREAK
+case 120:
+YY_RULE_SETUP
+#line 225 "fortran.lex"
+{ return TOK_NINT; }
+	YY_BREAK
+case 121:
+YY_RULE_SETUP
+#line 226 "fortran.lex"
+{ return TOK_FLOAT; }
+	YY_BREAK
+case 122:
+YY_RULE_SETUP
+#line 227 "fortran.lex"
+{ return TOK_EXP; }
+	YY_BREAK
+case 123:
+YY_RULE_SETUP
+#line 228 "fortran.lex"
+{ return TOK_COS; }
+	YY_BREAK
+case 124:
+YY_RULE_SETUP
+#line 229 "fortran.lex"
+{ return TOK_COSH; }
+	YY_BREAK
+case 125:
+YY_RULE_SETUP
+#line 230 "fortran.lex"
+{ return TOK_ACOS; }
+	YY_BREAK
+case 126:
+YY_RULE_SETUP
+#line 231 "fortran.lex"
+{ return TOK_SIN; }
+	YY_BREAK
+case 127:
+YY_RULE_SETUP
+#line 232 "fortran.lex"
+{ return TOK_SINH; }
+	YY_BREAK
+case 128:
+YY_RULE_SETUP
+#line 233 "fortran.lex"
+{ return TOK_ASIN; }
+	YY_BREAK
+case 129:
+YY_RULE_SETUP
+#line 234 "fortran.lex"
+{ return TOK_LOG; }
+	YY_BREAK
+case 130:
+YY_RULE_SETUP
+#line 235 "fortran.lex"
+{ return TOK_TAN; }
+	YY_BREAK
+case 131:
+YY_RULE_SETUP
+#line 236 "fortran.lex"
+{ return TOK_ATAN; }
+	YY_BREAK
+case 132:
+YY_RULE_SETUP
+#line 237 "fortran.lex"
+{ return TOK_CYCLE; }
+	YY_BREAK
+case 133:
+YY_RULE_SETUP
+#line 238 "fortran.lex"
+{ return TOK_ABS; }
+	YY_BREAK
+case 134:
+YY_RULE_SETUP
+#line 239 "fortran.lex"
+{ return TOK_MOD; }
+	YY_BREAK
+case 135:
+YY_RULE_SETUP
+#line 240 "fortran.lex"
+{ return TOK_SIGN; }
+	YY_BREAK
+case 136:
+YY_RULE_SETUP
+#line 241 "fortran.lex"
+{ return TOK_MINLOC; }
+	YY_BREAK
+case 137:
+YY_RULE_SETUP
+#line 242 "fortran.lex"
+{ return TOK_MAXLOC; }
+	YY_BREAK
+case 138:
+YY_RULE_SETUP
+#line 243 "fortran.lex"
+{ return TOK_MINVAL; }
+	YY_BREAK
+case 139:
+YY_RULE_SETUP
+#line 244 "fortran.lex"
+{ return TOK_BACKSPACE; }
+	YY_BREAK
+case 140:
+YY_RULE_SETUP
+#line 245 "fortran.lex"
+{ return TOK_FOURDOTS;  }
+	YY_BREAK
+case 141:
+YY_RULE_SETUP
+#line 246 "fortran.lex"
+{ return TOK_LEFTAB; }
+	YY_BREAK
+case 142:
+YY_RULE_SETUP
+#line 247 "fortran.lex"
+{ return TOK_RIGHTAB; }
+	YY_BREAK
+case 143:
+/* rule 143 can match eol */
+YY_RULE_SETUP
+#line 248 "fortran.lex"
 {
-                            strcpy(yylval.na,fortrantext);
-                            tmpc = input();
-                            unput(tmpc);
-                            if ( (
-                               tmpc >= 'a' && tmpc <= 'z'
-                                  ) || (
-                               tmpc >= 'A' && tmpc <= 'Z'
-                               )  )
-                               {
-                                  return TOK_USE;
-                               }
-                               else
-                               {
-                                  return TOK_NAME;
-                               }
-                         }
-	YY_BREAK
-case 19:
-YY_RULE_SETUP
-#line 146 "fortran.lex"
-{return TOK_REWIND;}
-	YY_BREAK
-case 20:
-YY_RULE_SETUP
-#line 147 "fortran.lex"
-return TOK_IMPLICIT;
-	YY_BREAK
-case 21:
-YY_RULE_SETUP
-#line 148 "fortran.lex"
-return TOK_NONE;
-	YY_BREAK
-case 22:
-YY_RULE_SETUP
-#line 149 "fortran.lex"
-return TOK_CALL;
-	YY_BREAK
-case 23:
-YY_RULE_SETUP
-#line 150 "fortran.lex"
-return TOK_TRUE;
-	YY_BREAK
-case 24:
-YY_RULE_SETUP
-#line 151 "fortran.lex"
-return TOK_FALSE;
-	YY_BREAK
-case 25:
-YY_RULE_SETUP
-#line 152 "fortran.lex"
-{return TOK_POINT_TO;}
-	YY_BREAK
-case 26:
-YY_RULE_SETUP
-#line 153 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DASTER;}
-	YY_BREAK
-case 27:
-YY_RULE_SETUP
-#line 154 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_EQV;}
-	YY_BREAK
-case 28:
-YY_RULE_SETUP
-#line 155 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_EQ;}
-	YY_BREAK
-case 29:
-YY_RULE_SETUP
-#line 156 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_GT;}
-	YY_BREAK
-case 30:
-YY_RULE_SETUP
-#line 157 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_GE;}
-	YY_BREAK
-case 31:
-YY_RULE_SETUP
-#line 158 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_LT;}
-	YY_BREAK
-case 32:
-YY_RULE_SETUP
-#line 159 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_LE;}
-	YY_BREAK
-case 33:
-YY_RULE_SETUP
-#line 160 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NEQV;}
-	YY_BREAK
-case 34:
-YY_RULE_SETUP
-#line 161 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NE;}
-	YY_BREAK
-case 35:
-YY_RULE_SETUP
-#line 162 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NOT;}
-	YY_BREAK
-case 36:
-YY_RULE_SETUP
-#line 163 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_OR;}
-	YY_BREAK
-case 37:
-YY_RULE_SETUP
-#line 164 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_XOR;}
-	YY_BREAK
-case 38:
-YY_RULE_SETUP
-#line 165 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_AND;}
-	YY_BREAK
-case 39:
-YY_RULE_SETUP
-#line 166 "fortran.lex"
-{return TOK_MODULE;}
-	YY_BREAK
-case 40:
-YY_RULE_SETUP
-#line 167 "fortran.lex"
-{return TOK_DOWHILE;}
-	YY_BREAK
-case 41:
-YY_RULE_SETUP
-#line 168 "fortran.lex"
-return TOK_ENDMODULE;
-	YY_BREAK
-case 42:
-YY_RULE_SETUP
-#line 169 "fortran.lex"
-return TOK_ENDDO;
-	YY_BREAK
-case 43:
-YY_RULE_SETUP
-#line 170 "fortran.lex"
-{return TOK_PLAINDO;}
-	YY_BREAK
-case 44:
-YY_RULE_SETUP
-#line 171 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_REAL;}
-	YY_BREAK
-case 45:
-YY_RULE_SETUP
-#line 172 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_INTEGER;}
-	YY_BREAK
-case 46:
-YY_RULE_SETUP
-#line 173 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_LOGICAL;}
-	YY_BREAK
-case 47:
-YY_RULE_SETUP
-#line 174 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHARACTER;}
-	YY_BREAK
-case 48:
-YY_RULE_SETUP
-#line 175 "fortran.lex"
-{return TOK_ALLOCATABLE;}
-	YY_BREAK
-case 49:
-YY_RULE_SETUP
-#line 176 "fortran.lex"
-return TOK_CLOSE;
-	YY_BREAK
-case 50:
-YY_RULE_SETUP
-#line 177 "fortran.lex"
-return TOK_INQUIRE;
-	YY_BREAK
-case 51:
-YY_RULE_SETUP
-#line 178 "fortran.lex"
-{return TOK_DIMENSION;}
-	YY_BREAK
-case 52:
-YY_RULE_SETUP
-#line 179 "fortran.lex"
-return TOK_PAUSE;
-	YY_BREAK
-case 53:
-YY_RULE_SETUP
-#line 180 "fortran.lex"
-return TOK_EQUIVALENCE;
-	YY_BREAK
-case 54:
-YY_RULE_SETUP
-#line 181 "fortran.lex"
-return TOK_STOP;
-	YY_BREAK
-case 55:
-YY_RULE_SETUP
-#line 182 "fortran.lex"
-return TOK_WHERE;
-	YY_BREAK
-case 56:
-YY_RULE_SETUP
-#line 183 "fortran.lex"
-return TOK_ENDWHERE;
-	YY_BREAK
-case 57:
-YY_RULE_SETUP
-#line 184 "fortran.lex"
-return TOK_ELSEWHERE;
-	YY_BREAK
-case 58:
-YY_RULE_SETUP
-#line 185 "fortran.lex"
-{return TOK_COMPLEX;}
-	YY_BREAK
-case 59:
-YY_RULE_SETUP
-#line 186 "fortran.lex"
-{return TOK_CONTAINS;}
-	YY_BREAK
-case 60:
-YY_RULE_SETUP
-#line 187 "fortran.lex"
-{return TOK_ONLY;}
-	YY_BREAK
-case 61:
-YY_RULE_SETUP
-#line 188 "fortran.lex"
-{return TOK_PARAMETER;}
-	YY_BREAK
-case 62:
-YY_RULE_SETUP
-#line 189 "fortran.lex"
-{return TOK_RECURSIVE;}
-	YY_BREAK
-case 63:
-YY_RULE_SETUP
-#line 190 "fortran.lex"
-{return TOK_COMMON;}
-	YY_BREAK
-case 64:
-YY_RULE_SETUP
-#line 191 "fortran.lex"
-{return TOK_GLOBAL;}
-	YY_BREAK
-case 65:
-YY_RULE_SETUP
-#line 192 "fortran.lex"
-{return TOK_EXTERNAL;}
-	YY_BREAK
-case 66:
-YY_RULE_SETUP
-#line 193 "fortran.lex"
-{return TOK_INTENT;}
-	YY_BREAK
-case 67:
-YY_RULE_SETUP
-#line 194 "fortran.lex"
-{return TOK_POINTER;}
-	YY_BREAK
-case 68:
-YY_RULE_SETUP
-#line 195 "fortran.lex"
-{return TOK_OPTIONAL;}
-	YY_BREAK
-case 69:
-YY_RULE_SETUP
-#line 196 "fortran.lex"
-{return TOK_SAVE;}
-	YY_BREAK
-case 70:
-YY_RULE_SETUP
-#line 197 "fortran.lex"
-{return TOK_TYPE;}
-	YY_BREAK
-case 71:
-YY_RULE_SETUP
-#line 198 "fortran.lex"
-{return TOK_TYPEPAR;}
-	YY_BREAK
-case 72:
-YY_RULE_SETUP
-#line 199 "fortran.lex"
-{if (inallocate == 1) return TOK_STAT; else {strcpy(yylval.na,fortrantext);return TOK_NAME;}}
-	YY_BREAK
-case 73:
-YY_RULE_SETUP
-#line 200 "fortran.lex"
-{return TOK_ENDTYPE;}
-	YY_BREAK
-case 74:
-YY_RULE_SETUP
-#line 201 "fortran.lex"
-return TOK_OPEN;
-	YY_BREAK
-case 75:
-YY_RULE_SETUP
-#line 202 "fortran.lex"
-return TOK_RETURN;
-	YY_BREAK
-case 76:
-/* rule 76 can match eol */
-YY_RULE_SETUP
-#line 203 "fortran.lex"
-return TOK_EXIT;
-	YY_BREAK
-case 77:
-YY_RULE_SETUP
-#line 204 "fortran.lex"
-return TOK_PRINT;
-	YY_BREAK
-case 78:
-YY_RULE_SETUP
-#line 205 "fortran.lex"
-{return TOK_PROCEDURE;}
-	YY_BREAK
-case 79:
-YY_RULE_SETUP
-#line 206 "fortran.lex"
-{return TOK_READ;}
-	YY_BREAK
-case 80:
-YY_RULE_SETUP
-#line 207 "fortran.lex"
-{return TOK_NAMELIST;}
-	YY_BREAK
-case 81:
-YY_RULE_SETUP
-#line 208 "fortran.lex"
-{return TOK_WRITE;}
-	YY_BREAK
-case 82:
-YY_RULE_SETUP
-#line 209 "fortran.lex"
-{return TOK_TARGET;}
-	YY_BREAK
-case 83:
-YY_RULE_SETUP
-#line 210 "fortran.lex"
-{return TOK_PUBLIC;}
-	YY_BREAK
-case 84:
-YY_RULE_SETUP
-#line 211 "fortran.lex"
-{return TOK_PRIVATE;}
-	YY_BREAK
-case 85:
-YY_RULE_SETUP
-#line 212 "fortran.lex"
-{strcpy(yylval.nac,fortrantext);return TOK_IN;}
-	YY_BREAK
-case 86:
-YY_RULE_SETUP
-#line 213 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DATA;}
-	YY_BREAK
-case 87:
-YY_RULE_SETUP
-#line 214 "fortran.lex"
-return TOK_CONTINUE;
-	YY_BREAK
-case 88:
-YY_RULE_SETUP
-#line 215 "fortran.lex"
-{return TOK_PLAINGOTO;}
-	YY_BREAK
-case 89:
-YY_RULE_SETUP
-#line 216 "fortran.lex"
-{strcpy(yylval.nac,fortrantext);return TOK_OUT;}
-	YY_BREAK
-case 90:
-YY_RULE_SETUP
-#line 217 "fortran.lex"
-{strcpy(yylval.nac,fortrantext);return TOK_INOUT;}
-	YY_BREAK
-case 91:
-YY_RULE_SETUP
-#line 218 "fortran.lex"
-{return TOK_INTRINSIC;}
-	YY_BREAK
-case 92:
-YY_RULE_SETUP
-#line 219 "fortran.lex"
-{return TOK_THEN;}
-	YY_BREAK
-case 93:
-YY_RULE_SETUP
-#line 220 "fortran.lex"
-{return TOK_ELSEIF;}
-	YY_BREAK
-case 94:
-YY_RULE_SETUP
-#line 221 "fortran.lex"
-{return TOK_ELSE;}
-	YY_BREAK
-case 95:
-YY_RULE_SETUP
-#line 222 "fortran.lex"
-{return TOK_ENDIF;}
-	YY_BREAK
-case 96:
-YY_RULE_SETUP
-#line 223 "fortran.lex"
-{return TOK_LOGICALIF;}
-	YY_BREAK
-case 97:
-YY_RULE_SETUP
-#line 224 "fortran.lex"
-{return TOK_SUM;}
-	YY_BREAK
-case 98:
-YY_RULE_SETUP
-#line 225 "fortran.lex"
-{return TOK_MAX;}
-	YY_BREAK
-case 99:
-YY_RULE_SETUP
-#line 226 "fortran.lex"
-{return TOK_TANH;}
-	YY_BREAK
-case 100:
-YY_RULE_SETUP
-#line 227 "fortran.lex"
-{return TOK_MAXVAL;}
-	YY_BREAK
-case 101:
-YY_RULE_SETUP
-#line 228 "fortran.lex"
-{return TOK_TRIM;}
-	YY_BREAK
-case 102:
-YY_RULE_SETUP
-#line 229 "fortran.lex"
-{return TOK_SQRT;}
-	YY_BREAK
-case 103:
-YY_RULE_SETUP
-#line 230 "fortran.lex"
-{return TOK_SELECTCASE;}
-	YY_BREAK
-case 104:
-YY_RULE_SETUP
-#line 231 "fortran.lex"
-{return TOK_CASE;}
-	YY_BREAK
-case 105:
-YY_RULE_SETUP
-#line 232 "fortran.lex"
-{return TOK_CASEDEFAULT;}
-	YY_BREAK
-case 106:
-YY_RULE_SETUP
-#line 233 "fortran.lex"
-{return TOK_ENDSELECT;}
-	YY_BREAK
-case 107:
-YY_RULE_SETUP
-#line 234 "fortran.lex"
-{return TOK_FILE;}
-	YY_BREAK
-case 108:
-YY_RULE_SETUP
-#line 235 "fortran.lex"
-{return TOK_END;}
-	YY_BREAK
-case 109:
-YY_RULE_SETUP
-#line 236 "fortran.lex"
-{return TOK_ERR;}
-	YY_BREAK
-case 110:
-YY_RULE_SETUP
-#line 237 "fortran.lex"
-{return TOK_EXIST;}
-	YY_BREAK
-case 111:
-YY_RULE_SETUP
-#line 238 "fortran.lex"
-{return TOK_MIN;}
-	YY_BREAK
-case 112:
-YY_RULE_SETUP
-#line 239 "fortran.lex"
-{return TOK_NINT;}
-	YY_BREAK
-case 113:
-YY_RULE_SETUP
-#line 240 "fortran.lex"
-{return TOK_FLOAT;}
-	YY_BREAK
-case 114:
-YY_RULE_SETUP
-#line 241 "fortran.lex"
-{return TOK_EXP;}
-	YY_BREAK
-case 115:
-YY_RULE_SETUP
-#line 242 "fortran.lex"
-{return TOK_COS;}
-	YY_BREAK
-case 116:
-YY_RULE_SETUP
-#line 243 "fortran.lex"
-{return TOK_COSH;}
-	YY_BREAK
-case 117:
-YY_RULE_SETUP
-#line 244 "fortran.lex"
-{return TOK_ACOS;}
-	YY_BREAK
-case 118:
-YY_RULE_SETUP
-#line 245 "fortran.lex"
-{return TOK_SIN;}
-	YY_BREAK
-case 119:
-YY_RULE_SETUP
-#line 246 "fortran.lex"
-{return TOK_SINH;}
-	YY_BREAK
-case 120:
-YY_RULE_SETUP
-#line 247 "fortran.lex"
-{return TOK_ASIN;}
-	YY_BREAK
-case 121:
-YY_RULE_SETUP
-#line 248 "fortran.lex"
-{return TOK_LOG;}
-	YY_BREAK
-case 122:
-YY_RULE_SETUP
-#line 249 "fortran.lex"
-{return TOK_TAN;}
-	YY_BREAK
-case 123:
+                              return TOK_FORMAT; }
+	YY_BREAK
+case 144:
 YY_RULE_SETUP
 #line 250 "fortran.lex"
-{return TOK_ATAN;}
-	YY_BREAK
-case 124:
+{ strcpy(yylval.na,fortran_text); return TOK_SLASH; }
+	YY_BREAK
+case 145:
 YY_RULE_SETUP
 #line 251 "fortran.lex"
-{return TOK_CYCLE;}
-	YY_BREAK
-case 125:
+{ strcpy(yylval.na,fortran_text); return TOK_DSLASH; }
+	YY_BREAK
+case 146:
+/* rule 146 can match eol */
 YY_RULE_SETUP
 #line 252 "fortran.lex"
-{return TOK_ABS;}
-	YY_BREAK
-case 126:
-YY_RULE_SETUP
-#line 253 "fortran.lex"
-{return TOK_MOD;}
-	YY_BREAK
-case 127:
+{
+                              strcpy(yylval.na,fortran_text); return TOK_CHAR_CUT; }
+	YY_BREAK
+case 147:
+/* rule 147 can match eol */
 YY_RULE_SETUP
 #line 254 "fortran.lex"
-{return TOK_SIGN;}
-	YY_BREAK
-case 128:
+{ strcpy(yylval.na,fortran_text);return TOK_CHAR_CONSTANT; }
+	YY_BREAK
+case 148:
+/* rule 148 can match eol */
 YY_RULE_SETUP
 #line 255 "fortran.lex"
-{return TOK_MINLOC;}
-	YY_BREAK
-case 129:
+{ strcpy(yylval.na,fortran_text);return TOK_CHAR_MESSAGE; }
+	YY_BREAK
+case 149:
 YY_RULE_SETUP
 #line 256 "fortran.lex"
-{return TOK_MAXLOC;}
-	YY_BREAK
-case 130:
+{ BEGIN(donottreat); }
+	YY_BREAK
+case 150:
+/* rule 150 can match eol */
 YY_RULE_SETUP
 #line 257 "fortran.lex"
-{return TOK_MINVAL;}
-	YY_BREAK
-case 131:
+{ out_of_donottreat(); return '\n'; }
+	YY_BREAK
+case 151:
 YY_RULE_SETUP
 #line 258 "fortran.lex"
-{return TOK_BACKSPACE;}
-	YY_BREAK
-case 132:
+{ strcpy(yylval.na,fortran_text); return TOK_NAME; }
+	YY_BREAK
+case 152:
+/* rule 152 can match eol */
+*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */
+(yy_c_buf_p) = yy_cp -= 1;
+YY_DO_BEFORE_ACTION; /* set up fortran_text again */
 YY_RULE_SETUP
 #line 259 "fortran.lex"
-{return TOK_LEFTAB;}
-	YY_BREAK
-case 133:
-YY_RULE_SETUP
-#line 260 "fortran.lex"
-{return TOK_RIGHTAB;}
-	YY_BREAK
-case 134:
-/* rule 134 can match eol */
+{  // REAL1
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+	YY_BREAK
+case 153:
 YY_RULE_SETUP
 #line 261 "fortran.lex"
-{return TOK_FORMAT;}
-	YY_BREAK
-case 135:
-YY_RULE_SETUP
-#line 262 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DOUBLEPRECISION;}
-	YY_BREAK
-case 136:
+{  // REAL2
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+	YY_BREAK
+case 154:
 YY_RULE_SETUP
 #line 263 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DOUBLECOMPLEX;}
-	YY_BREAK
-case 137:
+{ strcpy(yylval.na,fortran_text); return TOK_CSTINT; }
+	YY_BREAK
+case 155:
 YY_RULE_SETUP
 #line 264 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_SLASH;}
-	YY_BREAK
-case 138:
+{}
+	YY_BREAK
+case 156:
 YY_RULE_SETUP
 #line 265 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DSLASH;}
-	YY_BREAK
-case 139:
-/* rule 139 can match eol */
+{}
+	YY_BREAK
+case 157:
 YY_RULE_SETUP
 #line 266 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_CUT;}
-	YY_BREAK
-case 140:
+{ strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+	YY_BREAK
+case 158:
 YY_RULE_SETUP
 #line 267 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_CONSTANT;}
-	YY_BREAK
-case 141:
+{ strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+	YY_BREAK
+case 159:
 YY_RULE_SETUP
 #line 268 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_MESSAGE;}
-	YY_BREAK
-case 142:
+{ return TOK_SEMICOLON; }
+	YY_BREAK
+case 160:
 YY_RULE_SETUP
 #line 269 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_INT;}
-	YY_BREAK
-case 143:
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 161:
 YY_RULE_SETUP
 #line 270 "fortran.lex"
-{printf("debug interfacer\n");BEGIN(donottreat);}
-	YY_BREAK
-case 144:
-/* rule 144 can match eol */
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 162:
 YY_RULE_SETUP
 #line 271 "fortran.lex"
-{
-						BEGIN(INITIAL);
-                        if (infixed) BEGIN(fortran77style) ;
-                        if (infree) BEGIN(fortran90style)  ;
-                        line_num_fortran++;line_num_fortran_common++;
-                        return '\n';
-						}
-	YY_BREAK
-case 145:
-YY_RULE_SETUP
-#line 278 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NAME;}
-	YY_BREAK
-case 146:
-YY_RULE_SETUP
-#line 279 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREAL;}
-	YY_BREAK
-case 147:
-YY_RULE_SETUP
-#line 280 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREALDP;}
-	YY_BREAK
-case 148:
-YY_RULE_SETUP
-#line 281 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREALQP;}
-	YY_BREAK
-case 149:
-/* rule 149 can match eol */
-*yy_cp = (yy_hold_char); /* undo effects of setting up fortrantext */
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 163:
+YY_RULE_SETUP
+#line 272 "fortran.lex"
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 164:
+/* rule 164 can match eol */
+YY_RULE_SETUP
+#line 273 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; return '\n'; }
+	YY_BREAK
+case 165:
+*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */
 (yy_c_buf_p) = yy_cp -= 1;
-YY_DO_BEFORE_ACTION; /* set up fortrantext again */
-YY_RULE_SETUP
-#line 282 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREAL;}
-	YY_BREAK
-case 150:
-YY_RULE_SETUP
-#line 283 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTINT;}
-	YY_BREAK
-case 151:
-YY_RULE_SETUP
-#line 284 "fortran.lex"
+YY_DO_BEFORE_ACTION; /* set up fortran_text again */
+YY_RULE_SETUP
+#line 274 "fortran.lex"
 {}
 	YY_BREAK
-case 152:
-YY_RULE_SETUP
-#line 285 "fortran.lex"
-{return TOK_QUOTE;}
-	YY_BREAK
-case 153:
-YY_RULE_SETUP
-#line 286 "fortran.lex"
+case 166:
+YY_RULE_SETUP
+#line 275 "fortran.lex"
 {}
 	YY_BREAK
-case 154:
-YY_RULE_SETUP
-#line 287 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return (int) *fortrantext;}
-	YY_BREAK
-case 155:
-YY_RULE_SETUP
-#line 288 "fortran.lex"
-{afterpercent = 1; strcpy(yylval.na,fortrantext);return (int) *fortrantext;}
-	YY_BREAK
-case 156:
-YY_RULE_SETUP
-#line 289 "fortran.lex"
-{return TOK_SEMICOLON;}
-	YY_BREAK
-case 157:
-YY_RULE_SETUP
-#line 290 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 158:
-YY_RULE_SETUP
-#line 291 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 159:
-YY_RULE_SETUP
-#line 292 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 160:
-YY_RULE_SETUP
-#line 293 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 161:
-/* rule 161 can match eol */
-YY_RULE_SETUP
-#line 294 "fortran.lex"
-{colnum=0;line_num_fortran++;line_num_fortran_common++; return (int) *fortrantext;}
-	YY_BREAK
-case 162:
-*yy_cp = (yy_hold_char); /* undo effects of setting up fortrantext */
-(yy_c_buf_p) = yy_cp -= 1;
-YY_DO_BEFORE_ACTION; /* set up fortrantext again */
-YY_RULE_SETUP
-#line 295 "fortran.lex"
-
-	YY_BREAK
-case 163:
-YY_RULE_SETUP
-#line 296 "fortran.lex"
-{if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0;}
-	YY_BREAK
-case 164:
-YY_RULE_SETUP
-#line 297 "fortran.lex"
-
-	YY_BREAK
-case 165:
-YY_RULE_SETUP
-#line 298 "fortran.lex"
-{colnum=colnum-1+tabsize;}
-	YY_BREAK
-case 166:
-YY_RULE_SETUP
-#line 299 "fortran.lex"
-;
-	YY_BREAK
 case 167:
-/* rule 167 can match eol */
-YY_RULE_SETUP
-#line 300 "fortran.lex"
-{line_num_fortran++;line_num_fortran_common++;newlinef90=1;colnum=0;}
+YY_RULE_SETUP
+#line 276 "fortran.lex"
+{ if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0; }
 	YY_BREAK
 case 168:
 /* rule 168 can match eol */
 YY_RULE_SETUP
-#line 301 "fortran.lex"
-{line_num_fortran++;line_num_fortran_common++;colnum=0;}
+#line 277 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; newlinef90=1; }
 	YY_BREAK
 case 169:
 /* rule 169 can match eol */
 YY_RULE_SETUP
-#line 302 "fortran.lex"
-{
-                           convert2lower(motparse1);
-                           if ( strncasecmp(motparse1,"contains",8) == 0 )
-                           {
-                              return TOK_CONTAINS;
-                           }
-                           else
-                           {
-                            /*  colnum=0;line_num_fortran++;line_num_fortran_common++;*/
-                             if ( !strcasecmp(motparse1,"C$AGRIF_DO_NOT_TREAT\n")) 
-                             return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                             unput('\n');
-                           }
-                         }
+#line 278 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
 	YY_BREAK
 case 170:
 /* rule 170 can match eol */
 YY_RULE_SETUP
-#line 317 "fortran.lex"
-{
-                           convert2lower(&motparse1[1]);
-                           if ( strncasecmp(&motparse1[1],"contains",8) == 0 )
-                           {
-                              return TOK_CONTAINS;
-                           }
-                           else
-                           {
-                             /* colnum=0;line_num_fortran++;line_num_fortran_common++;*/
-                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_DO_NOT_TREAT\n")) 
-                             return TOK_DONOTTREAT;
-                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                             unput('\n');
-                           }
-                         }                            
+#line 280 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; BEGIN(donottreat); }
 	YY_BREAK
 case 171:
 /* rule 171 can match eol */
 YY_RULE_SETUP
-#line 332 "fortran.lex"
-{
-						BEGIN(donottreat);
-						}
+#line 281 "fortran.lex"
+{ out_of_donottreat(); return '\n'; }
 	YY_BREAK
 case 172:
 /* rule 172 can match eol */
 YY_RULE_SETUP
-#line 335 "fortran.lex"
-{
-						BEGIN(INITIAL);
-                        if (infixed) BEGIN(fortran77style) ;
-                        if (infree) BEGIN(fortran90style)  ;
-                        line_num_fortran++;line_num_fortran_common++;
-                        return '\n';
-						}
+#line 282 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
 	YY_BREAK
 case 173:
 /* rule 173 can match eol */
 YY_RULE_SETUP
-#line 342 "fortran.lex"
-{line_num_fortran++;line_num_fortran_common++;}
+#line 283 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
 	YY_BREAK
 case 174:
 /* rule 174 can match eol */
 YY_RULE_SETUP
-#line 343 "fortran.lex"
-{
-                             colnum = 0;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                          }
+#line 284 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
 	YY_BREAK
 case 175:
 YY_RULE_SETUP
-#line 348 "fortran.lex"
-{
-                             colnum = 0;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                          }
+#line 285 "fortran.lex"
+{}
 	YY_BREAK
 case 176:
 YY_RULE_SETUP
-#line 353 "fortran.lex"
+#line 286 "fortran.lex"
 ECHO;
 	YY_BREAK
-#line 4224 "fortran.yy.c"
+#line 3015 "fortran.yy.c"
 case YY_STATE_EOF(INITIAL):
 case YY_STATE_EOF(parameter):
@@ -11106,6 +9444,6 @@
 			/* We're scanning a new file or input source.  It's
 			 * possible that this happened because the user
-			 * just pointed fortranin at a new source and called
-			 * fortranlex().  If so, then we have to assure
+			 * just pointed fortran_in at a new source and called
+			 * fortran_lex().  If so, then we have to assure
 			 * consistency between YY_CURRENT_BUFFER and our
 			 * globals.  Here is the right place to do so, because
@@ -11114,5 +9452,5 @@
 			 */
 			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
-			YY_CURRENT_BUFFER_LVALUE->yy_input_file = fortranin;
+			YY_CURRENT_BUFFER_LVALUE->yy_input_file = fortran_in;
 			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
 			}
@@ -11167,9 +9505,9 @@
 				(yy_did_buffer_switch_on_eof) = 0;
 
-				if ( fortranwrap( ) )
+				if ( fortran_wrap( ) )
 					{
 					/* Note: because we've taken care in
 					 * yy_get_next_buffer() to have set up
-					 * fortrantext, we can now set up
+					 * fortran_text, we can now set up
 					 * yy_c_buf_p so that if some total
 					 * hoser (like flex itself) wants to
@@ -11220,5 +9558,5 @@
 	} /* end of action switch */
 		} /* end of scanning one token */
-} /* end of fortranlex */
+} /* end of fortran_lex */
 
 /* yy_get_next_buffer - try to read in a new buffer
@@ -11298,5 +9636,5 @@
 				b->yy_ch_buf = (char *)
 					/* Include room in for 2 EOB chars. */
-					fortranrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
+					fortran_realloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
 				}
 			else
@@ -11330,5 +9668,5 @@
 			{
 			ret_val = EOB_ACT_END_OF_FILE;
-			fortranrestart(fortranin  );
+			fortran_restart(fortran_in  );
 			}
 
@@ -11347,5 +9685,5 @@
 		/* Extend the array by 50%, plus the number we really need. */
 		yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
-		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) fortranrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
+		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) fortran_realloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
 		if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
 			YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
@@ -11382,5 +9720,5 @@
 			{
 			yy_current_state = (int) yy_def[yy_current_state];
-			if ( yy_current_state >= 1162 )
+			if ( yy_current_state >= 1132 )
 				yy_c = yy_meta[(unsigned int) yy_c];
 			}
@@ -11410,9 +9748,9 @@
 		{
 		yy_current_state = (int) yy_def[yy_current_state];
-		if ( yy_current_state >= 1162 )
+		if ( yy_current_state >= 1132 )
 			yy_c = yy_meta[(unsigned int) yy_c];
 		}
 	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
-	yy_is_jam = (yy_current_state == 1161);
+	yy_is_jam = (yy_current_state == 1131);
 
 	return yy_is_jam ? 0 : yy_current_state;
@@ -11425,5 +9763,5 @@
     yy_cp = (yy_c_buf_p);
 
-	/* undo effects of setting up fortrantext */
+	/* undo effects of setting up fortran_text */
 	*yy_cp = (yy_hold_char);
 
@@ -11497,5 +9835,5 @@
 
 					/* Reset buffer status. */
-					fortranrestart(fortranin );
+					fortran_restart(fortran_in );
 
 					/*FALLTHROUGH*/
@@ -11503,5 +9841,5 @@
 				case EOB_ACT_END_OF_FILE:
 					{
-					if ( fortranwrap( ) )
+					if ( fortran_wrap( ) )
 						return 0;
 
@@ -11523,5 +9861,5 @@
 
 	c = *(unsigned char *) (yy_c_buf_p);	/* cast for 8-bit char's */
-	*(yy_c_buf_p) = '\0';	/* preserve fortrantext */
+	*(yy_c_buf_p) = '\0';	/* preserve fortran_text */
 	(yy_hold_char) = *++(yy_c_buf_p);
 
@@ -11537,15 +9875,15 @@
  * @note This function does not reset the start condition to @c INITIAL .
  */
-    void fortranrestart  (FILE * input_file )
+    void fortran_restart  (FILE * input_file )
 {
     
 	if ( ! YY_CURRENT_BUFFER ){
-        fortranensure_buffer_stack ();
+        fortran_ensure_buffer_stack ();
 		YY_CURRENT_BUFFER_LVALUE =
-            fortran_create_buffer(fortranin,YY_BUF_SIZE );
+            fortran__create_buffer(fortran_in,YY_BUF_SIZE );
 	}
 
-	fortran_init_buffer(YY_CURRENT_BUFFER,input_file );
-	fortran_load_buffer_state( );
+	fortran__init_buffer(YY_CURRENT_BUFFER,input_file );
+	fortran__load_buffer_state( );
 }
 
@@ -11554,13 +9892,13 @@
  * 
  */
-    void fortran_switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
+    void fortran__switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
 {
     
 	/* TODO. We should be able to replace this entire function body
 	 * with
-	 *		fortranpop_buffer_state();
-	 *		fortranpush_buffer_state(new_buffer);
+	 *		fortran_pop_buffer_state();
+	 *		fortran_push_buffer_state(new_buffer);
      */
-	fortranensure_buffer_stack ();
+	fortran_ensure_buffer_stack ();
 	if ( YY_CURRENT_BUFFER == new_buffer )
 		return;
@@ -11575,9 +9913,9 @@
 
 	YY_CURRENT_BUFFER_LVALUE = new_buffer;
-	fortran_load_buffer_state( );
+	fortran__load_buffer_state( );
 
 	/* We don't actually know whether we did this switch during
-	 * EOF (fortranwrap()) processing, but the only time this flag
-	 * is looked at is after fortranwrap() is called, so it's safe
+	 * EOF (fortran_wrap()) processing, but the only time this flag
+	 * is looked at is after fortran_wrap() is called, so it's safe
 	 * to go ahead and always set it.
 	 */
@@ -11585,9 +9923,9 @@
 }
 
-static void fortran_load_buffer_state  (void)
+static void fortran__load_buffer_state  (void)
 {
     	(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
 	(yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
-	fortranin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+	fortran_in = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
 	(yy_hold_char) = *(yy_c_buf_p);
 }
@@ -11599,11 +9937,11 @@
  * @return the allocated buffer state.
  */
-    YY_BUFFER_STATE fortran_create_buffer  (FILE * file, int  size )
+    YY_BUFFER_STATE fortran__create_buffer  (FILE * file, int  size )
 {
 	YY_BUFFER_STATE b;
     
-	b = (YY_BUFFER_STATE) fortranalloc(sizeof( struct yy_buffer_state )  );
+	b = (YY_BUFFER_STATE) fortran_alloc(sizeof( struct yy_buffer_state )  );
 	if ( ! b )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_create_buffer()" );
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__create_buffer()" );
 
 	b->yy_buf_size = size;
@@ -11612,11 +9950,11 @@
 	 * we need to put in 2 end-of-buffer characters.
 	 */
-	b->yy_ch_buf = (char *) fortranalloc(b->yy_buf_size + 2  );
+	b->yy_ch_buf = (char *) fortran_alloc(b->yy_buf_size + 2  );
 	if ( ! b->yy_ch_buf )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_create_buffer()" );
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__create_buffer()" );
 
 	b->yy_is_our_buffer = 1;
 
-	fortran_init_buffer(b,file );
+	fortran__init_buffer(b,file );
 
 	return b;
@@ -11624,8 +9962,8 @@
 
 /** Destroy the buffer.
- * @param b a buffer created with fortran_create_buffer()
+ * @param b a buffer created with fortran__create_buffer()
  * 
  */
-    void fortran_delete_buffer (YY_BUFFER_STATE  b )
+    void fortran__delete_buffer (YY_BUFFER_STATE  b )
 {
     
@@ -11637,7 +9975,7 @@
 
 	if ( b->yy_is_our_buffer )
-		fortranfree((void *) b->yy_ch_buf  );
-
-	fortranfree((void *) b  );
+		fortran_free((void *) b->yy_ch_buf  );
+
+	fortran_free((void *) b  );
 }
 
@@ -11648,18 +9986,18 @@
 /* Initializes or reinitializes a buffer.
  * This function is sometimes called more than once on the same buffer,
- * such as during a fortranrestart() or at EOF.
+ * such as during a fortran_restart() or at EOF.
  */
-    static void fortran_init_buffer  (YY_BUFFER_STATE  b, FILE * file )
+    static void fortran__init_buffer  (YY_BUFFER_STATE  b, FILE * file )
 
 {
 	int oerrno = errno;
     
-	fortran_flush_buffer(b );
+	fortran__flush_buffer(b );
 
 	b->yy_input_file = file;
 	b->yy_fill_buffer = 1;
 
-    /* If b is the current buffer, then fortran_init_buffer was _probably_
-     * called from fortranrestart() or through yy_get_next_buffer.
+    /* If b is the current buffer, then fortran__init_buffer was _probably_
+     * called from fortran_restart() or through yy_get_next_buffer.
      * In that case, we don't want to reset the lineno or column.
      */
@@ -11678,5 +10016,5 @@
  * 
  */
-    void fortran_flush_buffer (YY_BUFFER_STATE  b )
+    void fortran__flush_buffer (YY_BUFFER_STATE  b )
 {
     	if ( ! b )
@@ -11698,5 +10036,5 @@
 
 	if ( b == YY_CURRENT_BUFFER )
-		fortran_load_buffer_state( );
+		fortran__load_buffer_state( );
 }
 
@@ -11707,12 +10045,12 @@
  *  
  */
-void fortranpush_buffer_state (YY_BUFFER_STATE new_buffer )
+void fortran_push_buffer_state (YY_BUFFER_STATE new_buffer )
 {
     	if (new_buffer == NULL)
 		return;
 
-	fortranensure_buffer_stack();
-
-	/* This block is copied from fortran_switch_to_buffer. */
+	fortran_ensure_buffer_stack();
+
+	/* This block is copied from fortran__switch_to_buffer. */
 	if ( YY_CURRENT_BUFFER )
 		{
@@ -11728,6 +10066,6 @@
 	YY_CURRENT_BUFFER_LVALUE = new_buffer;
 
-	/* copied from fortran_switch_to_buffer. */
-	fortran_load_buffer_state( );
+	/* copied from fortran__switch_to_buffer. */
+	fortran__load_buffer_state( );
 	(yy_did_buffer_switch_on_eof) = 1;
 }
@@ -11737,10 +10075,10 @@
  *  
  */
-void fortranpop_buffer_state (void)
+void fortran_pop_buffer_state (void)
 {
     	if (!YY_CURRENT_BUFFER)
 		return;
 
-	fortran_delete_buffer(YY_CURRENT_BUFFER );
+	fortran__delete_buffer(YY_CURRENT_BUFFER );
 	YY_CURRENT_BUFFER_LVALUE = NULL;
 	if ((yy_buffer_stack_top) > 0)
@@ -11748,5 +10086,5 @@
 
 	if (YY_CURRENT_BUFFER) {
-		fortran_load_buffer_state( );
+		fortran__load_buffer_state( );
 		(yy_did_buffer_switch_on_eof) = 1;
 	}
@@ -11756,5 +10094,5 @@
  *  Guarantees space for at least one push.
  */
-static void fortranensure_buffer_stack (void)
+static void fortran_ensure_buffer_stack (void)
 {
 	yy_size_t num_to_alloc;
@@ -11767,9 +10105,9 @@
          */
 		num_to_alloc = 1;
-		(yy_buffer_stack) = (struct yy_buffer_state**)fortranalloc
+		(yy_buffer_stack) = (struct yy_buffer_state**)fortran_alloc
 								(num_to_alloc * sizeof(struct yy_buffer_state*)
 								);
 		if ( ! (yy_buffer_stack) )
-			YY_FATAL_ERROR( "out of dynamic memory in fortranensure_buffer_stack()" );
+			YY_FATAL_ERROR( "out of dynamic memory in fortran_ensure_buffer_stack()" );
 								  
 		memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
@@ -11786,10 +10124,10 @@
 
 		num_to_alloc = (yy_buffer_stack_max) + grow_size;
-		(yy_buffer_stack) = (struct yy_buffer_state**)fortranrealloc
+		(yy_buffer_stack) = (struct yy_buffer_state**)fortran_realloc
 								((yy_buffer_stack),
 								num_to_alloc * sizeof(struct yy_buffer_state*)
 								);
 		if ( ! (yy_buffer_stack) )
-			YY_FATAL_ERROR( "out of dynamic memory in fortranensure_buffer_stack()" );
+			YY_FATAL_ERROR( "out of dynamic memory in fortran_ensure_buffer_stack()" );
 
 		/* zero only the new slots.*/
@@ -11805,5 +10143,5 @@
  * @return the newly allocated buffer state object. 
  */
-YY_BUFFER_STATE fortran_scan_buffer  (char * base, yy_size_t  size )
+YY_BUFFER_STATE fortran__scan_buffer  (char * base, yy_size_t  size )
 {
 	YY_BUFFER_STATE b;
@@ -11815,7 +10153,7 @@
 		return 0;
 
-	b = (YY_BUFFER_STATE) fortranalloc(sizeof( struct yy_buffer_state )  );
+	b = (YY_BUFFER_STATE) fortran_alloc(sizeof( struct yy_buffer_state )  );
 	if ( ! b )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_scan_buffer()" );
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__scan_buffer()" );
 
 	b->yy_buf_size = size - 2;	/* "- 2" to take care of EOB's */
@@ -11829,10 +10167,10 @@
 	b->yy_buffer_status = YY_BUFFER_NEW;
 
-	fortran_switch_to_buffer(b  );
+	fortran__switch_to_buffer(b  );
 
 	return b;
 }
 
-/** Setup the input buffer state to scan a string. The next call to fortranlex() will
+/** Setup the input buffer state to scan a string. The next call to fortran_lex() will
  * scan from a @e copy of @a str.
  * @param yystr a NUL-terminated string to scan
@@ -11840,13 +10178,13 @@
  * @return the newly allocated buffer state object.
  * @note If you want to scan bytes that may contain NUL values, then use
- *       fortran_scan_bytes() instead.
+ *       fortran__scan_bytes() instead.
  */
-YY_BUFFER_STATE fortran_scan_string (yyconst char * yystr )
+YY_BUFFER_STATE fortran__scan_string (yyconst char * yystr )
 {
     
-	return fortran_scan_bytes(yystr,strlen(yystr) );
+	return fortran__scan_bytes(yystr,strlen(yystr) );
 }
 
-/** Setup the input buffer state to scan the given bytes. The next call to fortranlex() will
+/** Setup the input buffer state to scan the given bytes. The next call to fortran_lex() will
  * scan from a @e copy of @a bytes.
  * @param bytes the byte buffer to scan
@@ -11855,5 +10193,5 @@
  * @return the newly allocated buffer state object.
  */
-YY_BUFFER_STATE fortran_scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
+YY_BUFFER_STATE fortran__scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
 {
 	YY_BUFFER_STATE b;
@@ -11863,7 +10201,7 @@
 	/* Get memory for full buffer, including space for trailing EOB's. */
 	n = _yybytes_len + 2;
-	buf = (char *) fortranalloc(n  );
+	buf = (char *) fortran_alloc(n  );
 	if ( ! buf )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_scan_bytes()" );
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__scan_bytes()" );
 
 	for ( i = 0; i < _yybytes_len; ++i )
@@ -11872,7 +10210,7 @@
 	buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
 
-	b = fortran_scan_buffer(buf,n );
+	b = fortran__scan_buffer(buf,n );
 	if ( ! b )
-		YY_FATAL_ERROR( "bad buffer in fortran_scan_bytes()" );
+		YY_FATAL_ERROR( "bad buffer in fortran__scan_bytes()" );
 
 	/* It's okay to grow etc. this buffer, and we should throw it
@@ -11900,12 +10238,12 @@
 	do \
 		{ \
-		/* Undo effects of setting up fortrantext. */ \
+		/* Undo effects of setting up fortran_text. */ \
         int yyless_macro_arg = (n); \
         YY_LESS_LINENO(yyless_macro_arg);\
-		fortrantext[fortranleng] = (yy_hold_char); \
-		(yy_c_buf_p) = fortrantext + yyless_macro_arg; \
+		fortran_text[fortran_leng] = (yy_hold_char); \
+		(yy_c_buf_p) = fortran_text + yyless_macro_arg; \
 		(yy_hold_char) = *(yy_c_buf_p); \
 		*(yy_c_buf_p) = '\0'; \
-		fortranleng = yyless_macro_arg; \
+		fortran_leng = yyless_macro_arg; \
 		} \
 	while ( 0 )
@@ -11916,8 +10254,8 @@
  * 
  */
-int fortranget_lineno  (void)
+int fortran_get_lineno  (void)
 {
         
-    return fortranlineno;
+    return fortran_lineno;
 }
 
@@ -11925,7 +10263,7 @@
  * 
  */
-FILE *fortranget_in  (void)
+FILE *fortran_get_in  (void)
 {
-        return fortranin;
+        return fortran_in;
 }
 
@@ -11933,7 +10271,7 @@
  * 
  */
-FILE *fortranget_out  (void)
+FILE *fortran_get_out  (void)
 {
-        return fortranout;
+        return fortran_out;
 }
 
@@ -11941,7 +10279,7 @@
  * 
  */
-yy_size_t fortranget_leng  (void)
+yy_size_t fortran_get_leng  (void)
 {
-        return fortranleng;
+        return fortran_leng;
 }
 
@@ -11950,7 +10288,7 @@
  */
 
-char *fortranget_text  (void)
+char *fortran_get_text  (void)
 {
-        return fortrantext;
+        return fortran_text;
 }
 
@@ -11959,8 +10297,8 @@
  * 
  */
-void fortranset_lineno (int  line_number )
+void fortran_set_lineno (int  line_number )
 {
     
-    fortranlineno = line_number;
+    fortran_lineno = line_number;
 }
 
@@ -11969,24 +10307,24 @@
  * @param in_str A readable stream.
  * 
- * @see fortran_switch_to_buffer
+ * @see fortran__switch_to_buffer
  */
-void fortranset_in (FILE *  in_str )
+void fortran_set_in (FILE *  in_str )
 {
-        fortranin = in_str ;
+        fortran_in = in_str ;
 }
 
-void fortranset_out (FILE *  out_str )
+void fortran_set_out (FILE *  out_str )
 {
-        fortranout = out_str ;
+        fortran_out = out_str ;
 }
 
-int fortranget_debug  (void)
+int fortran_get_debug  (void)
 {
-        return fortran_flex_debug;
+        return fortran__flex_debug;
 }
 
-void fortranset_debug (int  bdebug )
+void fortran_set_debug (int  bdebug )
 {
-        fortran_flex_debug = bdebug ;
+        fortran__flex_debug = bdebug ;
 }
 
@@ -11994,5 +10332,5 @@
 {
         /* Initialization is the same as for the non-reentrant scanner.
-     * This function is called from fortranlex_destroy(), so don't allocate here.
+     * This function is called from fortran_lex_destroy(), so don't allocate here.
      */
 
@@ -12006,34 +10344,34 @@
 /* Defined in main.c */
 #ifdef YY_STDINIT
-    fortranin = stdin;
-    fortranout = stdout;
+    fortran_in = stdin;
+    fortran_out = stdout;
 #else
-    fortranin = (FILE *) 0;
-    fortranout = (FILE *) 0;
+    fortran_in = (FILE *) 0;
+    fortran_out = (FILE *) 0;
 #endif
 
     /* For future reference: Set errno on error, since we are called by
-     * fortranlex_init()
+     * fortran_lex_init()
      */
     return 0;
 }
 
-/* fortranlex_destroy is for both reentrant and non-reentrant scanners. */
-int fortranlex_destroy  (void)
+/* fortran_lex_destroy is for both reentrant and non-reentrant scanners. */
+int fortran_lex_destroy  (void)
 {
     
     /* Pop the buffer stack, destroying each element. */
 	while(YY_CURRENT_BUFFER){
-		fortran_delete_buffer(YY_CURRENT_BUFFER  );
+		fortran__delete_buffer(YY_CURRENT_BUFFER  );
 		YY_CURRENT_BUFFER_LVALUE = NULL;
-		fortranpop_buffer_state();
+		fortran_pop_buffer_state();
 	}
 
 	/* Destroy the stack itself. */
-	fortranfree((yy_buffer_stack) );
+	fortran_free((yy_buffer_stack) );
 	(yy_buffer_stack) = NULL;
 
     /* Reset the globals. This is important in a non-reentrant scanner so the next time
-     * fortranlex() is called, initialization will occur. */
+     * fortran_lex() is called, initialization will occur. */
     yy_init_globals( );
 
@@ -12065,10 +10403,10 @@
 #endif
 
-void *fortranalloc (yy_size_t  size )
+void *fortran_alloc (yy_size_t  size )
 {
 	return (void *) malloc( size );
 }
 
-void *fortranrealloc  (void * ptr, yy_size_t  size )
+void *fortran_realloc  (void * ptr, yy_size_t  size )
 {
 	/* The cast to (char *) in the following accommodates both
@@ -12082,30 +10420,21 @@
 }
 
-void fortranfree (void * ptr )
+void fortran_free (void * ptr )
 {
-	free( (char *) ptr );	/* see fortranrealloc() for (char *) cast */
+	free( (char *) ptr );	/* see fortran_realloc() for (char *) cast */
 }
 
 #define YYTABLES_NAME "yytables"
 
-#line 353 "fortran.lex"
-
-
-
-fortranerror(char *s)
+#line 286 "fortran.lex"
+
+
+
+void out_of_donottreat ( void )
 {
-   if (!strcasecmp(curfile,mainfile))
-   {
-      printf("%s line %d, file %s motclef = %s\n",s,line_num_fortran,curfile,fortrantext);
-   }
-   else
-   {
-      printf("%s line %d, file %s motclef = %s curbuf = %s\n",s,line_num_fortran_common,curfile,fortrantext,curbuf);
-   }
-/*   exit(0);*/
+    BEGIN(INITIAL);
+    if (infixed) BEGIN(fortran77style) ;
+    if (infree)  BEGIN(fortran90style) ;
+    INCREMENT_LINE_NUM() ;
 }
 
-int fortranwrap()
-{
-}
-
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.lex
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.lex	(revision 5659)
+++ 	(revision )
@@ -1,370 +1,0 @@
-/******************************************************************************/
-/*                                                                            */
-/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
-/*                                                                            */
-/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
-/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
-/* This software is governed by the CeCILL-C license under French law and     */
-/* abiding by the rules of distribution of free software.  You can  use,      */
-/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
-/* license as circulated by CEA, CNRS and INRIA at the following URL          */
-/* "http://www.cecill.info".                                                  */
-/*                                                                            */
-/* As a counterpart to the access to the source code and  rights to copy,     */
-/* modify and redistribute granted by the license, users are provided only    */
-/* with a limited warranty  and the software's author,  the holder of the     */
-/* economic rights,  and the successive licensors  have only  limited         */
-/* liability.                                                                 */
-/*                                                                            */
-/* In this respect, the user's attention is drawn to the risks associated     */
-/* with loading,  using,  modifying and/or developing or reproducing the      */
-/* software by the user in light of its specific status of free software,     */
-/* that may mean  that it is complicated to manipulate,  and  that  also      */
-/* therefore means  that it is reserved for developers  and  experienced      */
-/* professionals having in-depth computer knowledge. Users are therefore      */
-/* encouraged to load and test the software's suitability as regards their    */
-/* requirements in conditions enabling the security of their systems and/or   */
-/* data to be ensured and,  more generally, to use and operate it in the      */
-/* same conditions as regards security.                                       */
-/*                                                                            */
-/* The fact that you are presently reading this means that you have had       */
-/* knowledge of the CeCILL-C license and that you accept its terms.           */
-/******************************************************************************/
-/* version 1.7                                                                */
-/******************************************************************************/
-%x parameter
-%s character
-%x donottreat
-%s fortran77style
-%s fortran90style
-%{
-#include <math.h>
-#include <stdlib.h>
-#include <string.h>
-extern FILE * yyin;
-#define MAX_INCLUDE_DEPTH 30
-#define tabsize 6
-YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
-int line_num_fortran=1;
-int line_num_fortran_common=1;
-int newlinef90 = 0;
-char *tmp;
-char tmpc;
-/******************************************************************************/
-/**************PETITS PB NON PREVUS *******************************************/
-/******************************************************************************/
-/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
-/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
-/*            de la 7eme et le debut de la ligne de commande                  */
-/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
-/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
-/******************************************************************************/
-#define YY_USER_ACTION \
-        {\
-           if (firstpass == 0) \
-           {\
-              strcat(curbuf,yytext); \
-              Save_Length(curbuf,38); \
-              strcpy(motparse,yytext);\
-              Save_Length(motparse,32); \
-              colnum = colnum + strlen(motparse);\
-              ECHO; \
-           }\
-           strcpy(motparse1,yytext);\
-/*           printf("yytext = %s\n",yytext);*/\
-        /*if ( firstpass == 1 ) 
-                      printf("yytext = %s %d\n",yytext,strlen(yytext));*/\
-        }
-%}
-AGRIFDEB "Agrif_debut"
-AGRIFFIN "Agrif_fin"
-REAL8 "real*8"[ \t]*"(a-h,o-z)"
-NOTTREAT Agrif_do_not_treat
-ENDNOTTREAT Agrif_end_do_not_treat
-
-NIMPORTEQUOI .
-SLASH "/"
-DSLASH "/"[ \t]*"/"
-NAME [a-zA-Z\_][a-zA-Z0-9\_]*
-DIGIT [0-9]+
-INT {DIGIT}
-EXPONENT e[-+]?{DIGIT}
-DEXPONENT d[-+]?{DIGIT}
-QEXPONENT q[-+]?{DIGIT}
-REAL (({DIGIT}\.[0-9]+|[0-9]*\.{DIGIT}){EXPONENT}?)|{DIGIT}\.{EXPONENT}
-REALDP (({DIGIT}\.[0-9]+|[0-9]*\.{DIGIT}){DEXPONENT}?)|{DIGIT}\.{DEXPONENT}
-REALQP (({DIGIT}\.[0-9]+|[0-9]*\.{DIGIT}){QEXPONENT}?)|{DIGIT}\.{QEXPONENT}
-ENDFUNCTION end[ \t]*function
-DOUBLEPRECISION double[ \t]*precision
-DOUBLECOMPLEX double[ \t]*complex
-
-COMMENTAIRESFORTRAN77 ^([Cc*](([ \t]*\n)|([^AaHhOo\n]{NIMPORTEQUOI}*\n)))
-COMMENTAIRESFORTRAN77_2 \n([Cc*](([ \t]*\n)|([^AaHhOo\n]{NIMPORTEQUOI}*\n)))
-COMMENTAIRESFORTRAN90 ^([ \t]*!{NIMPORTEQUOI}*\n)
-COMMENTAIRESFORTRAN90_2 (!{NIMPORTEQUOI}*)
-NEXTLINEF90 "&"{NIMPORTEQUOI}*[\n]*
-NEXTLINEF77 [\n \t]*\n[ \t]{5}("&"|"+"|"$"|"*"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"|"."|"#")
-%%
-  if (infixed) BEGIN(fortran77style) ;
-  if (infree) BEGIN(fortran90style)  ;
-
-^C${AGRIFDEB}            return TOK_DEBUT;
-^C${AGRIFFIN}            return TOK_FIN;
-^C$OMP[ \t]*{NIMPORTEQUOI}* return TOK_OMP;
-^C$[ \t]*{NIMPORTEQUOI}* return TOK_DOLLAR;
-
-{REAL8}                 {return TOK_REAL8;}
-subroutine              {return TOK_SUBROUTINE;}
-program                 {return TOK_PROGRAM;}
-allocate                {inallocate = 1; return TOK_ALLOCATE;}
-nullify			{return TOK_NULLIFY;}
-deallocate              {inallocate = 1; return TOK_DEALLOCATE;}
-result                  {return TOK_RESULT;}
-function                {return TOK_FUNCTION;}
-end[ \t]*subroutine     {strcpy(yylval.na,yytext);return TOK_ENDSUBROUTINE;}
-end[ \t]*program        {strcpy(yylval.na,yytext);return TOK_ENDPROGRAM;}
-end[ \t]*function       {strcpy(yylval.na,yytext);return TOK_ENDFUNCTION;}
-end                     {strcpy(yylval.na,yytext);return TOK_ENDUNIT;}
-include                  return TOK_INCLUDE;
-^[ \t]*use[ ]+           {
-                            strcpy(yylval.na,yytext);
-                            tmpc = input();
-                            unput(tmpc);
-                            if ( (
-                               tmpc >= 'a' && tmpc <= 'z'
-                                  ) || (
-                               tmpc >= 'A' && tmpc <= 'Z'
-                               )  )
-                               {
-                                  return TOK_USE;
-                               }
-                               else
-                               {
-                                  return TOK_NAME;
-                               }
-                         }
-rewind                  {return TOK_REWIND;}
-implicit                 return TOK_IMPLICIT;
-none                     return TOK_NONE;
-call                     return TOK_CALL;
-.true.                   return TOK_TRUE;
-.false.                  return TOK_FALSE;
-\=\>                    {return TOK_POINT_TO;}
-\*\*                    {strcpy(yylval.na,yytext);return TOK_DASTER;}
-\.[ \t]*eqv\.            {strcpy(yylval.na,yytext);return TOK_EQV;}
-\.[ \t]*eq\.            {strcpy(yylval.na,yytext);return TOK_EQ;}
-\.[ \t]*gt\.            {strcpy(yylval.na,yytext);return TOK_GT;}
-\.[ \t]*ge\.            {strcpy(yylval.na,yytext);return TOK_GE;}
-\.[ \t]*lt\.            {strcpy(yylval.na,yytext);return TOK_LT;}
-\.[ \t]*le\.            {strcpy(yylval.na,yytext);return TOK_LE;}
-\.[ \t]*neqv\.          {strcpy(yylval.na,yytext);return TOK_NEQV;}
-\.[ \t]*ne\.            {strcpy(yylval.na,yytext);return TOK_NE;}
-\.[ \t]*not\.           {strcpy(yylval.na,yytext);return TOK_NOT;}
-\.[ \t]*or\.            {strcpy(yylval.na,yytext);return TOK_OR;}
-\.[ \t]*xor\.           {strcpy(yylval.na,yytext);return TOK_XOR;}
-\.[ \t]*and\.           {strcpy(yylval.na,yytext);return TOK_AND;}
-module                  {return TOK_MODULE;}
-do[ 0-9\t]*while           {return TOK_DOWHILE;}
-end[ \t]*module          return TOK_ENDMODULE;
-end[ \t]*do              return TOK_ENDDO;
-do                      {return TOK_PLAINDO;}
-real                    {strcpy(yylval.na,yytext);return TOK_REAL;}
-integer                 {strcpy(yylval.na,yytext);return TOK_INTEGER;}
-logical                 {strcpy(yylval.na,yytext);return TOK_LOGICAL;}
-character               {strcpy(yylval.na,yytext);return TOK_CHARACTER;}
-allocatable             {return TOK_ALLOCATABLE;}
-close                    return TOK_CLOSE;
-inquire                  return TOK_INQUIRE;
-dimension               {return TOK_DIMENSION;}
-pause                    return TOK_PAUSE;
-equivalence              return TOK_EQUIVALENCE;
-stop                     return TOK_STOP;
-where                    return TOK_WHERE;
-end[ \t]*where           return TOK_ENDWHERE;
-else[ \t]*where          return TOK_ELSEWHERE;
-complex                 {return TOK_COMPLEX;}
-^[ \t]*contains         {return TOK_CONTAINS;}
-only                    {return TOK_ONLY;}
-parameter               {return TOK_PARAMETER;}
-recursive               {return TOK_RECURSIVE;}
-common                  {return TOK_COMMON;}
-^[ \t]*global[ \t]+     {return TOK_GLOBAL;}
-external                {return TOK_EXTERNAL;}
-intent                  {return TOK_INTENT;}
-pointer                 {return TOK_POINTER;}
-optional                {return TOK_OPTIONAL;}
-save                    {return TOK_SAVE;}
-^[ \t]*type[ \t\,]+       {return TOK_TYPE;}
-^[ \t]*type[ \t]*\(     {return TOK_TYPEPAR;}
-stat                    {if (inallocate == 1) return TOK_STAT; else {strcpy(yylval.na,yytext);return TOK_NAME;}}
-end[ \t]*type           {return TOK_ENDTYPE;}
-open                     return TOK_OPEN;
-return                   return TOK_RETURN;
-exit[^(]                 return TOK_EXIT;
-print                    return TOK_PRINT;
-module[ \t]*procedure   {return TOK_PROCEDURE;}
-read                    {return TOK_READ;}
-namelist                {return TOK_NAMELIST;}
-write                   {return TOK_WRITE;}
-target                  {return TOK_TARGET;}
-public                  {return TOK_PUBLIC;}
-private                 {return TOK_PRIVATE;}
-in                      {strcpy(yylval.nac,yytext);return TOK_IN;}
-^[ \t]*data[ \t]+       {strcpy(yylval.na,yytext);return TOK_DATA;}
-continue                 return TOK_CONTINUE;
-go[ \t]*to              {return TOK_PLAINGOTO;}
-out                     {strcpy(yylval.nac,yytext);return TOK_OUT;}
-inout                   {strcpy(yylval.nac,yytext);return TOK_INOUT;}
-intrinsic               {return TOK_INTRINSIC;}
-then                    {return TOK_THEN;}
-else[ \t]*if            {return TOK_ELSEIF;}
-else                    {return TOK_ELSE;}
-end[ \t]*if             {return TOK_ENDIF;}
-if[ \t]*\(              {return TOK_LOGICALIF;}
-sum[ \t]*\(             {return TOK_SUM;}
-max[ \t]*\(             {return TOK_MAX;}
-tanh                    {return TOK_TANH;}
-maxval                  {return TOK_MAXVAL;}
-trim                    {return TOK_TRIM;}
-sqrt\(                  {return TOK_SQRT;}
-select[ \t]*case        {return TOK_SELECTCASE;}
-^[ \t]*case[ \t]*\(     {return TOK_CASE;}
-^[ \t]*case[ \t]*default       {return TOK_CASEDEFAULT;}
-end[ \t]*select         {return TOK_ENDSELECT;}
-file[ \t]*\=            {return TOK_FILE;}
-end[ \t]*\=             {return TOK_END;}
-err[ \t]*\=             {return TOK_ERR;}
-exist[ \t]*\=           {return TOK_EXIST;}
-min[ \t]*\(             {return TOK_MIN;}
-nint                    {return TOK_NINT;}
-float                   {return TOK_FLOAT;}
-exp                     {return TOK_EXP;}
-cos                     {return TOK_COS;}
-cosh                    {return TOK_COSH;}
-acos                    {return TOK_ACOS;}
-sin                     {return TOK_SIN;}
-sinh                    {return TOK_SINH;}
-asin                    {return TOK_ASIN;}
-log                     {return TOK_LOG;}
-tan                     {return TOK_TAN;}
-atan                    {return TOK_ATAN;}
-cycle                   {return TOK_CYCLE;}
-abs\(                   {return TOK_ABS;}
-mod                     {return TOK_MOD;}
-sign                    {return TOK_SIGN;}
-minloc                  {return TOK_MINLOC;}
-maxloc                  {return TOK_MAXLOC;}
-minval                  {return TOK_MINVAL;}
-backspace               {return TOK_BACKSPACE;}
-\({SLASH}               {return TOK_LEFTAB;}
-{SLASH}\)               {return TOK_RIGHTAB;}
-format[ \t]*\(({NIMPORTEQUOI}|{NEXTLINEF90}|{NEXTLINEF77})*\)  {return TOK_FORMAT;}
-{DOUBLEPRECISION}       {strcpy(yylval.na,yytext);return TOK_DOUBLEPRECISION;}
-{DOUBLECOMPLEX}         {strcpy(yylval.na,yytext);return TOK_DOUBLECOMPLEX;}
-{SLASH}                 {strcpy(yylval.na,yytext);return TOK_SLASH;}
-DSLASH                  {strcpy(yylval.na,yytext);return TOK_DSLASH;}
-(\')[^']*&{0,1}\n[ \t]*&{0,1}[^']*(\')         {strcpy(yylval.na,yytext);return TOK_CHAR_CUT;}
-(\')[^\n']*(\')         {strcpy(yylval.na,yytext);return TOK_CHAR_CONSTANT;}
-(\")[^\n"]*(\")         {strcpy(yylval.na,yytext);return TOK_CHAR_MESSAGE;}
-({NAME}{REAL})          {strcpy(yylval.na,yytext);return TOK_CHAR_INT;}
-^[ \t]*interface        {printf("debug interfacer\n");BEGIN(donottreat);}
-<donottreat>^[ \t]*end[ \t]*interface[ \t]*\n {
-						BEGIN(INITIAL);
-                        if (infixed) BEGIN(fortran77style) ;
-                        if (infree) BEGIN(fortran90style)  ;
-                        line_num_fortran++;line_num_fortran_common++;
-                        return '\n';
-						}
-{NAME}                  {strcpy(yylval.na,yytext);return TOK_NAME;}
-{REAL}                  {strcpy(yylval.na,yytext);return TOK_CSTREAL;}
-{REALDP}                {strcpy(yylval.na,yytext);return TOK_CSTREALDP;}
-{REALQP}                {strcpy(yylval.na,yytext);return TOK_CSTREALQP;}
-({DIGIT}\.)/[^{NAME}|"and."|"false."|"true."|"eq."|"or."|"gt."|"ge."|"lt."|"le."|"not."|"ne."] {strcpy(yylval.na,yytext);return TOK_CSTREAL;}
-{INT}                   {strcpy(yylval.na,yytext);return TOK_CSTINT;}
-\$ {}
-\'|\"                   {return TOK_QUOTE;}
-\.                      {}
-\(|\)|:|\[|\]|\+|\-|\* {strcpy(yylval.na,yytext);return (int) *yytext;}
-\%                     {afterpercent = 1; strcpy(yylval.na,yytext);return (int) *yytext;}
-\;                      {return TOK_SEMICOLON;}
-\,                      {return (int) *yytext;}
-\=                      {return (int) *yytext;}
-\<                      {return (int) *yytext;}
-\>                      {return (int) *yytext;}
-\n                      {colnum=0;line_num_fortran++;line_num_fortran_common++; return (int) *yytext;}
-^[ ]*$
-^(((" "|[0-9]){1,5})|([ \t]{1,5}))[ &]+ {if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0;}
-[ ]+
-[\t]+                   {colnum=colnum-1+tabsize;}
-[ \t]+ ;
-{NEXTLINEF90}           {line_num_fortran++;line_num_fortran_common++;newlinef90=1;colnum=0;}
-{NEXTLINEF77}           {line_num_fortran++;line_num_fortran_common++;colnum=0;}
-<fortran77style>{COMMENTAIRESFORTRAN77} {
-                           convert2lower(motparse1);
-                           if ( strncasecmp(motparse1,"contains",8) == 0 )
-                           {
-                              return TOK_CONTAINS;
-                           }
-                           else
-                           {
-                            /*  colnum=0;line_num_fortran++;line_num_fortran_common++;*/
-                             if ( !strcasecmp(motparse1,"C$AGRIF_DO_NOT_TREAT\n")) 
-                             return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                             unput('\n');
-                           }
-                         }
-<fortran77style>{COMMENTAIRESFORTRAN77_2} {
-                           convert2lower(&motparse1[1]);
-                           if ( strncasecmp(&motparse1[1],"contains",8) == 0 )
-                           {
-                              return TOK_CONTAINS;
-                           }
-                           else
-                           {
-                             /* colnum=0;line_num_fortran++;line_num_fortran_common++;*/
-                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_DO_NOT_TREAT\n")) 
-                             return TOK_DONOTTREAT;
-                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                             unput('\n');
-                           }
-                         }                            
-^"!$AGRIF_DO_NOT_TREAT"[ \t]*\n {
-						BEGIN(donottreat);
-						}
-<donottreat>^"!$AGRIF_END_DO_NOT_TREAT"[ \t]*\n {
-						BEGIN(INITIAL);
-                        if (infixed) BEGIN(fortran77style) ;
-                        if (infree) BEGIN(fortran90style)  ;
-                        line_num_fortran++;line_num_fortran_common++;
-                        return '\n';
-						}
-<donottreat>.*\n        {line_num_fortran++;line_num_fortran_common++;}
-{COMMENTAIRESFORTRAN90}   {
-                             colnum = 0;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                          }
-{COMMENTAIRESFORTRAN90_2} {
-                             colnum = 0;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                          }
-%%
-
-fortranerror(char *s)
-{
-   if (!strcasecmp(curfile,mainfile))
-   {
-      printf("%s line %d, file %s motclef = %s\n",s,line_num_fortran,curfile,yytext);
-   }
-   else
-   {
-      printf("%s line %d, file %s motclef = %s curbuf = %s\n",s,line_num_fortran_common,curfile,yytext,curbuf);
-   }
-/*   exit(0);*/
-}
-
-int fortranwrap()
-{
-}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.tab.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.tab.c	(revision 5659)
+++ 	(revision )
@@ -1,6863 +1,0 @@
-/* A Bison parser, made by GNU Bison 2.3.  */
-
-/* Skeleton implementation for Bison's Yacc-like parsers in C
-
-   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
-   Free Software Foundation, Inc.
-
-   This program is free software; you can redistribute it and/or modify
-   it under the terms of the GNU General Public License as published by
-   the Free Software Foundation; either version 2, or (at your option)
-   any later version.
-
-   This program is distributed in the hope that it will be useful,
-   but WITHOUT ANY WARRANTY; without even the implied warranty of
-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-   GNU General Public License for more details.
-
-   You should have received a copy of the GNU General Public License
-   along with this program; if not, write to the Free Software
-   Foundation, Inc., 51 Franklin Street, Fifth Floor,
-   Boston, MA 02110-1301, USA.  */
-
-/* As a special exception, you may create a larger work that contains
-   part or all of the Bison parser skeleton and distribute that work
-   under terms of your choice, so long as that work isn't itself a
-   parser generator using the skeleton or a modified version thereof
-   as a parser skeleton.  Alternatively, if you modify or redistribute
-   the parser skeleton itself, you may (at your option) remove this
-   special exception, which will cause the skeleton and the resulting
-   Bison output files to be licensed under the GNU General Public
-   License without this special exception.
-
-   This special exception was added by the Free Software Foundation in
-   version 2.2 of Bison.  */
-
-/* C LALR(1) parser skeleton written by Richard Stallman, by
-   simplifying the original so-called "semantic" parser.  */
-
-/* All symbols defined below should begin with yy or YY, to avoid
-   infringing on user name space.  This should be done even for local
-   variables, as they might otherwise be expanded by user macros.
-   There are some unavoidable exceptions within include files to
-   define necessary library symbols; they are noted "INFRINGES ON
-   USER NAME SPACE" below.  */
-
-/* Identify Bison output.  */
-#define YYBISON 1
-
-/* Bison version.  */
-#define YYBISON_VERSION "2.3"
-
-/* Skeleton name.  */
-#define YYSKELETON_NAME "yacc.c"
-
-/* Pure parsers.  */
-#define YYPURE 0
-
-/* Using locations.  */
-#define YYLSP_NEEDED 0
-
-/* Substitute the variable and function names.  */
-#define yyparse fortranparse
-#define yylex   fortranlex
-#define yyerror fortranerror
-#define yylval  fortranlval
-#define yychar  fortranchar
-#define yydebug fortrandebug
-#define yynerrs fortrannerrs
-
-
-/* Tokens.  */
-#ifndef YYTOKENTYPE
-# define YYTOKENTYPE
-   /* Put the tokens into the symbol table, so that GDB and other debuggers
-      know about them.  */
-   enum yytokentype {
-     TOK_BINARY_OP = 258,
-     TOK_NEQV = 259,
-     TOK_EQV = 260,
-     TOK_XOR = 261,
-     TOK_OR = 262,
-     TOK_AND = 263,
-     TOK_NOT = 264,
-     TOK_NE = 265,
-     TOK_EQ = 266,
-     TOK_GE = 267,
-     TOK_LE = 268,
-     TOK_GT = 269,
-     TOK_LT = 270,
-     TOK_UNARY_OP = 271,
-     TOK_DSLASH = 272,
-     TOK_SLASH = 273,
-     TOK_DASTER = 274,
-     TOK_SEP = 275,
-     TOK_SEMICOLON = 276,
-     TOK_NEXTLINE = 277,
-     TOK_PARAMETER = 278,
-     TOK_RESULT = 279,
-     TOK_ONLY = 280,
-     TOK_INCLUDE = 281,
-     TOK_SUBROUTINE = 282,
-     TOK_PROGRAM = 283,
-     TOK_FUNCTION = 284,
-     TOK_OMP = 285,
-     TOK_DOLLAR = 286,
-     TOK_FORMAT = 287,
-     TOK_MAX = 288,
-     TOK_TANH = 289,
-     TOK_WHERE = 290,
-     TOK_ELSEWHERE = 291,
-     TOK_ENDWHERE = 292,
-     TOK_MAXVAL = 293,
-     TOK_TRIM = 294,
-     TOK_SUM = 295,
-     TOK_SQRT = 296,
-     TOK_CASE = 297,
-     TOK_SELECTCASE = 298,
-     TOK_FILE = 299,
-     TOK_END = 300,
-     TOK_ERR = 301,
-     TOK_DONOTTREAT = 302,
-     TOK_ENDDONOTTREAT = 303,
-     TOK_EXIST = 304,
-     TOK_MIN = 305,
-     TOK_FLOAT = 306,
-     TOK_EXP = 307,
-     TOK_COS = 308,
-     TOK_COSH = 309,
-     TOK_ACOS = 310,
-     TOK_NINT = 311,
-     TOK_CYCLE = 312,
-     TOK_SIN = 313,
-     TOK_SINH = 314,
-     TOK_ASIN = 315,
-     TOK_EQUIVALENCE = 316,
-     TOK_BACKSPACE = 317,
-     TOK_LOG = 318,
-     TOK_TAN = 319,
-     TOK_ATAN = 320,
-     TOK_RECURSIVE = 321,
-     TOK_ABS = 322,
-     TOK_MOD = 323,
-     TOK_SIGN = 324,
-     TOK_MINLOC = 325,
-     TOK_MAXLOC = 326,
-     TOK_EXIT = 327,
-     TOK_MINVAL = 328,
-     TOK_PUBLIC = 329,
-     TOK_PRIVATE = 330,
-     TOK_ALLOCATABLE = 331,
-     TOK_RETURN = 332,
-     TOK_THEN = 333,
-     TOK_ELSEIF = 334,
-     TOK_ELSE = 335,
-     TOK_ENDIF = 336,
-     TOK_PRINT = 337,
-     TOK_PLAINGOTO = 338,
-     TOK_CONSTRUCTID = 339,
-     TOK_LOGICALIF = 340,
-     TOK_PLAINDO = 341,
-     TOK_CONTAINS = 342,
-     TOK_ENDDO = 343,
-     TOK_MODULE = 344,
-     TOK_ENDMODULE = 345,
-     TOK_DOWHILE = 346,
-     TOK_ALLOCATE = 347,
-     TOK_OPEN = 348,
-     TOK_CLOSE = 349,
-     TOK_INQUIRE = 350,
-     TOK_WRITE = 351,
-     TOK_READ = 352,
-     TOK_REWIND = 353,
-     TOK_DEALLOCATE = 354,
-     TOK_NULLIFY = 355,
-     TOK_FIN = 356,
-     TOK_DEBUT = 357,
-     TOK_DIMENSION = 358,
-     TOK_ENDSELECT = 359,
-     TOK_EXTERNAL = 360,
-     TOK_INTENT = 361,
-     TOK_INTRINSIC = 362,
-     TOK_NAMELIST = 363,
-     TOK_CASEDEFAULT = 364,
-     TOK_OPTIONAL = 365,
-     TOK_POINTER = 366,
-     TOK_CONTINUE = 367,
-     TOK_SAVE = 368,
-     TOK_TARGET = 369,
-     TOK_QUOTE = 370,
-     TOK_IMPLICIT = 371,
-     TOK_NONE = 372,
-     TOK_CALL = 373,
-     TOK_STAT = 374,
-     TOK_POINT_TO = 375,
-     TOK_COMMON = 376,
-     TOK_GLOBAL = 377,
-     TOK_INTERFACE = 378,
-     TOK_ENDINTERFACE = 379,
-     TOK_LEFTAB = 380,
-     TOK_RIGHTAB = 381,
-     TOK_PAUSE = 382,
-     TOK_PROCEDURE = 383,
-     TOK_STOP = 384,
-     TOK_NAMEEQ = 385,
-     TOK_REAL8 = 386,
-     TOK_OUT = 387,
-     TOK_INOUT = 388,
-     TOK_IN = 389,
-     TOK_USE = 390,
-     TOK_TRUE = 391,
-     TOK_FALSE = 392,
-     TOK_LABEL = 393,
-     TOK_TYPE = 394,
-     TOK_TYPEPAR = 395,
-     TOK_ENDTYPE = 396,
-     TOK_REAL = 397,
-     TOK_INTEGER = 398,
-     TOK_LOGICAL = 399,
-     TOK_DOUBLEPRECISION = 400,
-     TOK_DOUBLEREAL = 401,
-     TOK_ENDSUBROUTINE = 402,
-     TOK_ENDFUNCTION = 403,
-     TOK_ENDPROGRAM = 404,
-     TOK_ENDUNIT = 405,
-     TOK_CHARACTER = 406,
-     TOK_CHAR_CONSTANT = 407,
-     TOK_CHAR_CUT = 408,
-     TOK_DATA = 409,
-     TOK_CHAR_INT = 410,
-     TOK_CHAR_MESSAGE = 411,
-     TOK_CSTREAL = 412,
-     TOK_CSTREALDP = 413,
-     TOK_CSTREALQP = 414,
-     TOK_SFREAL = 415,
-     TOK_COMPLEX = 416,
-     TOK_DOUBLECOMPLEX = 417,
-     TOK_NAME = 418,
-     TOK_NAME_CHAR = 419,
-     TOK_PROBTYPE = 420,
-     TOK_INTERPTYPE = 421,
-     TOK_VARTYPE = 422,
-     TOK_BC = 423,
-     TOK_OP = 424,
-     TOK_CSTINT = 425,
-     TOK_COMMENT = 426,
-     TOK_FILENAME = 427
-   };
-#endif
-/* Tokens.  */
-#define TOK_BINARY_OP 258
-#define TOK_NEQV 259
-#define TOK_EQV 260
-#define TOK_XOR 261
-#define TOK_OR 262
-#define TOK_AND 263
-#define TOK_NOT 264
-#define TOK_NE 265
-#define TOK_EQ 266
-#define TOK_GE 267
-#define TOK_LE 268
-#define TOK_GT 269
-#define TOK_LT 270
-#define TOK_UNARY_OP 271
-#define TOK_DSLASH 272
-#define TOK_SLASH 273
-#define TOK_DASTER 274
-#define TOK_SEP 275
-#define TOK_SEMICOLON 276
-#define TOK_NEXTLINE 277
-#define TOK_PARAMETER 278
-#define TOK_RESULT 279
-#define TOK_ONLY 280
-#define TOK_INCLUDE 281
-#define TOK_SUBROUTINE 282
-#define TOK_PROGRAM 283
-#define TOK_FUNCTION 284
-#define TOK_OMP 285
-#define TOK_DOLLAR 286
-#define TOK_FORMAT 287
-#define TOK_MAX 288
-#define TOK_TANH 289
-#define TOK_WHERE 290
-#define TOK_ELSEWHERE 291
-#define TOK_ENDWHERE 292
-#define TOK_MAXVAL 293
-#define TOK_TRIM 294
-#define TOK_SUM 295
-#define TOK_SQRT 296
-#define TOK_CASE 297
-#define TOK_SELECTCASE 298
-#define TOK_FILE 299
-#define TOK_END 300
-#define TOK_ERR 301
-#define TOK_DONOTTREAT 302
-#define TOK_ENDDONOTTREAT 303
-#define TOK_EXIST 304
-#define TOK_MIN 305
-#define TOK_FLOAT 306
-#define TOK_EXP 307
-#define TOK_COS 308
-#define TOK_COSH 309
-#define TOK_ACOS 310
-#define TOK_NINT 311
-#define TOK_CYCLE 312
-#define TOK_SIN 313
-#define TOK_SINH 314
-#define TOK_ASIN 315
-#define TOK_EQUIVALENCE 316
-#define TOK_BACKSPACE 317
-#define TOK_LOG 318
-#define TOK_TAN 319
-#define TOK_ATAN 320
-#define TOK_RECURSIVE 321
-#define TOK_ABS 322
-#define TOK_MOD 323
-#define TOK_SIGN 324
-#define TOK_MINLOC 325
-#define TOK_MAXLOC 326
-#define TOK_EXIT 327
-#define TOK_MINVAL 328
-#define TOK_PUBLIC 329
-#define TOK_PRIVATE 330
-#define TOK_ALLOCATABLE 331
-#define TOK_RETURN 332
-#define TOK_THEN 333
-#define TOK_ELSEIF 334
-#define TOK_ELSE 335
-#define TOK_ENDIF 336
-#define TOK_PRINT 337
-#define TOK_PLAINGOTO 338
-#define TOK_CONSTRUCTID 339
-#define TOK_LOGICALIF 340
-#define TOK_PLAINDO 341
-#define TOK_CONTAINS 342
-#define TOK_ENDDO 343
-#define TOK_MODULE 344
-#define TOK_ENDMODULE 345
-#define TOK_DOWHILE 346
-#define TOK_ALLOCATE 347
-#define TOK_OPEN 348
-#define TOK_CLOSE 349
-#define TOK_INQUIRE 350
-#define TOK_WRITE 351
-#define TOK_READ 352
-#define TOK_REWIND 353
-#define TOK_DEALLOCATE 354
-#define TOK_NULLIFY 355
-#define TOK_FIN 356
-#define TOK_DEBUT 357
-#define TOK_DIMENSION 358
-#define TOK_ENDSELECT 359
-#define TOK_EXTERNAL 360
-#define TOK_INTENT 361
-#define TOK_INTRINSIC 362
-#define TOK_NAMELIST 363
-#define TOK_CASEDEFAULT 364
-#define TOK_OPTIONAL 365
-#define TOK_POINTER 366
-#define TOK_CONTINUE 367
-#define TOK_SAVE 368
-#define TOK_TARGET 369
-#define TOK_QUOTE 370
-#define TOK_IMPLICIT 371
-#define TOK_NONE 372
-#define TOK_CALL 373
-#define TOK_STAT 374
-#define TOK_POINT_TO 375
-#define TOK_COMMON 376
-#define TOK_GLOBAL 377
-#define TOK_INTERFACE 378
-#define TOK_ENDINTERFACE 379
-#define TOK_LEFTAB 380
-#define TOK_RIGHTAB 381
-#define TOK_PAUSE 382
-#define TOK_PROCEDURE 383
-#define TOK_STOP 384
-#define TOK_NAMEEQ 385
-#define TOK_REAL8 386
-#define TOK_OUT 387
-#define TOK_INOUT 388
-#define TOK_IN 389
-#define TOK_USE 390
-#define TOK_TRUE 391
-#define TOK_FALSE 392
-#define TOK_LABEL 393
-#define TOK_TYPE 394
-#define TOK_TYPEPAR 395
-#define TOK_ENDTYPE 396
-#define TOK_REAL 397
-#define TOK_INTEGER 398
-#define TOK_LOGICAL 399
-#define TOK_DOUBLEPRECISION 400
-#define TOK_DOUBLEREAL 401
-#define TOK_ENDSUBROUTINE 402
-#define TOK_ENDFUNCTION 403
-#define TOK_ENDPROGRAM 404
-#define TOK_ENDUNIT 405
-#define TOK_CHARACTER 406
-#define TOK_CHAR_CONSTANT 407
-#define TOK_CHAR_CUT 408
-#define TOK_DATA 409
-#define TOK_CHAR_INT 410
-#define TOK_CHAR_MESSAGE 411
-#define TOK_CSTREAL 412
-#define TOK_CSTREALDP 413
-#define TOK_CSTREALQP 414
-#define TOK_SFREAL 415
-#define TOK_COMPLEX 416
-#define TOK_DOUBLECOMPLEX 417
-#define TOK_NAME 418
-#define TOK_NAME_CHAR 419
-#define TOK_PROBTYPE 420
-#define TOK_INTERPTYPE 421
-#define TOK_VARTYPE 422
-#define TOK_BC 423
-#define TOK_OP 424
-#define TOK_CSTINT 425
-#define TOK_COMMENT 426
-#define TOK_FILENAME 427
-
-
-
-
-/* Copy the first part of user declarations.  */
-#line 36 "fortran.y"
-
-#define YYMAXDEPTH 1000
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include "decl.h"
-extern int line_num_fortran;
-extern int line_num_fortran_common;
-char *tmp;
-char c_selectorname[LONG_C];
-char ligne[LONG_C];
-char truename[LONGNOM];
-char identcopy[LONG_C];
-int c_selectorgiven=0;
-int incom;
-listvar *curlistvar;
-typedim c_selectordim;
-listcouple *coupletmp;
-listdim *parcoursdim;
-int removeline=0;
-listvar *test;
-
-
-/* Enabling traces.  */
-#ifndef YYDEBUG
-# define YYDEBUG 0
-#endif
-
-/* Enabling verbose error messages.  */
-#ifdef YYERROR_VERBOSE
-# undef YYERROR_VERBOSE
-# define YYERROR_VERBOSE 1
-#else
-# define YYERROR_VERBOSE 0
-#endif
-
-/* Enabling the token table.  */
-#ifndef YYTOKEN_TABLE
-# define YYTOKEN_TABLE 0
-#endif
-
-#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
-typedef union YYSTYPE
-#line 59 "fortran.y"
-{
-       char      nac[LONG_C];
-       char      na[LONGNOM];
-       listdim  *d;
-       listvar  *l;
-       listnom  *ln;
-       listcouple  *lc;
-       listname *lnn;
-       typedim   dim1;
-       variable *v;
-       }
-/* Line 193 of yacc.c.  */
-#line 483 "fortran.tab.c"
-	YYSTYPE;
-# define yystype YYSTYPE /* obsolescent; will be withdrawn */
-# define YYSTYPE_IS_DECLARED 1
-# define YYSTYPE_IS_TRIVIAL 1
-#endif
-
-
-
-/* Copy the second part of user declarations.  */
-
-
-/* Line 216 of yacc.c.  */
-#line 496 "fortran.tab.c"
-
-#ifdef short
-# undef short
-#endif
-
-#ifdef YYTYPE_UINT8
-typedef YYTYPE_UINT8 yytype_uint8;
-#else
-typedef unsigned char yytype_uint8;
-#endif
-
-#ifdef YYTYPE_INT8
-typedef YYTYPE_INT8 yytype_int8;
-#elif (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-typedef signed char yytype_int8;
-#else
-typedef short int yytype_int8;
-#endif
-
-#ifdef YYTYPE_UINT16
-typedef YYTYPE_UINT16 yytype_uint16;
-#else
-typedef unsigned short int yytype_uint16;
-#endif
-
-#ifdef YYTYPE_INT16
-typedef YYTYPE_INT16 yytype_int16;
-#else
-typedef short int yytype_int16;
-#endif
-
-#ifndef YYSIZE_T
-# ifdef __SIZE_TYPE__
-#  define YYSIZE_T __SIZE_TYPE__
-# elif defined size_t
-#  define YYSIZE_T size_t
-# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
-#  define YYSIZE_T size_t
-# else
-#  define YYSIZE_T unsigned int
-# endif
-#endif
-
-#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
-
-#ifndef YY_
-# if defined YYENABLE_NLS && YYENABLE_NLS
-#  if ENABLE_NLS
-#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
-#   define YY_(msgid) dgettext ("bison-runtime", msgid)
-#  endif
-# endif
-# ifndef YY_
-#  define YY_(msgid) msgid
-# endif
-#endif
-
-/* Suppress unused-variable warnings by "using" E.  */
-#if ! defined lint || defined __GNUC__
-# define YYUSE(e) ((void) (e))
-#else
-# define YYUSE(e) /* empty */
-#endif
-
-/* Identity function, used to suppress warnings about constant conditions.  */
-#ifndef lint
-# define YYID(n) (n)
-#else
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static int
-YYID (int i)
-#else
-static int
-YYID (i)
-    int i;
-#endif
-{
-  return i;
-}
-#endif
-
-#if ! defined yyoverflow || YYERROR_VERBOSE
-
-/* The parser invokes alloca or malloc; define the necessary symbols.  */
-
-# ifdef YYSTACK_USE_ALLOCA
-#  if YYSTACK_USE_ALLOCA
-#   ifdef __GNUC__
-#    define YYSTACK_ALLOC __builtin_alloca
-#   elif defined __BUILTIN_VA_ARG_INCR
-#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
-#   elif defined _AIX
-#    define YYSTACK_ALLOC __alloca
-#   elif defined _MSC_VER
-#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
-#    define alloca _alloca
-#   else
-#    define YYSTACK_ALLOC alloca
-#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-#     ifndef _STDLIB_H
-#      define _STDLIB_H 1
-#     endif
-#    endif
-#   endif
-#  endif
-# endif
-
-# ifdef YYSTACK_ALLOC
-   /* Pacify GCC's `empty if-body' warning.  */
-#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
-#  ifndef YYSTACK_ALLOC_MAXIMUM
-    /* The OS might guarantee only one guard page at the bottom of the stack,
-       and a page size can be as small as 4096 bytes.  So we cannot safely
-       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
-       to allow for a few compiler-allocated temporary stack slots.  */
-#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
-#  endif
-# else
-#  define YYSTACK_ALLOC YYMALLOC
-#  define YYSTACK_FREE YYFREE
-#  ifndef YYSTACK_ALLOC_MAXIMUM
-#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
-#  endif
-#  if (defined __cplusplus && ! defined _STDLIB_H \
-       && ! ((defined YYMALLOC || defined malloc) \
-	     && (defined YYFREE || defined free)))
-#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-#   ifndef _STDLIB_H
-#    define _STDLIB_H 1
-#   endif
-#  endif
-#  ifndef YYMALLOC
-#   define YYMALLOC malloc
-#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
-#   endif
-#  endif
-#  ifndef YYFREE
-#   define YYFREE free
-#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-void free (void *); /* INFRINGES ON USER NAME SPACE */
-#   endif
-#  endif
-# endif
-#endif /* ! defined yyoverflow || YYERROR_VERBOSE */
-
-
-#if (! defined yyoverflow \
-     && (! defined __cplusplus \
-	 || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
-
-/* A type that is properly aligned for any stack member.  */
-union yyalloc
-{
-  yytype_int16 yyss;
-  YYSTYPE yyvs;
-  };
-
-/* The size of the maximum gap between one aligned stack and the next.  */
-# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
-
-/* The size of an array large to enough to hold all stacks, each with
-   N elements.  */
-# define YYSTACK_BYTES(N) \
-     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \
-      + YYSTACK_GAP_MAXIMUM)
-
-/* Copy COUNT objects from FROM to TO.  The source and destination do
-   not overlap.  */
-# ifndef YYCOPY
-#  if defined __GNUC__ && 1 < __GNUC__
-#   define YYCOPY(To, From, Count) \
-      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
-#  else
-#   define YYCOPY(To, From, Count)		\
-      do					\
-	{					\
-	  YYSIZE_T yyi;				\
-	  for (yyi = 0; yyi < (Count); yyi++)	\
-	    (To)[yyi] = (From)[yyi];		\
-	}					\
-      while (YYID (0))
-#  endif
-# endif
-
-/* Relocate STACK from its old location to the new one.  The
-   local variables YYSIZE and YYSTACKSIZE give the old and new number of
-   elements in the stack, and YYPTR gives the new location of the
-   stack.  Advance YYPTR to a properly aligned location for the next
-   stack.  */
-# define YYSTACK_RELOCATE(Stack)					\
-    do									\
-      {									\
-	YYSIZE_T yynewbytes;						\
-	YYCOPY (&yyptr->Stack, Stack, yysize);				\
-	Stack = &yyptr->Stack;						\
-	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
-	yyptr += yynewbytes / sizeof (*yyptr);				\
-      }									\
-    while (YYID (0))
-
-#endif
-
-/* YYFINAL -- State number of the termination state.  */
-#define YYFINAL  2
-/* YYLAST -- Last index in YYTABLE.  */
-#define YYLAST   6070
-
-/* YYNTOKENS -- Number of terminals.  */
-#define YYNTOKENS  190
-/* YYNNTS -- Number of nonterminals.  */
-#define YYNNTS  184
-/* YYNRULES -- Number of rules.  */
-#define YYNRULES  555
-/* YYNRULES -- Number of states.  */
-#define YYNSTATES  982
-
-/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
-#define YYUNDEFTOK  2
-#define YYMAXUTOK   427
-
-#define YYTRANSLATE(YYX)						\
-  ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
-
-/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.  */
-static const yytype_uint8 yytranslate[] =
-{
-       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-     187,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,   183,     2,     2,     2,   189,     2,     2,
-     179,   180,    23,    21,     3,    22,     2,   188,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     4,     2,
-     185,     5,   186,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,   181,     2,   182,     2,   184,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     1,     2,     6,     7,
-       8,     9,    10,    11,    12,    13,    14,    15,    16,    17,
-      18,    19,    20,    24,    25,    26,    27,    28,    29,    30,
-      31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
-      41,    42,    43,    44,    45,    46,    47,    48,    49,    50,
-      51,    52,    53,    54,    55,    56,    57,    58,    59,    60,
-      61,    62,    63,    64,    65,    66,    67,    68,    69,    70,
-      71,    72,    73,    74,    75,    76,    77,    78,    79,    80,
-      81,    82,    83,    84,    85,    86,    87,    88,    89,    90,
-      91,    92,    93,    94,    95,    96,    97,    98,    99,   100,
-     101,   102,   103,   104,   105,   106,   107,   108,   109,   110,
-     111,   112,   113,   114,   115,   116,   117,   118,   119,   120,
-     121,   122,   123,   124,   125,   126,   127,   128,   129,   130,
-     131,   132,   133,   134,   135,   136,   137,   138,   139,   140,
-     141,   142,   143,   144,   145,   146,   147,   148,   149,   150,
-     151,   152,   153,   154,   155,   156,   157,   158,   159,   160,
-     161,   162,   163,   164,   165,   166,   167,   168,   169,   170,
-     171,   172,   173,   174,   175,   176,   177,   178
-};
-
-#if YYDEBUG
-/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
-   YYRHS.  */
-static const yytype_uint16 yyprhs[] =
-{
-       0,     0,     3,     4,     7,    10,    13,    15,    19,    23,
-      25,    29,    32,    35,    39,    43,    46,    49,    52,    54,
-      56,    58,    60,    61,    62,    65,    66,    68,    69,    70,
-      72,    73,    78,    81,    88,    93,    96,    98,    99,   101,
-     103,   104,   107,   111,   112,   115,   119,   121,   125,   127,
-     129,   132,   137,   140,   143,   148,   151,   153,   155,   157,
-     159,   161,   163,   165,   167,   169,   171,   176,   180,   184,
-     187,   191,   192,   194,   196,   198,   200,   202,   204,   206,
-     208,   210,   212,   214,   216,   218,   220,   222,   224,   226,
-     228,   230,   232,   234,   236,   238,   240,   242,   244,   248,
-     252,   258,   260,   264,   268,   271,   276,   278,   282,   283,
-     286,   289,   293,   295,   297,   299,   304,   311,   316,   318,
-     322,   325,   329,   335,   339,   341,   342,   345,   347,   352,
-     356,   359,   363,   367,   371,   375,   376,   378,   381,   384,
-     388,   394,   398,   399,   402,   405,   407,   413,   419,   422,
-     426,   429,   433,   435,   439,   442,   446,   452,   454,   457,
-     459,   463,   466,   468,   472,   473,   475,   477,   481,   485,
-     488,   490,   494,   497,   500,   501,   508,   516,   517,   520,
-     523,   527,   531,   533,   534,   537,   542,   546,   550,   555,
-     558,   560,   562,   564,   566,   568,   570,   572,   574,   575,
-     578,   580,   584,   585,   588,   592,   594,   598,   601,   605,
-     607,   609,   611,   613,   614,   618,   619,   622,   627,   629,
-     633,   635,   637,   639,   642,   644,   649,   651,   653,   655,
-     657,   659,   661,   663,   665,   667,   669,   670,   674,   676,
-     680,   682,   684,   687,   690,   694,   696,   698,   700,   704,
-     706,   708,   712,   716,   721,   726,   730,   735,   740,   744,
-     749,   754,   759,   764,   769,   774,   779,   784,   789,   794,
-     799,   804,   809,   813,   818,   823,   828,   833,   835,   839,
-     841,   843,   845,   848,   851,   854,   856,   858,   861,   864,
-     867,   870,   873,   876,   879,   882,   885,   888,   891,   895,
-     898,   902,   905,   908,   911,   914,   917,   920,   923,   924,
-     926,   929,   932,   935,   937,   939,   941,   943,   944,   946,
-     949,   954,   960,   965,   969,   973,   975,   978,   980,   984,
-     986,   988,   992,   998,  1003,  1007,  1010,  1013,  1015,  1017,
-    1019,  1021,  1023,  1025,  1027,  1029,  1032,  1035,  1037,  1040,
-    1042,  1044,  1045,  1047,  1053,  1054,  1056,  1058,  1060,  1061,
-    1065,  1069,  1070,  1076,  1079,  1084,  1091,  1098,  1100,  1102,
-    1104,  1108,  1112,  1114,  1118,  1122,  1124,  1126,  1132,  1138,
-    1143,  1145,  1148,  1151,  1154,  1157,  1159,  1162,  1168,  1170,
-    1172,  1175,  1181,  1183,  1186,  1190,  1195,  1197,  1199,  1201,
-    1203,  1205,  1207,  1209,  1211,  1215,  1219,  1223,  1226,  1229,
-    1230,  1236,  1244,  1245,  1248,  1250,  1252,  1253,  1255,  1257,
-    1259,  1261,  1264,  1266,  1268,  1270,  1276,  1282,  1285,  1288,
-    1291,  1294,  1296,  1297,  1302,  1309,  1311,  1315,  1318,  1321,
-    1324,  1325,  1329,  1330,  1332,  1335,  1337,  1339,  1343,  1345,
-    1348,  1350,  1352,  1355,  1358,  1361,  1365,  1368,  1370,  1371,
-    1373,  1376,  1379,  1380,  1383,  1387,  1391,  1395,  1399,  1401,
-    1405,  1407,  1409,  1413,  1415,  1417,  1419,  1423,  1426,  1431,
-    1436,  1439,  1442,  1444,  1446,  1448,  1450,  1452,  1454,  1456,
-    1458,  1460,  1464,  1466,  1468,  1472,  1476,  1480,  1484,  1487,
-    1491,  1494,  1497,  1500,  1503,  1507,  1509,  1511,  1513,  1515,
-    1519,  1520,  1522,  1525,  1530,  1533,  1536,  1542,  1543,  1545,
-    1548,  1550,  1552,  1554,  1558,  1562,  1566,  1570,  1574,  1578,
-    1580,  1582,  1584,  1588,  1594,  1600,  1606,  1612,  1620,  1622,
-    1631,  1634,  1636,  1638,  1642,  1644,  1646,  1648,  1653,  1655,
-    1659,  1660,  1665,  1667,  1671,  1675
-};
-
-/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
-static const yytype_int16 yyrhs[] =
-{
-     191,     0,    -1,    -1,   191,   192,    -1,   187,   198,    -1,
-     199,   193,    -1,   177,    -1,   197,   200,   205,    -1,     1,
-     205,   201,    -1,   194,    -1,   193,    27,   194,    -1,   203,
-     196,    -1,   212,   196,    -1,   206,   207,   196,    -1,   315,
-     200,   205,    -1,   195,   196,    -1,   298,     4,    -1,   198,
-     200,    -1,    53,    -1,    54,    -1,    36,    -1,    37,    -1,
-      -1,    -1,   144,   201,    -1,    -1,   177,    -1,    -1,    -1,
-      72,    -1,    -1,   202,    33,   204,   208,    -1,    34,   204,
-      -1,   202,    35,   204,   208,    30,   209,    -1,   202,    35,
-     204,   208,    -1,    95,   169,    -1,   169,    -1,    -1,    32,
-      -1,   158,    -1,    -1,   179,   180,    -1,   179,   210,   180,
-      -1,    -1,   179,   180,    -1,   179,   210,   180,    -1,   211,
-      -1,   210,     3,   211,    -1,   169,    -1,    23,    -1,   257,
-     222,    -1,   145,   213,   221,   324,    -1,   147,   324,    -1,
-     117,   216,    -1,   224,   179,   249,   180,    -1,   224,   249,
-      -1,   243,    -1,   228,    -1,   253,    -1,   239,    -1,   241,
-      -1,   240,    -1,   308,    -1,   251,    -1,   237,    -1,   234,
-      -1,    68,   179,   280,   180,    -1,   111,   221,   242,    -1,
-     113,   221,   215,    -1,    67,   217,    -1,   225,   226,   187,
-      -1,    -1,   275,    -1,    46,    -1,    40,    -1,    44,    -1,
-      56,    -1,    79,    -1,    45,    -1,    47,    -1,    62,    -1,
-      57,    -1,    58,    -1,    59,    -1,    60,    -1,    61,    -1,
-      64,    -1,    65,    -1,    66,    -1,    69,    -1,    70,    -1,
-      71,    -1,    74,    -1,    75,    -1,    76,    -1,    77,    -1,
-     169,    -1,   214,    -1,   215,     3,   214,    -1,   179,   220,
-     180,    -1,   216,     3,   179,   220,   180,    -1,   218,    -1,
-     217,     3,   218,    -1,   179,   219,   180,    -1,   298,   276,
-      -1,   219,     3,   298,   276,    -1,   280,    -1,   220,     3,
-     280,    -1,    -1,     4,     4,    -1,   255,   256,    -1,   223,
-     204,   208,    -1,    35,    -1,    29,    -1,   160,    -1,   169,
-      24,   227,    24,    -1,   226,   248,   169,    24,   227,    24,
-      -1,   231,    24,   227,    24,    -1,   232,    -1,   232,     3,
-     227,    -1,   229,   230,    -1,   229,   247,   230,    -1,   228,
-     248,   247,   248,   230,    -1,   228,     3,   230,    -1,   119,
-      -1,    -1,   169,   276,    -1,   169,    -1,   169,   179,   280,
-     180,    -1,   231,     3,   231,    -1,   233,   299,    -1,   232,
-      21,   232,    -1,   232,    22,   232,    -1,   232,    23,   232,
-      -1,   232,   188,   232,    -1,    -1,   284,    -1,   235,   236,
-      -1,   114,   298,    -1,   114,   247,   298,    -1,   235,   248,
-     247,   248,   298,    -1,   235,     3,   298,    -1,    -1,   129,
-     324,    -1,   130,   324,    -1,   109,    -1,   238,   248,   169,
-     276,   264,    -1,   239,     3,   169,   276,   264,    -1,    81,
-     187,    -1,    81,   221,   242,    -1,    80,   187,    -1,    80,
-     221,   242,    -1,   169,    -1,   242,     3,   169,    -1,   244,
-     245,    -1,   244,   247,   245,    -1,   243,   248,   247,   248,
-     245,    -1,   127,    -1,   128,   127,    -1,   246,    -1,   245,
-       3,   246,    -1,   169,   276,    -1,    20,    -1,    24,   169,
-      24,    -1,    -1,     3,    -1,   250,    -1,   249,     3,   250,
-      -1,   169,     5,   280,    -1,   134,   252,    -1,   169,    -1,
-     252,     3,   169,    -1,   122,   123,    -1,   122,   137,    -1,
-      -1,   271,   254,   169,   276,   264,   305,    -1,   255,     3,
-     254,   169,   276,   264,   305,    -1,    -1,   262,   266,    -1,
-     261,   259,    -1,   263,    23,   176,    -1,   258,   268,   180,
-      -1,   146,    -1,    -1,    23,   176,    -1,    23,   179,   260,
-     180,    -1,   179,   260,   180,    -1,   169,   269,   270,    -1,
-     169,     5,   269,   270,    -1,   269,   270,    -1,   157,    -1,
-     263,    -1,   149,    -1,   148,    -1,   167,    -1,   151,    -1,
-     168,    -1,   150,    -1,    -1,    23,   265,    -1,   280,    -1,
-     179,    23,   180,    -1,    -1,    23,   267,    -1,   179,   268,
-     180,    -1,   280,    -1,   179,    23,   180,    -1,   169,   269,
-      -1,   169,     5,   269,    -1,   169,    -1,   176,    -1,   280,
-      -1,    23,    -1,    -1,     3,   169,   269,    -1,    -1,     4,
-       4,    -1,     3,   272,     4,     4,    -1,   273,    -1,   272,
-       3,   273,    -1,    29,    -1,   275,    -1,    82,    -1,   109,
-     276,    -1,   111,    -1,   112,   179,   274,   180,    -1,   113,
-      -1,   116,    -1,   117,    -1,   119,    -1,   120,    -1,   140,
-      -1,   138,    -1,   139,    -1,    80,    -1,    81,    -1,    -1,
-     179,   277,   180,    -1,   278,    -1,   277,     3,   278,    -1,
-     279,    -1,     4,    -1,   280,     4,    -1,     4,   280,    -1,
-     280,     4,   279,    -1,    23,    -1,   280,    -1,   283,    -1,
-     179,   280,   180,    -1,   307,    -1,   281,    -1,    46,   282,
-     180,    -1,    39,   282,   180,    -1,    40,   179,   282,   180,
-      -1,    44,   179,   282,   180,    -1,    56,   282,   180,    -1,
-      79,   179,   282,   180,    -1,    45,   179,   280,   180,    -1,
-      47,   280,   180,    -1,   148,   179,   282,   180,    -1,    62,
-     179,   280,   180,    -1,    57,   179,   280,   180,    -1,    58,
-     179,   280,   180,    -1,    59,   179,   280,   180,    -1,    60,
-     179,   280,   180,    -1,    61,   179,   280,   180,    -1,    64,
-     179,   280,   180,    -1,    65,   179,   280,   180,    -1,    66,
-     179,   280,   180,    -1,    69,   179,   280,   180,    -1,    70,
-     179,   280,   180,    -1,    71,   179,   280,   180,    -1,    73,
-     280,   180,    -1,    74,   179,   282,   180,    -1,    75,   179,
-     282,   180,    -1,    76,   179,   282,   180,    -1,    77,   179,
-     282,   180,    -1,   280,    -1,   282,     3,   280,    -1,   288,
-      -1,   299,    -1,   293,    -1,   280,   285,    -1,   284,   280,
-      -1,    12,   280,    -1,    21,    -1,    22,    -1,    21,   280,
-      -1,    22,   280,    -1,    23,   280,    -1,    25,   280,    -1,
-      14,   280,    -1,     8,   280,    -1,    17,   280,    -1,   186,
-     280,    -1,    18,   280,    -1,   185,   280,    -1,    15,   280,
-      -1,   186,     5,   280,    -1,    16,   280,    -1,   185,     5,
-     280,    -1,    13,   280,    -1,     7,   280,    -1,     9,   280,
-      -1,    10,   280,    -1,    11,   280,    -1,    24,   286,    -1,
-       5,   287,    -1,    -1,   280,    -1,     5,   280,    -1,    24,
-     280,    -1,     5,   280,    -1,   280,    -1,   298,    -1,   292,
-      -1,   290,    -1,    -1,   291,    -1,   291,   302,    -1,   292,
-     179,   294,   180,    -1,   292,   179,   294,   180,   302,    -1,
-     298,   179,   294,   180,    -1,   288,   189,   288,    -1,   131,
-     360,   132,    -1,   289,    -1,   289,   295,    -1,   296,    -1,
-     295,     3,   296,    -1,   280,    -1,   297,    -1,   280,     4,
-     280,    -1,   280,     4,   280,     4,   280,    -1,     4,   280,
-       4,   280,    -1,     4,     4,   280,    -1,     4,   280,    -1,
-     280,     4,    -1,     4,    -1,   169,    -1,   142,    -1,   143,
-      -1,   176,    -1,   163,    -1,   164,    -1,   165,    -1,   299,
-     169,    -1,   300,   301,    -1,   158,    -1,   300,   158,    -1,
-     162,    -1,   159,    -1,    -1,   302,    -1,   179,   303,     4,
-     303,   180,    -1,    -1,   280,    -1,   187,    -1,   280,    -1,
-      -1,   306,     5,   280,    -1,   306,   126,   280,    -1,    -1,
-     179,   283,     3,   283,   180,    -1,   309,   310,    -1,   309,
-     310,     3,   311,    -1,   309,   310,     3,    31,     4,   187,
-      -1,   309,   310,     3,    31,     4,   313,    -1,   141,    -1,
-     169,    -1,   312,    -1,   311,     3,   312,    -1,   169,   126,
-     169,    -1,   314,    -1,   313,     3,   314,    -1,   169,   126,
-     169,    -1,   169,    -1,   328,    -1,    98,   179,   366,   370,
-     180,    -1,   105,   179,   369,   370,   180,    -1,   106,   179,
-     371,   180,    -1,   317,    -1,   318,   324,    -1,   316,   324,
-      -1,   319,   324,    -1,    96,   324,    -1,   321,    -1,   372,
-     328,    -1,    41,   179,   280,   180,   304,    -1,    42,    -1,
-      43,    -1,   372,    84,    -1,    85,   179,   280,   180,    84,
-      -1,    86,    -1,    87,   324,    -1,    48,   320,   180,    -1,
-      49,   179,   280,   180,    -1,   115,    -1,   110,    -1,    93,
-      -1,   153,    -1,   156,    -1,   155,    -1,   154,    -1,   280,
-      -1,   320,     3,   280,    -1,   320,     4,   280,    -1,   326,
-     323,   322,    -1,   327,   280,    -1,    94,   325,    -1,    -1,
-     373,     5,   280,     3,   280,    -1,   373,     5,   280,     3,
-     280,     3,   280,    -1,    -1,   176,   248,    -1,   187,    -1,
-     169,    -1,    -1,   169,    -1,    92,    -1,    97,    -1,   118,
-      -1,   330,   332,    -1,   365,    -1,   341,    -1,   333,    -1,
-      98,   179,   366,   370,   180,    -1,   105,   179,   369,   370,
-     180,    -1,    78,   303,    -1,    83,   304,    -1,    63,   304,
-      -1,   340,   304,    -1,   331,    -1,    -1,   298,   329,   276,
-     276,    -1,   330,   189,   298,   329,   276,   276,    -1,   176,
-      -1,   331,     3,   176,    -1,     5,   280,    -1,   126,   280,
-      -1,   336,   334,    -1,    -1,   179,   335,   180,    -1,    -1,
-     338,    -1,   337,   169,    -1,   124,    -1,   339,    -1,   338,
-       3,   339,    -1,   280,    -1,    23,   364,    -1,   133,    -1,
-     135,    -1,   349,   345,    -1,   351,   343,    -1,   352,   345,
-      -1,   352,   345,   360,    -1,   104,   346,    -1,    38,    -1,
-      -1,   356,    -1,   345,   342,    -1,   350,   344,    -1,    -1,
-       3,   356,    -1,   179,   347,   180,    -1,   179,   353,   180,
-      -1,   179,   298,   180,    -1,   179,   176,   180,    -1,   176,
-      -1,   179,   283,   180,    -1,   169,    -1,   348,    -1,   347,
-       3,   348,    -1,   353,    -1,    23,    -1,    25,    -1,   298,
-     280,   276,    -1,   298,   280,    -1,   298,   280,   189,   330,
-      -1,   298,   179,   297,   180,    -1,   298,    23,    -1,   298,
-      25,    -1,    99,    -1,   100,    -1,   354,    -1,    23,    -1,
-     103,    -1,   101,    -1,    88,    -1,   102,    -1,   354,    -1,
-     179,   353,   180,    -1,   288,    -1,   299,    -1,   353,   355,
-     353,    -1,   353,    23,   353,    -1,   353,    24,   353,    -1,
-     353,    25,   353,    -1,   355,   353,    -1,   353,    20,   353,
-      -1,    50,   280,    -1,    55,   280,    -1,    52,   280,    -1,
-      51,   280,    -1,   169,     5,   280,    -1,   281,    -1,    21,
-      -1,    22,    -1,   358,    -1,   356,     3,   358,    -1,    -1,
-     288,    -1,   357,   359,    -1,   179,   356,   180,   359,    -1,
-     281,   359,    -1,   299,   359,    -1,   179,   356,     3,   363,
-     180,    -1,    -1,   285,    -1,   359,   285,    -1,   283,    -1,
-     362,    -1,   361,    -1,   283,     3,   280,    -1,   283,     3,
-     362,    -1,   362,     3,   280,    -1,   362,     3,   362,    -1,
-     361,     3,   280,    -1,   361,     3,   362,    -1,   283,    -1,
-     281,    -1,   307,    -1,   179,   280,   180,    -1,   179,   283,
-       3,   363,   180,    -1,   179,   362,     3,   363,   180,    -1,
-     179,   361,     3,   363,   180,    -1,   169,     5,   280,     3,
-     280,    -1,   169,     5,   280,     3,   280,     3,   280,    -1,
-     176,    -1,    89,   179,   280,     3,   280,   180,     3,   280,
-      -1,    89,   364,    -1,   367,    -1,   330,    -1,   366,     3,
-     367,    -1,   298,    -1,   292,    -1,   368,    -1,   298,   179,
-     295,   180,    -1,   367,    -1,   369,     3,   367,    -1,    -1,
-       3,   125,     5,   298,    -1,   298,    -1,   371,     3,   298,
-      -1,    91,   280,   180,    -1,   298,    -1
-};
-
-/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
-static const yytype_uint16 yyrline[] =
-{
-       0,   336,   336,   337,   339,   340,   341,   342,   343,   346,
-     347,   349,   350,   351,   360,   361,   363,   365,   367,   374,
-     379,   380,   382,   384,   385,   387,   388,   394,   397,   398,
-     401,   402,   430,   448,   481,   515,   532,   539,   541,   545,
-     550,   553,   556,   561,   562,   563,   571,   582,   594,   595,
-     597,   605,   613,   619,   620,   635,   648,   649,   655,   656,
-     693,   706,   707,   708,   709,   710,   711,   712,   713,   714,
-     715,   734,   735,   741,   742,   743,   744,   745,   746,   747,
-     748,   749,   750,   751,   752,   753,   754,   755,   756,   757,
-     758,   759,   760,   761,   762,   763,   764,   766,   767,   769,
-     770,   772,   773,   775,   777,   778,   780,   781,   783,   784,
-     786,   870,   907,   913,   918,   923,   937,   951,   966,   973,
-     982,   983,   984,   985,   987,   992,   993,   998,  1002,  1007,
-    1012,  1014,  1016,  1018,  1020,  1024,  1025,  1028,  1030,  1031,
-    1032,  1033,  1035,  1037,  1042,  1047,  1053,  1069,  1086,  1087,
-    1089,  1093,  1098,  1102,  1107,  1113,  1124,  1136,  1141,  1147,
-    1152,  1156,  1166,  1175,  1185,  1186,  1188,  1192,  1197,  1220,
-    1222,  1223,  1225,  1235,  1237,  1239,  1272,  1307,  1309,  1311,
-    1315,  1320,  1326,  1334,  1335,  1337,  1338,  1340,  1341,  1342,
-    1344,  1349,  1351,  1356,  1360,  1363,  1369,  1371,  1377,  1378,
-    1380,  1381,  1383,  1384,  1385,  1387,  1388,  1390,  1391,  1400,
-    1404,  1409,  1411,  1414,  1415,  1417,  1418,  1419,  1421,  1422,
-    1424,  1428,  1429,  1431,  1436,  1438,  1440,  1441,  1442,  1443,
-    1449,  1452,  1453,  1454,  1456,  1458,  1461,  1466,  1470,  1472,
-    1476,  1481,  1485,  1490,  1495,  1503,  1504,  1506,  1507,  1509,
-    1511,  1515,  1517,  1519,  1521,  1523,  1525,  1527,  1529,  1531,
-    1533,  1535,  1537,  1539,  1541,  1543,  1545,  1547,  1549,  1551,
-    1553,  1555,  1557,  1559,  1561,  1563,  1565,  1568,  1569,  1573,
-    1574,  1576,  1578,  1580,  1582,  1585,  1586,  1588,  1590,  1592,
-    1594,  1596,  1598,  1600,  1602,  1604,  1606,  1608,  1610,  1612,
-    1614,  1616,  1618,  1620,  1622,  1624,  1626,  1628,  1631,  1632,
-    1634,  1636,  1639,  1641,  1645,  1650,  1655,  1661,  1673,  1678,
-    1680,  1683,  1687,  1697,  1703,  1706,  1707,  1710,  1711,  1714,
-    1715,  1717,  1719,  1722,  1724,  1725,  1726,  1727,  1729,  1787,
-    1789,  1790,  1791,  1792,  1793,  1794,  1796,  1798,  1800,  1801,
-    1803,  1806,  1807,  1809,  1812,  1813,  1815,  1816,  1818,  1819,
-    1827,  1836,  1838,  1841,  1861,  1895,  1915,  1966,  1974,  1977,
-    1981,  1991,  2002,  2006,  2016,  2028,  2037,  2038,  2044,  2050,
-    2051,  2101,  2119,  2139,  2158,  2203,  2204,  2205,  2206,  2207,
-    2208,  2209,  2210,  2211,  2212,  2213,  2214,  2215,  2216,  2260,
-    2270,  2279,  2288,  2297,  2298,  2299,  2301,  2302,  2303,  2305,
-    2306,  2307,  2308,  2309,  2311,  2312,  2314,  2315,  2317,  2319,
-    2326,  2327,  2328,  2329,  2330,  2331,  2337,  2343,  2344,  2345,
-    2346,  2347,  2349,  2350,  2360,  2362,  2363,  2365,  2366,  2368,
-    2396,  2397,  2399,  2400,  2402,  2432,  2434,  2435,  2438,  2452,
-    2455,  2456,  2459,  2460,  2461,  2462,  2463,  2464,  2476,  2477,
-    2479,  2480,  2485,  2486,  2488,  2489,  2491,  2492,  2493,  2494,
-    2495,  2497,  2498,  2500,  2501,  2502,  2503,  2504,  2505,  2506,
-    2507,  2508,  2510,  2511,  2513,  2514,  2517,  2518,  2519,  2522,
-    2525,  2526,  2528,  2529,  2530,  2531,  2532,  2533,  2534,  2535,
-    2536,  2537,  2538,  2539,  2540,  2541,  2543,  2544,  2546,  2547,
-    2549,  2550,  2552,  2553,  2554,  2555,  2556,  2558,  2559,  2560,
-    2562,  2563,  2564,  2566,  2568,  2570,  2572,  2574,  2576,  2578,
-    2579,  2581,  2583,  2585,  2587,  2589,  2593,  2596,  2603,  2605,
-    2606,  2608,  2609,  2610,  2612,  2614,  2615,  2617,  2624,  2625,
-    2627,  2628,  2630,  2631,  2639,  2641
-};
-#endif
-
-#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
-/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
-   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
-static const char *const yytname[] =
-{
-  "$end", "error", "$undefined", "','", "':'", "'='", "TOK_BINARY_OP",
-  "TOK_NEQV", "TOK_EQV", "TOK_XOR", "TOK_OR", "TOK_AND", "TOK_NOT",
-  "TOK_NE", "TOK_EQ", "TOK_GE", "TOK_LE", "TOK_GT", "TOK_LT",
-  "TOK_UNARY_OP", "TOK_DSLASH", "'+'", "'-'", "'*'", "TOK_SLASH",
-  "TOK_DASTER", "TOK_SEP", "TOK_SEMICOLON", "TOK_NEXTLINE",
-  "TOK_PARAMETER", "TOK_RESULT", "TOK_ONLY", "TOK_INCLUDE",
-  "TOK_SUBROUTINE", "TOK_PROGRAM", "TOK_FUNCTION", "TOK_OMP", "TOK_DOLLAR",
-  "TOK_FORMAT", "TOK_MAX", "TOK_TANH", "TOK_WHERE", "TOK_ELSEWHERE",
-  "TOK_ENDWHERE", "TOK_MAXVAL", "TOK_TRIM", "TOK_SUM", "TOK_SQRT",
-  "TOK_CASE", "TOK_SELECTCASE", "TOK_FILE", "TOK_END", "TOK_ERR",
-  "TOK_DONOTTREAT", "TOK_ENDDONOTTREAT", "TOK_EXIST", "TOK_MIN",
-  "TOK_FLOAT", "TOK_EXP", "TOK_COS", "TOK_COSH", "TOK_ACOS", "TOK_NINT",
-  "TOK_CYCLE", "TOK_SIN", "TOK_SINH", "TOK_ASIN", "TOK_EQUIVALENCE",
-  "TOK_BACKSPACE", "TOK_LOG", "TOK_TAN", "TOK_ATAN", "TOK_RECURSIVE",
-  "TOK_ABS", "TOK_MOD", "TOK_SIGN", "TOK_MINLOC", "TOK_MAXLOC", "TOK_EXIT",
-  "TOK_MINVAL", "TOK_PUBLIC", "TOK_PRIVATE", "TOK_ALLOCATABLE",
-  "TOK_RETURN", "TOK_THEN", "TOK_ELSEIF", "TOK_ELSE", "TOK_ENDIF",
-  "TOK_PRINT", "TOK_PLAINGOTO", "TOK_CONSTRUCTID", "TOK_LOGICALIF",
-  "TOK_PLAINDO", "TOK_CONTAINS", "TOK_ENDDO", "TOK_MODULE",
-  "TOK_ENDMODULE", "TOK_DOWHILE", "TOK_ALLOCATE", "TOK_OPEN", "TOK_CLOSE",
-  "TOK_INQUIRE", "TOK_WRITE", "TOK_READ", "TOK_REWIND", "TOK_DEALLOCATE",
-  "TOK_NULLIFY", "TOK_FIN", "TOK_DEBUT", "TOK_DIMENSION", "TOK_ENDSELECT",
-  "TOK_EXTERNAL", "TOK_INTENT", "TOK_INTRINSIC", "TOK_NAMELIST",
-  "TOK_CASEDEFAULT", "TOK_OPTIONAL", "TOK_POINTER", "TOK_CONTINUE",
-  "TOK_SAVE", "TOK_TARGET", "TOK_QUOTE", "TOK_IMPLICIT", "TOK_NONE",
-  "TOK_CALL", "TOK_STAT", "TOK_POINT_TO", "TOK_COMMON", "TOK_GLOBAL",
-  "TOK_INTERFACE", "TOK_ENDINTERFACE", "TOK_LEFTAB", "TOK_RIGHTAB",
-  "TOK_PAUSE", "TOK_PROCEDURE", "TOK_STOP", "TOK_NAMEEQ", "TOK_REAL8",
-  "TOK_OUT", "TOK_INOUT", "TOK_IN", "TOK_USE", "TOK_TRUE", "TOK_FALSE",
-  "TOK_LABEL", "TOK_TYPE", "TOK_TYPEPAR", "TOK_ENDTYPE", "TOK_REAL",
-  "TOK_INTEGER", "TOK_LOGICAL", "TOK_DOUBLEPRECISION", "TOK_DOUBLEREAL",
-  "TOK_ENDSUBROUTINE", "TOK_ENDFUNCTION", "TOK_ENDPROGRAM", "TOK_ENDUNIT",
-  "TOK_CHARACTER", "TOK_CHAR_CONSTANT", "TOK_CHAR_CUT", "TOK_DATA",
-  "TOK_CHAR_INT", "TOK_CHAR_MESSAGE", "TOK_CSTREAL", "TOK_CSTREALDP",
-  "TOK_CSTREALQP", "TOK_SFREAL", "TOK_COMPLEX", "TOK_DOUBLECOMPLEX",
-  "TOK_NAME", "TOK_NAME_CHAR", "TOK_PROBTYPE", "TOK_INTERPTYPE",
-  "TOK_VARTYPE", "TOK_BC", "TOK_OP", "TOK_CSTINT", "TOK_COMMENT",
-  "TOK_FILENAME", "'('", "')'", "'['", "']'", "'!'", "'_'", "'<'", "'>'",
-  "'\\n'", "'/'", "'%'", "$accept", "input", "line", "suite_line_list",
-  "suite_line", "instr", "fin_line", "keyword", "position", "thislabel",
-  "cmnt", "nulcurbuf", "opt_recursive", "entry", "name_routine",
-  "writedeclar", "before_include", "filename", "arglist", "arglist1",
-  "args", "arg", "spec", "opt_spec", "name_intrinsic",
-  "use_intrinsic_list", "list_couple", "list_expr_equi", "expr_equi",
-  "list_expr_equi1", "list_expr", "opt_sep", "after_type",
-  "before_function", "before_parameter", "before_data", "data",
-  "datavallist", "save", "before_save", "varsave", "datanamelist",
-  "expr_data", "opt_signe", "namelist", "namelist_action",
-  "after_namelist", "interface", "before_dimension", "dimension",
-  "private", "public", "use_name_list", "common", "before_common",
-  "var_common_list", "var_common", "comblock", "opt_comma", "paramlist",
-  "paramitem", "module_proc_stmt", "proc_name_list", "implicit",
-  "opt_retour", "dcl", "nodimsgiven", "type", "before_typepar",
-  "c_selector", "c_attribute", "before_character", "typespec", "typename",
-  "lengspec", "proper_lengspec", "selector", "proper_selector",
-  "attribute", "clause", "opt_clause", "options", "attr_spec_list",
-  "attr_spec", "intent_spec", "access_spec", "dims", "dimlist", "dim",
-  "ubound", "expr", "predefinedfunction", "minmaxlist", "uexpr", "signe",
-  "operation", "after_slash", "after_equal", "lhs", "beforefunctionuse",
-  "array_ele_substring_func_ref", "begin_array", "structure_component",
-  "vec", "funarglist", "funargs", "funarg", "triplet", "ident",
-  "simple_const", "string_constant", "opt_substring", "substring",
-  "optexpr", "opt_expr", "initial_value", "before_initial",
-  "complex_const", "use_stat", "word_use", "module_name", "rename_list",
-  "rename_name", "only_list", "only_name", "exec", "word_endsubroutine",
-  "word_endunit", "word_endprogram", "word_endfunction", "caselist",
-  "boucledo", "do_arg", "opt_int", "opt_name", "optname", "worddo",
-  "wordwhile", "iffable", "before_dims", "ident_dims", "int_list",
-  "after_ident_dims", "call", "opt_call", "opt_callarglist", "keywordcall",
-  "before_call", "callarglist", "callarg", "stop", "io", "option_inlist",
-  "option_read", "opt_inlist", "ioctl", "after_rewind", "ctllist",
-  "ioclause", "iofctl", "infmt", "read", "write", "fexpr", "unpar_fexpr",
-  "addop", "inlist", "opt_lhs", "inelt", "opt_operation", "outlist",
-  "out2", "other", "dospec", "label", "goto", "allocation_list",
-  "allocate_object", "array_element", "allocate_object_list",
-  "opt_stat_spec", "pointer_name_list", "logif", "do_var", 0
-};
-#endif
-
-# ifdef YYPRINT
-/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
-   token YYLEX-NUM.  */
-static const yytype_uint16 yytoknum[] =
-{
-       0,   256,   257,    44,    58,    61,   258,   259,   260,   261,
-     262,   263,   264,   265,   266,   267,   268,   269,   270,   271,
-     272,    43,    45,    42,   273,   274,   275,   276,   277,   278,
-     279,   280,   281,   282,   283,   284,   285,   286,   287,   288,
-     289,   290,   291,   292,   293,   294,   295,   296,   297,   298,
-     299,   300,   301,   302,   303,   304,   305,   306,   307,   308,
-     309,   310,   311,   312,   313,   314,   315,   316,   317,   318,
-     319,   320,   321,   322,   323,   324,   325,   326,   327,   328,
-     329,   330,   331,   332,   333,   334,   335,   336,   337,   338,
-     339,   340,   341,   342,   343,   344,   345,   346,   347,   348,
-     349,   350,   351,   352,   353,   354,   355,   356,   357,   358,
-     359,   360,   361,   362,   363,   364,   365,   366,   367,   368,
-     369,   370,   371,   372,   373,   374,   375,   376,   377,   378,
-     379,   380,   381,   382,   383,   384,   385,   386,   387,   388,
-     389,   390,   391,   392,   393,   394,   395,   396,   397,   398,
-     399,   400,   401,   402,   403,   404,   405,   406,   407,   408,
-     409,   410,   411,   412,   413,   414,   415,   416,   417,   418,
-     419,   420,   421,   422,   423,   424,   425,   426,   427,    40,
-      41,    91,    93,    33,    95,    60,    62,    10,    47,    37
-};
-# endif
-
-/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
-static const yytype_uint16 yyr1[] =
-{
-       0,   190,   191,   191,   192,   192,   192,   192,   192,   193,
-     193,   194,   194,   194,   194,   194,   195,   196,   197,   197,
-     197,   197,   198,   199,   199,   200,   200,   201,   202,   202,
-     203,   203,   203,   203,   203,   203,   204,   205,   206,   207,
-     208,   208,   208,   209,   209,   209,   210,   210,   211,   211,
-     212,   212,   212,   212,   212,   212,   212,   212,   212,   212,
-     212,   212,   212,   212,   212,   212,   212,   212,   212,   212,
-     212,   213,   213,   214,   214,   214,   214,   214,   214,   214,
-     214,   214,   214,   214,   214,   214,   214,   214,   214,   214,
-     214,   214,   214,   214,   214,   214,   214,   215,   215,   216,
-     216,   217,   217,   218,   219,   219,   220,   220,   221,   221,
-     222,   222,   223,   224,   225,   226,   226,   226,   227,   227,
-     228,   228,   228,   228,   229,   230,   230,   231,   231,   231,
-     232,   232,   232,   232,   232,   233,   233,   234,   235,   235,
-     235,   235,   236,   237,   237,   238,   239,   239,   240,   240,
-     241,   241,   242,   242,   243,   243,   243,   244,   244,   245,
-     245,   246,   247,   247,   248,   248,   249,   249,   250,   251,
-     252,   252,   253,   253,   254,   255,   255,   256,   257,   257,
-     257,   257,   258,   259,   259,   259,   259,   260,   260,   260,
-     261,   262,   263,   263,   263,   263,   263,   263,   264,   264,
-     265,   265,   266,   266,   266,   267,   267,   268,   268,   268,
-     268,   269,   269,   270,   270,   271,   271,   271,   272,   272,
-     273,   273,   273,   273,   273,   273,   273,   273,   273,   273,
-     273,   274,   274,   274,   275,   275,   276,   276,   277,   277,
-     278,   278,   278,   278,   278,   279,   279,   280,   280,   280,
-     280,   281,   281,   281,   281,   281,   281,   281,   281,   281,
-     281,   281,   281,   281,   281,   281,   281,   281,   281,   281,
-     281,   281,   281,   281,   281,   281,   281,   282,   282,   283,
-     283,   283,   283,   283,   283,   284,   284,   285,   285,   285,
-     285,   285,   285,   285,   285,   285,   285,   285,   285,   285,
-     285,   285,   285,   285,   285,   285,   285,   285,   286,   286,
-     286,   286,   287,   287,   288,   288,   288,   289,   290,   290,
-     290,   290,   291,   292,   293,   294,   294,   295,   295,   296,
-     296,   297,   297,   297,   297,   297,   297,   297,   298,   299,
-     299,   299,   299,   299,   299,   299,   299,   300,   300,   300,
-     300,   301,   301,   302,   303,   303,   304,   304,   305,   305,
-     305,   306,   307,   308,   308,   308,   308,   309,   310,   311,
-     311,   312,   313,   313,   314,   314,   315,   315,   315,   315,
-     315,   315,   315,   315,   315,   315,   315,   315,   315,   315,
-     315,   315,   315,   315,   315,   315,   315,   315,   315,   316,
-     317,   318,   319,   320,   320,   320,   321,   321,   321,   322,
-     322,   322,   323,   323,   324,   324,   325,   325,   326,   327,
-     328,   328,   328,   328,   328,   328,   328,   328,   328,   328,
-     328,   328,   329,   330,   330,   331,   331,   332,   332,   333,
-     334,   334,   335,   335,   336,   337,   338,   338,   339,   339,
-     340,   340,   341,   341,   341,   341,   341,   341,   342,   342,
-     343,   343,   344,   344,   345,   345,   346,   346,   346,   346,
-     346,   347,   347,   348,   348,   348,   348,   348,   348,   348,
-     348,   348,   349,   349,   350,   350,   351,   351,   351,   352,
-     353,   353,   354,   354,   354,   354,   354,   354,   354,   354,
-     354,   354,   354,   354,   354,   354,   355,   355,   356,   356,
-     357,   357,   358,   358,   358,   358,   358,   359,   359,   359,
-     360,   360,   360,   361,   361,   361,   361,   361,   361,   361,
-     361,   362,   362,   362,   362,   362,   363,   363,   364,   365,
-     365,   366,   366,   366,   367,   367,   367,   368,   369,   369,
-     370,   370,   371,   371,   372,   373
-};
-
-/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN.  */
-static const yytype_uint8 yyr2[] =
-{
-       0,     2,     0,     2,     2,     2,     1,     3,     3,     1,
-       3,     2,     2,     3,     3,     2,     2,     2,     1,     1,
-       1,     1,     0,     0,     2,     0,     1,     0,     0,     1,
-       0,     4,     2,     6,     4,     2,     1,     0,     1,     1,
-       0,     2,     3,     0,     2,     3,     1,     3,     1,     1,
-       2,     4,     2,     2,     4,     2,     1,     1,     1,     1,
-       1,     1,     1,     1,     1,     1,     4,     3,     3,     2,
-       3,     0,     1,     1,     1,     1,     1,     1,     1,     1,
-       1,     1,     1,     1,     1,     1,     1,     1,     1,     1,
-       1,     1,     1,     1,     1,     1,     1,     1,     3,     3,
-       5,     1,     3,     3,     2,     4,     1,     3,     0,     2,
-       2,     3,     1,     1,     1,     4,     6,     4,     1,     3,
-       2,     3,     5,     3,     1,     0,     2,     1,     4,     3,
-       2,     3,     3,     3,     3,     0,     1,     2,     2,     3,
-       5,     3,     0,     2,     2,     1,     5,     5,     2,     3,
-       2,     3,     1,     3,     2,     3,     5,     1,     2,     1,
-       3,     2,     1,     3,     0,     1,     1,     3,     3,     2,
-       1,     3,     2,     2,     0,     6,     7,     0,     2,     2,
-       3,     3,     1,     0,     2,     4,     3,     3,     4,     2,
-       1,     1,     1,     1,     1,     1,     1,     1,     0,     2,
-       1,     3,     0,     2,     3,     1,     3,     2,     3,     1,
-       1,     1,     1,     0,     3,     0,     2,     4,     1,     3,
-       1,     1,     1,     2,     1,     4,     1,     1,     1,     1,
-       1,     1,     1,     1,     1,     1,     0,     3,     1,     3,
-       1,     1,     2,     2,     3,     1,     1,     1,     3,     1,
-       1,     3,     3,     4,     4,     3,     4,     4,     3,     4,
-       4,     4,     4,     4,     4,     4,     4,     4,     4,     4,
-       4,     4,     3,     4,     4,     4,     4,     1,     3,     1,
-       1,     1,     2,     2,     2,     1,     1,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,     3,     2,
-       3,     2,     2,     2,     2,     2,     2,     2,     0,     1,
-       2,     2,     2,     1,     1,     1,     1,     0,     1,     2,
-       4,     5,     4,     3,     3,     1,     2,     1,     3,     1,
-       1,     3,     5,     4,     3,     2,     2,     1,     1,     1,
-       1,     1,     1,     1,     1,     2,     2,     1,     2,     1,
-       1,     0,     1,     5,     0,     1,     1,     1,     0,     3,
-       3,     0,     5,     2,     4,     6,     6,     1,     1,     1,
-       3,     3,     1,     3,     3,     1,     1,     5,     5,     4,
-       1,     2,     2,     2,     2,     1,     2,     5,     1,     1,
-       2,     5,     1,     2,     3,     4,     1,     1,     1,     1,
-       1,     1,     1,     1,     3,     3,     3,     2,     2,     0,
-       5,     7,     0,     2,     1,     1,     0,     1,     1,     1,
-       1,     2,     1,     1,     1,     5,     5,     2,     2,     2,
-       2,     1,     0,     4,     6,     1,     3,     2,     2,     2,
-       0,     3,     0,     1,     2,     1,     1,     3,     1,     2,
-       1,     1,     2,     2,     2,     3,     2,     1,     0,     1,
-       2,     2,     0,     2,     3,     3,     3,     3,     1,     3,
-       1,     1,     3,     1,     1,     1,     3,     2,     4,     4,
-       2,     2,     1,     1,     1,     1,     1,     1,     1,     1,
-       1,     3,     1,     1,     3,     3,     3,     3,     2,     3,
-       2,     2,     2,     2,     3,     1,     1,     1,     1,     3,
-       0,     1,     2,     4,     2,     2,     5,     0,     1,     2,
-       1,     1,     1,     3,     3,     3,     3,     3,     3,     1,
-       1,     1,     3,     5,     5,     5,     5,     7,     1,     8,
-       2,     1,     1,     3,     1,     1,     1,     4,     1,     3,
-       0,     4,     1,     3,     3,     1
-};
-
-/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
-   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
-   means the default is an error.  */
-static const yytype_uint16 yydefact[] =
-{
-       2,     0,     1,    37,    20,    21,    18,    19,    27,     6,
-      22,     3,    25,    30,    27,    24,     4,    26,    37,   113,
-      38,     0,   457,     0,   388,   389,     0,     0,     0,     0,
-       0,    29,   354,   108,   108,     0,     0,   392,     0,   488,
-       0,     0,   418,   398,   416,     0,     0,   419,     0,   482,
-     483,   487,   489,   486,     0,     0,     0,   145,   397,   108,
-     108,     0,   396,     0,   420,   124,     0,   445,   157,     0,
-       0,     0,   450,     0,   451,   367,    71,   182,     0,   193,
-     192,   197,   195,   399,   402,   401,   400,   190,   114,   194,
-     196,   338,   435,     5,     9,    22,     0,    22,     0,    22,
-       0,     0,    57,   125,    65,   142,    64,   164,    59,    61,
-      60,    56,     0,    63,    58,   215,     0,   183,   202,   191,
-     432,    62,     0,    25,     0,   380,     0,     0,   385,   412,
-       0,   376,     0,   431,   424,   440,     0,     0,   423,     0,
-       0,     0,   422,     0,     8,     7,    36,    32,     0,     0,
-     285,   286,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   339,   340,
-       0,   347,   350,   349,   342,   343,   344,   341,     0,   403,
-     250,   247,     0,   279,   316,   318,   315,   281,   314,   280,
-     351,   249,     0,     0,   356,   357,   429,     0,    69,   101,
-       0,   355,   427,     0,   150,     0,   148,     0,   428,     0,
-     415,   414,   393,   538,     0,   540,     0,   417,   408,    35,
-     384,     0,   470,   468,     0,   456,     0,     0,     0,     0,
-     162,     0,     0,   138,     0,    53,   172,   173,   158,   143,
-     144,   170,   169,   234,   235,   108,    72,    52,    30,    15,
-      25,     0,     0,    11,    39,    22,    12,     0,     0,    55,
-     166,   127,   164,     0,   125,     0,   236,   120,   125,   165,
-     137,     0,   165,     0,     0,     0,   236,   154,   159,     0,
-       0,     0,   112,    50,     0,   177,   174,   209,   210,     0,
-       0,     0,   179,     0,     0,   178,     0,    16,   236,   368,
-     363,    37,   382,   381,   383,   164,   409,   407,     0,     0,
-       0,   421,     0,   442,   439,   444,   430,     0,   452,   506,
-     507,   485,     0,     0,     0,     0,   338,     0,   505,   492,
-     493,   453,   458,   462,     0,   484,     0,   454,   390,     0,
-       0,   432,   386,     0,   284,   277,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,   530,   520,   249,     0,   522,   521,     0,
-       0,   247,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   308,     0,     0,
-       0,   282,   283,     0,   354,   319,   317,   317,   345,   348,
-     346,   352,     0,     0,   394,     0,     0,   236,     0,     0,
-     109,   152,   151,   149,     0,     0,   554,     0,   545,   432,
-     542,   550,   541,   546,   341,   247,   314,   544,   548,   550,
-     552,     0,    67,    74,    75,    78,    73,    79,    76,    81,
-      82,    83,    84,    85,    80,    86,    87,    88,    89,    90,
-      91,    92,    93,    94,    95,    77,    96,    97,    68,     0,
-     139,     0,   106,     0,     0,     0,    10,    17,    40,    40,
-      13,     0,     0,     0,   135,     0,    70,     0,     0,   135,
-     123,   164,     0,   126,   121,   141,   164,   236,   236,   164,
-     161,     0,   155,   220,   222,   236,   224,     0,   226,   227,
-     228,   229,   230,     0,   218,   221,   216,    40,   174,   110,
-       0,     0,   212,   207,   211,   181,   184,     0,   338,     0,
-     213,     0,   203,   205,     0,   180,   236,     0,    14,   413,
-     555,   406,     0,   437,   438,   432,   436,     0,   448,     0,
-     443,   446,   474,   475,     0,   314,     0,   471,   473,   490,
-     500,   503,   502,   501,     0,   473,   510,   517,   511,   517,
-     460,   459,   517,   508,   510,   461,     0,     0,     0,     0,
-       0,   498,   455,     0,     0,     0,     0,   252,     0,     0,
-       0,   251,   258,   255,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   272,     0,     0,     0,
-       0,     0,     0,   247,     0,     0,     0,   324,     0,     0,
-       0,   248,     0,     0,   313,   307,   302,   292,   303,   304,
-     305,   301,   291,   297,   299,   293,   295,   287,   288,   289,
-       0,     0,   309,   306,   290,     0,   296,     0,   294,   323,
-       0,   325,     0,     0,   404,   405,   395,     0,   103,   104,
-     102,    66,     0,     0,     0,   317,     0,     0,   467,   469,
-     466,     0,     0,     0,   379,     0,   163,     0,    99,     0,
-     171,    51,     0,    31,    34,   168,    54,   167,     0,   118,
-       0,   136,     0,     0,   127,   129,     0,   125,   241,   245,
-       0,   238,   240,   246,     0,   198,   198,     0,   160,   223,
-       0,     0,     0,   111,     0,   236,   208,     0,     0,   213,
-     186,     0,   189,     0,   204,   433,     0,     0,   364,   369,
-       0,   236,   449,   441,     0,     0,   480,   481,   317,   236,
-       0,   464,   465,   504,   465,     0,   518,   514,   515,   510,
-     512,   463,   499,   495,   496,   497,   494,   550,   550,   387,
-     278,   253,   254,   257,   261,   262,   263,   264,   265,   260,
-     266,   267,   268,   269,   270,   271,   273,   274,   275,   276,
-     256,   248,     0,     0,     0,   523,   524,   527,   528,   525,
-     526,   259,   247,   312,   310,   311,   300,   298,   354,   337,
-     329,   326,   327,   330,   320,   322,   236,   153,   391,     0,
-       0,     0,   543,   377,   549,   378,   553,    98,   107,     0,
-      49,    48,    41,     0,    46,    43,   115,   135,   135,   135,
-     135,   135,   130,   128,   135,   117,   122,   243,     0,   237,
-     242,   140,     0,   146,   147,   156,   232,   233,   231,     0,
-     219,   217,   236,   198,   185,   213,   187,     0,   206,     0,
-       0,     0,     0,   236,   447,   491,     0,     0,     0,   476,
-     472,   473,   510,   517,   519,   509,     0,     0,   338,     0,
-       0,     0,   362,     0,     0,   335,   336,     0,   321,   105,
-       0,   547,     0,   100,     0,    42,     0,    33,   119,   131,
-     132,   133,   134,     0,   239,   244,   246,     0,   199,   200,
-     225,   198,   358,   188,   214,   375,   365,   366,   372,   371,
-     370,     0,   434,   479,   478,     0,   513,   425,   426,     0,
-     533,   535,   534,   353,   334,     0,   331,   328,     0,   551,
-      47,    44,     0,   116,     0,   358,   175,     0,     0,     0,
-     410,   516,     0,   333,     0,   539,    45,   201,   176,     0,
-       0,   374,   373,     0,     0,   332,   359,   360,   411,   536,
-       0,   537
-};
-
-/* YYDEFGOTO[NTERM-NUM].  */
-static const yytype_int16 yydefgoto[] =
-{
-      -1,     1,    11,    93,    94,    95,   259,    12,   260,    13,
-      18,    15,    96,    97,   147,    14,    98,   265,   693,   907,
-     833,   834,    99,   255,   477,   478,   245,   208,   209,   426,
-     481,   215,   293,   294,   100,   101,   272,   698,   102,   103,
-     277,   273,   699,   700,   104,   105,   280,   106,   107,   108,
-     109,   110,   432,   111,   112,   287,   288,   242,   275,   269,
-     270,   113,   252,   114,   530,   295,   529,   115,   116,   302,
-     539,   117,   118,   119,   853,   918,   305,   542,   299,   540,
-     732,   296,   523,   524,   859,   525,   503,   710,   711,   712,
-     355,   190,   356,   191,   192,   411,   653,   635,   193,   661,
-     194,   195,   196,   197,   663,   811,   812,   813,   198,   199,
-     200,   420,   415,   212,   206,   956,   957,   201,   121,   122,
-     310,   738,   739,   927,   928,   123,   124,   125,   126,   127,
-     202,   128,   551,   316,   222,   228,   129,   130,   131,   308,
-     132,   133,   321,   134,   324,   559,   135,   136,   560,   561,
-     137,   138,   580,   341,   585,   328,   235,   566,   567,   139,
-     343,   140,   141,   344,   569,   346,   581,   582,   583,   757,
-     386,   387,   388,   889,   225,   142,   441,   442,   443,   449,
-     677,   451,   143,   552
-};
-
-/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
-   STATE-NUM.  */
-#define YYPACT_NINF -711
-static const yytype_int16 yypact[] =
-{
-    -711,   923,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,   -98,  5724,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,   -51,  -711,   -47,  -711,  -711,  4731,    54,  2666,    70,
-     115,  -711,  4731,    34,    40,  2666,   117,  -711,   -63,  -711,
-       7,  4731,  -711,  -711,   -39,    66,   -63,  -711,   137,  -711,
-    -711,  -711,  -711,  -711,   184,   141,   170,  -711,  -711,   199,
-     199,   155,  -711,   175,  -711,  -711,    37,  -711,  -711,    92,
-     -63,   -63,  -711,   129,  -711,  -711,   116,  -711,   -63,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,   217,  -711,  -711,    31,  -711,    96,  -711,
-     -64,   187,    97,   156,  -711,   149,  -711,   384,   390,  -711,
-    -711,   395,   165,  -711,  -711,    91,   -15,    80,   125,   372,
-     416,  -711,   253,   -98,   -63,  -711,   -63,   -63,  -711,   247,
-    4731,  -711,    24,   434,  -711,   267,   278,  2666,  -711,   270,
-    5575,   270,  -711,  2341,  -711,  -711,  -711,  -711,  4731,  4731,
-    -711,  -711,  4731,   276,   279,   280,  4731,  4731,  4731,   285,
-     291,   292,   296,   299,   301,   309,   310,   313,   316,   317,
-     318,  4731,   319,   325,   328,   329,   330,  4859,  -711,  -711,
-     331,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  4731,  2530,
-    -711,  -711,  4731,   304,  -711,   334,   342,  -711,   343,   354,
-     -33,  -711,    43,  4731,  -711,  2530,  -711,   356,   528,  -711,
-    4731,  2530,  -711,   534,  -711,   376,  -711,   376,  -711,  4731,
-    -711,  -711,  -711,  -711,  4731,  -711,  1494,  -711,  -711,  -711,
-    -711,   356,  -711,  -711,  4987,  -711,   356,   356,   376,  2588,
-    -711,   377,   356,  -711,  4731,   544,  -711,  -711,  -711,  -711,
-    -711,  -711,   546,  -711,  -711,   199,  -711,  -711,  5724,  -711,
-     -98,   -51,   -51,  -711,  -711,  -711,  -711,   557,   394,   561,
-    -711,    21,    33,   144,   397,   139,   388,  -711,   397,   356,
-    -711,   139,  -711,   399,   402,   139,   388,   571,  -711,   407,
-     733,   575,  -711,  -711,   -51,   572,  -711,  3067,  -711,   401,
-     215,  3963,  -711,  5115,   -15,  -711,   425,  -711,   388,  -711,
-     601,  -711,  -711,  -711,  -711,   384,   356,  2530,  4731,  4731,
-     356,  -711,   429,  4091,  -711,  -711,  -711,  5430,  -711,  -711,
-    -711,  -711,  4731,  4731,  4731,  4731,   610,  5430,  -711,   304,
-     354,  -711,  1098,   616,   588,   618,  5621,  4859,  -711,   441,
-     443,  -711,  -711,  1515,   670,  2530,    27,  4731,  4731,  4731,
-      36,  1550,    45,  4731,  4731,  4731,  4731,  4731,  4731,  4731,
-    4731,  4731,  4731,  4731,  4731,  1572,  4731,  4731,  4731,  4731,
-    4731,  4859,  2530,  1594,   782,  -711,   500,   630,   631,  4731,
-    1615,   633,  3451,  4731,  4731,  4731,  4731,  4731,  4731,  4731,
-    4731,  4731,  4731,  4731,  4731,  4731,  4731,  3195,  4731,  3579,
-    3707,  -711,   128,   356,  4731,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  4731,  4731,  -711,  1637,    48,   388,    70,  1697,
-    -711,  -711,   641,   641,  1819,  1173,  -711,   304,   -24,    -1,
-     457,   647,  -711,  -711,   471,   472,   151,    -1,  -711,   650,
-    -711,    62,   641,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,   651,   634,
-    -711,    71,  2530,   476,   488,   -63,  -711,  -711,   480,   480,
-    -711,  4731,    72,   394,   314,  4731,  -711,   491,   495,   314,
-    -711,   384,  2538,  -711,  -711,  -711,   384,   388,   388,   384,
-    -711,   407,   571,  -711,  -711,   388,  -711,   486,  -711,  -711,
-    -711,  -711,  -711,   358,  -711,  -711,  -711,   480,  -711,  -711,
-     497,  4219,  -711,  -711,  2530,  -711,  -711,  3963,  3323,   487,
-     665,  4347,  -711,  2530,   489,  -711,   388,    23,  -711,  -711,
-    -711,  -711,   667,  2530,  2530,  -711,  -711,   498,  2530,   493,
-     672,  -711,  -711,  -711,  5621,  3835,    75,  -711,   119,  -711,
-    2530,  2530,  2530,  2530,  4731,   530,  5850,  2530,   304,  1840,
-    -711,   674,  2530,  -711,  5850,  -711,  5621,  5621,  5621,  5621,
-    5621,   654,  -711,   356,   356,  2666,  4731,  -711,    84,    85,
-    1879,  -711,  -711,  -711,  1900,  1921,  1942,  1963,  2006,  2027,
-    2145,  2209,  2230,  2251,  2272,  2293,  -711,    86,    88,    89,
-      90,    98,  2327,   678,   687,   693,  4859,  -711,  4859,  4859,
-      99,  -711,  4731,  4731,  2530,  -711,   710,   710,   569,   569,
-     670,   814,   814,   814,   814,   814,   814,   133,   133,   128,
-    4731,  4731,  2530,  -711,   128,  4731,   814,  4731,   814,   304,
-     695,  2811,   517,   520,  2530,  2530,  -711,   356,  -711,  -711,
-    -711,  -711,   532,   619,  4731,  2811,   -49,   526,  -711,  -711,
-    -711,   -49,   527,   356,  -711,  2588,  -711,  4731,  -711,  4731,
-    -711,  -711,    67,  -711,   681,  2530,  -711,  -711,   689,    50,
-     716,  -711,  2348,   691,   538,  -711,   705,   397,  4731,  -711,
-     105,  -711,  -711,  1384,   356,   707,   707,   407,  -711,  -711,
-     287,   733,   732,  -711,   568,   388,  -711,   558,  4219,   665,
-    -711,   570,  -711,   560,  -711,  -711,   738,   617,   741,  -711,
-    4731,   388,  -711,  -711,  4091,   536,  -711,  -711,  2811,   519,
-    5430,  -711,  -711,  2530,   727,   106,  -711,  2530,  2530,  5850,
-    2530,   674,   574,   654,   654,   654,   406,   647,   650,  -711,
-    2530,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  5243,  5243,  5243,  2530,  -711,  2530,  -711,  2530,
-    -711,  -711,   573,   814,   814,   128,   814,   814,  4731,  2939,
-    1406,   745,  -711,  -711,   334,  -711,   388,  -711,  -711,  2475,
-     107,   744,  -711,  -711,  -711,  -711,  -711,  -711,  2530,   109,
-    -711,  -711,  -711,   110,  -711,   577,  -711,   314,   314,   314,
-     314,   314,   354,  -711,   314,  -711,  -711,  2530,  2538,  -711,
-    4475,  -711,  5371,  -711,  -711,   571,  -711,  -711,  -711,   579,
-    -711,  -711,   388,   707,  -711,   665,  -711,  4219,  -711,   -50,
-     581,   582,  1196,   388,  -711,  -711,  1362,   580,   356,  -711,
-    -711,   588,  5891,  2530,  -711,  -711,   583,   584,   747,   585,
-     590,   591,  -711,   592,  4731,  1428,  4731,  2811,  -711,  -711,
-     754,  -711,   356,  -711,    26,  -711,    93,  -711,  -711,    29,
-      29,   586,   113,   737,  -711,  -711,  2530,  4603,  -711,  2530,
-    -711,   707,    64,  -711,  -711,   649,  -711,   770,  -711,  -711,
-    -711,  4731,  -711,  -711,   457,   596,  2530,  -711,  -711,  4731,
-    -711,  -711,  -711,  -711,  2530,  4731,  1471,  -711,  4731,  -711,
-    -711,  -711,   111,  -711,   597,    64,  -711,   162,   609,   611,
-    1282,  -711,  1305,  2530,  4731,  2530,  -711,  -711,  -711,  4731,
-    4731,  -711,  -711,  4731,  4731,  2530,  2530,  2530,  2530,  1328,
-    4731,  2530
-};
-
-/* YYPGOTO[NTERM-NUM].  */
-static const yytype_int16 yypgoto[] =
-{
-    -711,  -711,  -711,  -711,   523,  -711,    30,  -711,   774,  -711,
-     -66,   772,  -711,  -711,    65,     6,  -711,  -711,  -430,  -711,
-    -118,  -110,  -711,  -711,   123,  -711,  -711,  -711,   373,  -711,
-     120,     1,  -711,  -711,  -711,  -711,  -711,  -480,  -711,  -711,
-    -264,   312,  -439,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,   -68,  -711,  -711,  -276,   300,   -35,   -85,   548,
-     324,  -711,  -711,  -711,   274,  -711,  -711,  -711,  -711,  -711,
-     281,  -711,  -711,  -711,  -699,  -711,  -711,  -711,   515,  -290,
-    -666,  -711,  -711,   100,  -711,   749,  -104,  -711,   -25,   -17,
-     -26,  -136,    56,  -176,  -432,  -497,  -711,  -711,  -103,  -711,
-    -711,  -711,  -204,  -711,   404,   159,   -57,    95,    -5,   -70,
-    -711,  -711,  -197,  -398,   -30,  -108,  -711,  -166,  -711,  -711,
-    -711,  -711,   -23,  -711,  -105,  -711,  -711,  -711,  -711,  -711,
-    -711,  -711,  -711,  -711,   -28,  -711,  -711,  -711,   708,   302,
-    -208,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,   118,
-    -711,  -711,  -711,  -711,  -711,   277,  -711,  -711,   114,  -711,
-    -711,  -711,  -711,  -306,   720,  -263,  -226,  -711,  -673,  -554,
-     514,   482,  -326,  -710,   308,  -711,   273,  -202,  -711,   275,
-    -416,  -711,  -711,  -711
-};
-
-/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
-   positive, shift that token.  If negative, reduce the rule which
-   number is the opposite.  If zero, do what YYDEFACT says.
-   If YYTABLE_NINF, syntax error.  */
-#define YYTABLE_NINF -511
-static const yytype_int16 yytable[] =
-{
-     189,   384,   205,   421,   338,   218,   211,   533,   120,   205,
-     500,   385,   391,   512,   504,   226,   660,   854,   230,   706,
-     281,   568,   283,   440,   145,   758,   285,   438,   760,   318,
-     596,   575,   438,   682,   448,   217,   282,   339,   213,   596,
-     591,   383,   249,   250,   213,   494,   422,   423,   596,   830,
-     257,   667,   840,   837,   736,   625,   243,   311,   445,   694,
-     238,   239,   701,   866,   261,   683,   262,   701,   278,  -361,
-     340,   838,   839,   840,   687,   493,   821,   289,   750,    17,
-     756,   590,   756,   890,   891,   756,   885,   596,   596,   596,
-     830,   596,   596,   596,   290,   291,   312,   723,   313,   314,
-     274,   596,   596,   300,   317,   267,   220,   326,   848,   882,
-     897,   205,   687,   904,   904,   268,   830,  -164,   146,   925,
-      91,  -164,   353,   354,   221,   419,   292,   263,   437,   266,
-     227,   361,   148,   437,   838,   839,   840,   926,   351,   586,
-     329,   330,   587,   588,   589,   375,   414,   498,   303,   433,
-     319,   382,   279,   408,   297,   416,   406,   407,   408,   240,
-     246,   298,   390,   241,   922,  -315,   412,   969,   499,  -164,
-     452,   384,   935,  -164,   247,   240,   240,   425,   675,   241,
-     241,   385,   510,   223,   429,   240,   224,   497,  -314,   241,
-    -361,   338,   737,   434,   487,   831,   253,   254,   435,   923,
-     495,   338,   427,   213,   546,   623,   577,   597,   382,   885,
-     338,   383,   360,   320,   362,   385,   601,   841,   482,   248,
-     496,   214,   955,   424,   339,   603,   439,   216,   668,   446,
-     549,   447,   450,   203,   339,   229,   831,   480,   841,   578,
-     501,   726,   684,   339,   258,   383,   506,   832,   729,   207,
-     509,   688,   696,   120,   264,   751,   485,   340,   745,   301,
-     884,   884,   831,   884,   771,   772,   786,   340,   787,   788,
-     789,   534,   579,   951,   505,   534,   340,   543,   790,   801,
-     762,   763,   764,   765,   766,   849,   883,   901,   970,   903,
-     905,   966,   553,   554,   210,   490,   219,   558,   251,   752,
-     796,   841,   798,   800,   304,   590,   570,   571,   572,   573,
-     659,   550,   590,   409,   410,   555,   231,   548,   409,   410,
-     236,   382,   565,   669,    91,   276,   488,   489,   590,   936,
-     417,   680,   565,   600,   286,   150,   151,   604,   605,   606,
-     607,   608,   609,   610,   611,   612,   613,   614,   615,   237,
-     755,   886,   887,   232,   244,   622,   271,   908,   761,   527,
-     233,   721,   722,   234,   913,   391,   634,   636,   637,   638,
-     639,   640,   641,   642,   643,   644,   645,   646,   647,   648,
-     649,   652,   654,   656,   658,   440,   756,   282,   211,   438,
-     438,   536,   448,   284,   537,   306,   664,   665,   282,   909,
-     910,   911,   912,   715,   716,   701,   701,   701,   701,   701,
-     893,   719,   701,   598,   599,  -164,   707,   342,   347,  -164,
-     307,   714,   309,   315,   717,   856,   857,   858,   338,   587,
-     588,   589,   617,   618,   619,   620,   621,   322,   865,   884,
-     577,   855,   735,   846,   881,   630,   323,   325,   577,   327,
-     338,   338,   338,   338,   338,   357,   802,   691,   358,   359,
-     385,   339,   385,   385,   363,   695,   796,   798,   800,   702,
-     364,   365,   438,   578,   822,   366,   713,   438,   367,   824,
-     368,   578,   590,   339,   339,   339,   339,   339,   369,   370,
-     437,   437,   371,   413,   340,   372,   373,   374,   376,   590,
-     590,   590,   590,   590,   377,   534,   579,   378,   379,   380,
-     389,   534,   534,   414,   579,   390,   340,   340,   340,   340,
-     340,   416,   417,   418,   392,    91,   393,   394,   395,   396,
-     397,   428,   398,   399,   400,   401,   402,   403,   430,   749,
-     404,   405,   406,   407,   408,   431,   479,   483,   753,   484,
-     586,   329,   330,   587,   588,   589,   586,   329,   330,   587,
-     588,   589,   491,   267,   493,   769,   276,   502,   507,   205,
-     770,   508,   391,   437,   511,   528,   286,   924,   437,   526,
-     397,   535,   398,   399,   400,   401,   402,   403,   439,   447,
-     404,   405,   406,   407,   408,   329,   330,   587,   588,   589,
-     795,   545,   797,   799,   547,   556,   382,   803,   586,   329,
-     330,   587,   588,   589,   338,   574,   802,   898,   590,   584,
-     593,   863,   594,   577,   804,   805,   385,   385,   385,   806,
-     842,   807,   627,   628,   629,   810,   632,   873,  -490,  -490,
-    -490,  -490,  -490,  -490,   672,   879,   320,   339,   819,   810,
-     676,   678,   679,   681,   685,   689,   578,   690,   686,   692,
-     703,   828,   816,   482,   704,   720,   725,   730,   731,   734,
-     934,   447,   740,   743,   223,   744,   447,   759,   826,   589,
-     340,   792,   847,   398,   399,   400,   401,   402,   403,   579,
-     793,   404,   405,   406,   407,   408,   794,   814,   502,   808,
-     815,   817,   534,   818,   409,   410,   823,   825,   878,   851,
-     754,   835,   899,   836,   872,   844,   875,   495,   558,   395,
-     396,   397,   876,   398,   399,   400,   401,   402,   403,   845,
-     852,   404,   405,   406,   407,   408,   861,   862,   864,   867,
-     868,   391,   869,   870,   871,   565,   577,  -491,   897,   902,
-     929,   737,   939,   892,   409,   410,   906,   948,   921,   920,
-     933,   953,   513,   937,   938,   940,   795,   797,   799,   932,
-     941,   942,   943,   959,   841,   958,   961,   967,   971,   578,
-     925,   486,   211,   895,    16,   626,   144,  -247,   952,  -247,
-    -247,  -247,  -247,  -247,   950,  -247,  -247,  -247,  -247,  -247,
-    -247,   670,   724,  -247,  -247,  -247,  -247,  -247,   827,   829,
-     705,   718,   579,   253,   254,   514,   492,   697,   727,   544,
-     662,   860,   713,   914,   916,   256,   919,  -511,  -511,  -511,
-    -511,  -511,  -511,   915,   820,   404,   405,   406,   407,   408,
-     947,   534,   515,   877,   516,   517,   518,   968,   930,   519,
-     520,   352,   521,   522,   972,   409,   410,   741,   178,   179,
-     345,   592,   874,   624,   880,   742,   767,     0,   944,   768,
-     946,   810,     0,   351,   181,   182,     0,     0,   183,   184,
-     185,   186,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,   390,   187,     0,     0,   409,   410,   949,     0,     0,
-       0,     0,     0,     0,     0,   960,     0,     0,     0,     0,
-       0,     0,     0,   962,     0,     0,     0,     0,     0,   963,
-       0,     0,   965,     2,     3,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   975,     0,
-       0,     0,     0,   976,   977,     0,     0,   978,   979,     0,
-     -23,     0,   -23,     0,   981,   -23,   -23,   -23,   -23,     4,
-       5,   -23,     0,     0,   -23,   -23,   -23,  -247,  -247,     0,
-       0,   -23,   -23,     0,     0,     0,     6,     7,     0,     0,
-       0,     0,     0,     0,     0,     0,   -23,     0,     0,     0,
-     -23,   -23,     0,     0,     0,   -23,     0,     0,     0,   409,
-     410,   -23,     0,   -23,   -23,     0,   -23,     0,   -23,   -23,
-     -23,   -23,   -23,     0,   -23,   -23,   -23,   -23,   -23,   -23,
-     -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,
-       0,     0,   -23,   -23,   -23,     0,   -23,   -23,   -23,     0,
-     -23,   -23,   -23,     0,     0,   -23,     0,   -23,     0,     0,
-     -23,   -23,   -23,   -23,     0,     0,   -23,   -23,   -23,     0,
-       0,     0,     0,     0,   -23,     0,     0,     8,   -23,   -23,
-     -23,   -23,   -23,   -23,   -23,     0,   -23,   -23,   -23,   -23,
-     -23,     0,     0,   -23,     0,     0,     0,     0,     0,     0,
-     -23,   -23,   -23,     0,     0,     0,     0,     0,     0,   -23,
-       9,  -510,     0,  -510,     0,  -510,  -510,  -510,  -510,  -510,
-      10,  -510,  -510,  -510,  -510,  -510,  -510,     0,     0,  -510,
-    -510,  -510,  -510,  -510,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   152,   153,     0,
-       0,     0,   154,   155,   156,   157,     0,     0,     0,     0,
-       0,     0,     0,     0,   158,   159,   160,   161,   162,   163,
-     164,     0,   165,   166,   167,     0,     0,   168,   169,   170,
-       0,   171,   172,   173,   174,   175,   674,   176,   392,     0,
-     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
-     402,   403,     0,     0,   404,   405,   406,   407,   408,   931,
-       0,   392,     0,   393,   394,   395,   396,   397,     0,   398,
-     399,   400,   401,   402,   403,     0,     0,   404,   405,   406,
-     407,   408,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     178,   179,     0,     0,     0,     0,   180,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   181,   182,     0,     0,
-     183,   184,   185,   186,     0,     0,     0,    91,     0,     0,
-       0,     0,     0,     0,   187,     0,     0,   576,     0,     0,
-       0,     0,     0,  -510,  -510,   973,     0,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,     0,     0,   404,   405,   406,   407,   408,   974,     0,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,   980,     0,   392,     0,   393,   394,   395,   396,   397,
-       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
-     405,   406,   407,   408,     0,     0,     0,     0,   409,   410,
-       0,     0,     0,     0,     0,     0,   896,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,   409,   410,   404,   405,   406,   407,   408,   850,   392,
-       0,   393,   394,   395,   396,   397,     0,   398,   399,   400,
-     401,   402,   403,     0,     0,   404,   405,   406,   407,   408,
-     896,   392,     0,   393,   394,   395,   396,   397,     0,   398,
-     399,   400,   401,   402,   403,     0,     0,   404,   405,   406,
-     407,   408,   945,   392,     0,   393,   394,   395,   396,   397,
-       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
-     405,   406,   407,   408,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   409,   410,     0,
-       0,     0,     0,     0,     0,   964,   392,     0,   393,   394,
-     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
-     409,   410,   404,   405,   406,   407,   408,     0,     0,   392,
-       0,   393,   394,   395,   396,   397,     0,   398,   399,   400,
-     401,   402,   403,   409,   410,   404,   405,   406,   407,   408,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,   631,     0,     0,     0,     0,   409,   410,     0,
-       0,     0,     0,     0,     0,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,   409,
-     410,   404,   405,   406,   407,   408,     0,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,   409,   410,   404,   405,   406,   407,   408,     0,  -250,
-       0,  -250,  -250,  -250,  -250,  -250,     0,  -250,  -250,  -250,
-    -250,  -250,  -250,   409,   410,  -250,  -250,  -250,  -250,  -250,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,   409,   410,   404,   405,
-     406,   407,   408,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   436,     0,     0,     0,     0,   409,
-     410,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,   595,     0,     0,     0,     0,
-     409,   410,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
-     406,   407,   408,     0,     0,     0,     0,     0,     0,     0,
-     602,     0,     0,     0,     0,   409,   410,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   616,     0,     0,     0,     0,   409,   410,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,  -250,     0,     0,     0,     0,  -250,
-    -250,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,   631,     0,     0,     0,     0,
-     409,   410,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   666,     0,     0,
-       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
-     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
-     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
-       0,   404,   405,   406,   407,   408,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   671,     0,     0,
-       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
-     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
-     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
-       0,   404,   405,   406,   407,   408,   392,     0,   393,   394,
-     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
-       0,     0,   404,   405,   406,   407,   408,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,     0,     0,   404,   405,   406,   407,   408,   392,     0,
-     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
-     402,   403,     0,     0,   404,   405,   406,   407,   408,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   673,
-       0,     0,     0,     0,   409,   410,     0,     0,     0,   418,
-       0,   392,     0,   393,   394,   395,   396,   397,     0,   398,
-     399,   400,   401,   402,   403,   409,   410,   404,   405,   406,
-     407,   408,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
-     406,   407,   408,     0,     0,     0,     0,     0,     0,   773,
-       0,     0,     0,     0,   409,   410,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     774,     0,     0,     0,     0,   409,   410,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,   775,     0,     0,     0,     0,   409,   410,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   776,     0,     0,     0,     0,   409,   410,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,   777,     0,     0,     0,     0,   409,   410,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   778,     0,     0,     0,
-       0,   409,   410,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   779,     0,     0,
-       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
-     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
-     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
-     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
-       0,   404,   405,   406,   407,   408,   392,     0,   393,   394,
-     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
-       0,     0,   404,   405,   406,   407,   408,   392,     0,   393,
-     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
-     403,     0,     0,   404,   405,   406,   407,   408,   392,     0,
-     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
-     402,   403,     0,     0,   404,   405,   406,   407,   408,     0,
-       0,     0,     0,     0,     0,   780,     0,     0,     0,     0,
-     409,   410,   392,     0,   393,   394,   395,   396,   397,     0,
-     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
-     406,   407,   408,   392,     0,   393,   394,   395,   396,   397,
-       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
-     405,   406,   407,   408,     0,     0,     0,     0,     0,    22,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   781,
-       0,     0,     0,     0,   409,   410,     0,     0,     0,     0,
-       0,     0,     0,     0,    28,     0,     0,     0,     0,     0,
-     782,     0,     0,     0,     0,   409,   410,     0,     0,    32,
-       0,     0,     0,     0,    35,   348,     0,     0,     0,    39,
-      40,   783,     0,     0,     0,     0,   409,   410,     0,   349,
-      49,    50,    51,    52,    53,    54,   350,     0,     0,     0,
-       0,     0,   784,     0,     0,     0,     0,   409,   410,    64,
-       0,     0,     0,     0,     0,    67,     0,     0,     0,     0,
-       0,     0,     0,   785,    72,     0,    74,     0,   409,   410,
-     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
-     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
-     408,     0,     0,     0,     0,     0,     0,   791,     0,     0,
-      91,     0,   409,   410,     0,     0,     0,    92,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   843,     0,
-       0,     0,     0,   409,   410,   392,     0,   393,   394,   395,
-     396,   397,   708,   398,   399,   400,   401,   402,   403,     0,
-     149,   404,   405,   406,   407,   408,     0,     0,     0,   150,
-     151,   709,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   152,   153,     0,
-       0,     0,   154,   155,   156,   157,     0,     0,     0,     0,
-       0,     0,     0,     0,   158,   159,   160,   161,   162,   163,
-     164,     0,   165,   166,   167,     0,     0,   168,   169,   170,
-       0,   171,   172,   173,   174,   175,     0,   176,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   453,     0,
-       0,     0,   454,   455,   456,   457,     0,     0,     0,     0,
-       0,     0,     0,     0,   458,   459,   460,   461,   462,   463,
-     464,     0,   465,   466,   467,   900,     0,   468,   469,   470,
-     409,   410,   471,   472,   473,   474,     0,   475,     0,   177,
-       0,     0,     0,     0,     0,     0,     0,     0,   149,     0,
-     178,   179,     0,     0,     0,     0,   180,   150,   151,     0,
-       0,     0,     0,     0,     0,     0,   181,   182,     0,     0,
-     183,   184,   185,   186,     0,   152,   153,    91,     0,     0,
-     154,   155,   156,   157,   187,   409,   410,   188,     0,     0,
-       0,     0,   158,   159,   160,   161,   162,   163,   164,     0,
-     165,   166,   167,     0,     0,   168,   169,   170,     0,   171,
-     172,   173,   174,   175,     0,   176,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   476,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   177,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   178,   179,
-       0,     0,     0,     0,   180,   809,     0,     0,     0,     0,
-       0,     0,     0,   149,   181,   182,     0,     0,   183,   184,
-     185,   186,   150,   151,     0,    91,     0,     0,     0,     0,
-       0,     0,   187,     0,     0,   188,     0,     0,     0,     0,
-     152,   153,     0,   204,     0,   154,   155,   156,   157,     0,
-       0,     0,     0,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,   894,     0,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,   531,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-     532,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-     650,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,     0,   651,
-       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,   728,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,   532,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   188,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,   633,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,    91,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,     0,   655,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,   657,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-       0,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,   746,     0,
-     747,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,   532,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   748,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,   557,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,   538,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,     0,     0,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,   532,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,     0,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-     733,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,   709,     0,
-       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,   954,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   188,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,    91,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   177,     0,     0,     0,     0,     0,     0,     0,
-       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
-     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
-      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
-     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
-     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
-     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     177,     0,     0,     0,     0,     0,     0,     0,     0,   149,
-       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
-       0,     0,     0,     0,     0,     0,     0,   181,   182,     0,
-       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
-       0,   154,   155,   156,   157,   187,     0,     0,   381,     0,
-       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
-       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
-     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
-       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
-     179,     0,     0,     0,     0,   180,   150,   151,     0,     0,
-       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
-     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
-     155,   156,   157,   444,     0,     0,   188,     0,     0,     0,
-       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
-       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
-       0,     0,     0,   180,   150,   151,     0,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
-     157,   187,     0,     0,   541,     0,     0,     0,     0,   158,
-     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
-       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
-     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
-       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
-       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
-       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
-     152,   153,   888,     0,     0,   154,   155,   156,   157,   187,
-       0,     0,   381,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,   329,   330,   562,     0,   563,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   152,
-     153,     0,     0,     0,   154,   155,   156,   157,     0,     0,
-     332,   333,   334,     0,     0,   335,   158,   159,   160,   161,
-     162,   163,   164,     0,   165,   166,   167,     0,     0,   168,
-     169,   170,   177,   171,   172,   173,   174,   175,     0,   176,
-       0,     0,     0,   178,   179,     0,     0,     0,     0,   180,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,     0,     0,
-      91,     0,     0,     0,     0,     0,     0,   187,     0,     0,
-     917,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   178,   179,     0,     0,     0,     0,   180,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   181,   182,
-       0,     0,   183,   184,   185,   186,   329,   330,   331,   336,
-       0,     0,     0,     0,     0,     0,   187,     0,     0,   564,
-       0,     0,     0,     0,   152,   153,     0,     0,     0,   154,
-     155,   156,   157,     0,     0,   332,   333,   334,     0,     0,
-     335,   158,   159,   160,   161,   162,   163,   164,     0,   165,
-     166,   167,   329,   330,   168,   169,   170,     0,   171,   172,
-     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
-     152,   153,     0,     0,     0,   154,   155,   156,   157,     0,
-       0,   332,   333,   334,     0,     0,   335,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   178,   179,     0,
-       0,     0,     0,   180,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
-     186,     0,     0,     0,   336,     0,     0,     0,     0,     0,
-       0,   187,     0,    19,   337,     0,    20,   -28,    21,   -28,
-       0,     0,    22,   178,   179,    23,    24,    25,     0,   180,
-       0,     0,    26,    27,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,    28,     0,     0,
-     336,    29,    30,     0,     0,     0,    31,   187,     0,     0,
-     564,     0,    32,     0,    33,    34,     0,    35,     0,    36,
-      37,    38,    39,    40,     0,    41,    42,    43,    44,    45,
-      46,    47,    48,    49,    50,    51,    52,    53,    54,    55,
-      56,     0,     0,    57,    58,    59,     0,    60,    61,    62,
-       0,    63,    64,    65,     0,     0,    66,     0,    67,     0,
-       0,    68,    69,    70,    71,     0,     0,    72,    73,    74,
-       0,     0,     0,     0,     0,    75,     0,     0,     0,    76,
-      77,    78,    79,    80,    81,    82,     0,    83,    84,    85,
-      86,    87,     0,     0,    88,     0,     0,     0,     0,   152,
-     153,    89,    90,    91,   154,   155,   156,   157,     0,     0,
-      92,     0,     0,     0,     0,     0,   158,   159,   160,   161,
-     162,   163,   164,     0,   165,   166,   167,     0,     0,   168,
-     169,   170,     0,   171,   172,   173,   174,   175,     0,   176,
-     152,   153,     0,     0,     0,   154,   155,   156,   157,     0,
-       0,     0,     0,     0,     0,     0,     0,   158,   159,   160,
-     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
-     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
-     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   178,   179,     0,     0,     0,     0,   180,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,   181,   182,
-       0,     0,   183,   184,   185,   186,     0,     0,     0,    91,
-       0,     0,     0,     0,     0,     0,   187,     0,     0,   576,
-       0,     0,     0,   178,   179,     0,     0,     0,     0,   180,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   181,
-     182,     0,     0,   183,   184,   185,   186,     0,     0,     0,
-     888,     0,     0,     0,     0,     0,     0,   187,     0,     0,
-     576
-};
-
-static const yytype_int16 yycheck[] =
-{
-      26,   177,    28,   200,   140,    35,    32,   297,    13,    35,
-     274,   177,   188,   289,   278,    41,   414,   716,    46,   499,
-     105,   327,   107,   231,    18,   579,   111,   231,   582,     5,
-       3,   337,   236,   449,   236,    34,     3,   140,     4,     3,
-     346,   177,    70,    71,     4,    24,     3,     4,     3,    23,
-      78,     3,    23,     3,    31,   381,    61,   123,   234,   489,
-      59,    60,   494,   729,    33,     3,    35,   499,   103,     5,
-     140,    21,    22,    23,     3,     3,   125,   112,     3,   177,
-     577,   344,   579,   793,   794,   582,   759,     3,     3,     3,
-      23,     3,     3,     3,     3,     4,   124,   527,   126,   127,
-       3,     3,     3,    23,   130,   169,   169,   137,     3,     3,
-       3,   137,     3,     3,     3,   179,    23,    20,   169,   169,
-     169,    24,   148,   149,   187,   158,    35,    97,   231,    99,
-     169,   157,   179,   236,    21,    22,    23,   187,   143,    20,
-      21,    22,    23,    24,    25,   171,   179,     3,    23,   217,
-     126,   177,     3,    25,   169,   179,    23,    24,    25,    20,
-     123,   176,   188,    24,   863,   189,   192,     5,    24,    20,
-     238,   347,   882,    24,   137,    20,    20,   203,   179,    24,
-      24,   347,   286,   176,   210,    20,   179,   272,   189,    24,
-     126,   327,   169,   219,   260,   169,    80,    81,   224,   865,
-     179,   337,   207,     4,   308,   381,   342,   180,   234,   882,
-     346,   347,   156,   189,   158,   381,   180,   188,   244,   127,
-     187,   187,   921,   180,   327,   180,   231,   187,   180,   234,
-     315,   236,   237,   179,   337,   169,   169,   242,   188,   342,
-     275,   531,   180,   346,    27,   381,   281,   180,   538,   179,
-     285,   180,   180,   258,   158,   180,   255,   327,   564,   179,
-     757,   758,   169,   760,   180,   180,   180,   337,   180,   180,
-     180,   297,   342,   180,   279,   301,   346,   303,   180,   180,
-     586,   587,   588,   589,   590,   180,   180,   180,   126,   180,
-     180,   180,   318,   319,   179,   265,   179,   323,   169,   180,
-     626,   188,   628,   629,   179,   568,   332,   333,   334,   335,
-     413,   316,   575,   185,   186,   320,   179,   311,   185,   186,
-     179,   347,   327,   427,   169,   169,   261,   262,   591,   883,
-     179,   180,   337,   359,   169,    21,    22,   363,   364,   365,
-     366,   367,   368,   369,   370,   371,   372,   373,   374,   179,
-     576,   767,   768,   169,   179,   381,   169,   837,   584,   294,
-     176,     3,     4,   179,   844,   541,   392,   393,   394,   395,
-     396,   397,   398,   399,   400,   401,   402,   403,   404,   405,
-     406,   407,   408,   409,   410,   593,   883,     3,   414,   593,
-     594,   176,   594,     3,   179,    23,   422,   423,     3,   838,
-     839,   840,   841,   507,   508,   837,   838,   839,   840,   841,
-     808,   515,   844,   357,   358,    20,   501,   140,   141,    24,
-       4,   506,   169,   176,   509,   138,   139,   140,   564,    23,
-      24,    25,   376,   377,   378,   379,   380,     3,   728,   936,
-     576,   717,   546,   707,   750,   389,   179,   169,   584,   179,
-     586,   587,   588,   589,   590,   179,   632,   485,   179,   179,
-     626,   564,   628,   629,   179,   491,   792,   793,   794,   495,
-     179,   179,   676,   576,   676,   179,   502,   681,   179,   681,
-     179,   584,   745,   586,   587,   588,   589,   590,   179,   179,
-     593,   594,   179,   189,   564,   179,   179,   179,   179,   762,
-     763,   764,   765,   766,   179,   531,   576,   179,   179,   179,
-     179,   537,   538,   179,   584,   541,   586,   587,   588,   589,
-     590,   179,   179,   169,     5,   169,     7,     8,     9,    10,
-      11,     3,    13,    14,    15,    16,    17,    18,     4,   565,
-      21,    22,    23,    24,    25,   169,   169,     3,   574,     3,
-      20,    21,    22,    23,    24,    25,    20,    21,    22,    23,
-      24,    25,     5,   169,     3,   595,   169,   179,   169,   595,
-     596,   169,   748,   676,     3,     3,   169,   867,   681,     4,
-      11,   180,    13,    14,    15,    16,    17,    18,   593,   594,
-      21,    22,    23,    24,    25,    21,    22,    23,    24,    25,
-     626,   176,   628,   629,     3,   176,   632,   633,    20,    21,
-      22,    23,    24,    25,   750,     5,   792,   814,   881,     3,
-     179,   725,   179,   759,   650,   651,   792,   793,   794,   655,
-     700,   657,   132,     3,     3,   661,     3,   741,    20,    21,
-      22,    23,    24,    25,     3,   749,   189,   750,   674,   675,
-       3,   180,   180,     3,     3,   179,   759,   169,    24,   179,
-     169,   687,   667,   689,   169,   179,   169,   180,     3,   180,
-     878,   676,     5,   180,   176,     3,   681,     3,   683,    25,
-     750,     3,   708,    13,    14,    15,    16,    17,    18,   759,
-       3,    21,    22,    23,    24,    25,     3,   180,   179,     4,
-     180,   169,   728,    84,   185,   186,   180,   180,   189,   714,
-     180,    30,   816,    24,   740,    24,   180,   179,   744,     9,
-      10,    11,   748,    13,    14,    15,    16,    17,    18,    24,
-      23,    21,    22,    23,    24,    25,     4,   169,   180,   169,
-     180,   917,     4,   126,     3,   750,   882,    20,     3,     5,
-     169,   169,     5,   180,   185,   186,   179,     3,   862,   180,
-     180,    24,    29,   180,   180,   180,   792,   793,   794,   873,
-     180,   180,   180,     3,   188,   126,   180,   180,   169,   882,
-     169,   258,   808,   809,    10,     3,    14,     5,   906,     7,
-       8,     9,    10,    11,   904,    13,    14,    15,    16,    17,
-      18,   428,   528,    21,    22,    23,    24,    25,   685,   689,
-     498,   511,   882,    80,    81,    82,   268,   493,   537,   304,
-     416,   721,   848,   848,   850,    76,   852,    13,    14,    15,
-      16,    17,    18,   850,   675,    21,    22,    23,    24,    25,
-     897,   867,   109,   748,   111,   112,   113,   955,   871,   116,
-     117,   143,   119,   120,   959,   185,   186,   555,   142,   143,
-     140,   347,   744,   381,   750,   557,   593,    -1,   894,   594,
-     896,   897,    -1,   878,   158,   159,    -1,    -1,   162,   163,
-     164,   165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   917,   176,    -1,    -1,   185,   186,   902,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   931,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   939,    -1,    -1,    -1,    -1,    -1,   945,
-      -1,    -1,   948,     0,     1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   964,    -1,
-      -1,    -1,    -1,   969,   970,    -1,    -1,   973,   974,    -1,
-      27,    -1,    29,    -1,   980,    32,    33,    34,    35,    36,
-      37,    38,    -1,    -1,    41,    42,    43,   185,   186,    -1,
-      -1,    48,    49,    -1,    -1,    -1,    53,    54,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    63,    -1,    -1,    -1,
-      67,    68,    -1,    -1,    -1,    72,    -1,    -1,    -1,   185,
-     186,    78,    -1,    80,    81,    -1,    83,    -1,    85,    86,
-      87,    88,    89,    -1,    91,    92,    93,    94,    95,    96,
-      97,    98,    99,   100,   101,   102,   103,   104,   105,   106,
-      -1,    -1,   109,   110,   111,    -1,   113,   114,   115,    -1,
-     117,   118,   119,    -1,    -1,   122,    -1,   124,    -1,    -1,
-     127,   128,   129,   130,    -1,    -1,   133,   134,   135,    -1,
-      -1,    -1,    -1,    -1,   141,    -1,    -1,   144,   145,   146,
-     147,   148,   149,   150,   151,    -1,   153,   154,   155,   156,
-     157,    -1,    -1,   160,    -1,    -1,    -1,    -1,    -1,    -1,
-     167,   168,   169,    -1,    -1,    -1,    -1,    -1,    -1,   176,
-     177,     3,    -1,     5,    -1,     7,     8,     9,    10,    11,
-     187,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,    40,    -1,
-      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
-      62,    -1,    64,    65,    66,    -1,    -1,    69,    70,    71,
-      -1,    73,    74,    75,    76,    77,     3,    79,     5,    -1,
-       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
-      17,    18,    -1,    -1,    21,    22,    23,    24,    25,     3,
-      -1,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
-      14,    15,    16,    17,    18,    -1,    -1,    21,    22,    23,
-      24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     142,   143,    -1,    -1,    -1,    -1,   148,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,
-     162,   163,   164,   165,    -1,    -1,    -1,   169,    -1,    -1,
-      -1,    -1,    -1,    -1,   176,    -1,    -1,   179,    -1,    -1,
-      -1,    -1,    -1,   185,   186,     3,    -1,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,    -1,    -1,    21,    22,    23,    24,    25,     3,    -1,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,     3,    -1,     5,    -1,     7,     8,     9,    10,    11,
-      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,   185,   186,
-      -1,    -1,    -1,    -1,    -1,    -1,     4,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,   185,   186,    21,    22,    23,    24,    25,     4,     5,
-      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
-      16,    17,    18,    -1,    -1,    21,    22,    23,    24,    25,
-       4,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
-      14,    15,    16,    17,    18,    -1,    -1,    21,    22,    23,
-      24,    25,     4,     5,    -1,     7,     8,     9,    10,    11,
-      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   185,   186,    -1,
-      -1,    -1,    -1,    -1,    -1,     4,     5,    -1,     7,     8,
-       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
-     185,   186,    21,    22,    23,    24,    25,    -1,    -1,     5,
-      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
-      16,    17,    18,   185,   186,    21,    22,    23,    24,    25,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
-      -1,    -1,    -1,    -1,    -1,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,   185,
-     186,    21,    22,    23,    24,    25,    -1,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,   185,   186,    21,    22,    23,    24,    25,    -1,     5,
-      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
-      16,    17,    18,   185,   186,    21,    22,    23,    24,    25,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,   185,   186,    21,    22,
-      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,
-     186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
-     185,   186,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
-      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,
-     186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
-     185,   186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
-      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
-      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
-      -1,    21,    22,    23,    24,    25,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
-      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
-      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
-      -1,    21,    22,    23,    24,    25,     5,    -1,     7,     8,
-       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
-      -1,    -1,    21,    22,    23,    24,    25,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,    -1,    -1,    21,    22,    23,    24,    25,     5,    -1,
-       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
-      17,    18,    -1,    -1,    21,    22,    23,    24,    25,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,
-      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,   169,
-      -1,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
-      14,    15,    16,    17,    18,   185,   186,    21,    22,    23,
-      24,    25,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
-      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,   180,
-      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,
-      -1,   185,   186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
-      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
-      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
-      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
-      -1,    21,    22,    23,    24,    25,     5,    -1,     7,     8,
-       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
-      -1,    -1,    21,    22,    23,    24,    25,     5,    -1,     7,
-       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      18,    -1,    -1,    21,    22,    23,    24,    25,     5,    -1,
-       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
-      17,    18,    -1,    -1,    21,    22,    23,    24,    25,    -1,
-      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
-     185,   186,     5,    -1,     7,     8,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
-      23,    24,    25,     5,    -1,     7,     8,     9,    10,    11,
-      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
-      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    38,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,
-      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    63,    -1,    -1,    -1,    -1,    -1,
-     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    78,
-      -1,    -1,    -1,    -1,    83,    84,    -1,    -1,    -1,    88,
-      89,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,    98,
-      99,   100,   101,   102,   103,   104,   105,    -1,    -1,    -1,
-      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,   118,
-      -1,    -1,    -1,    -1,    -1,   124,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   180,   133,    -1,   135,    -1,   185,   186,
-       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
-      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
-      25,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
-     169,    -1,   185,   186,    -1,    -1,    -1,   176,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,
-      -1,    -1,    -1,   185,   186,     5,    -1,     7,     8,     9,
-      10,    11,     4,    13,    14,    15,    16,    17,    18,    -1,
-      12,    21,    22,    23,    24,    25,    -1,    -1,    -1,    21,
-      22,    23,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,    40,    -1,
-      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
-      62,    -1,    64,    65,    66,    -1,    -1,    69,    70,    71,
-      -1,    73,    74,    75,    76,    77,    -1,    79,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    40,    -1,
-      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
-      62,    -1,    64,    65,    66,   180,    -1,    69,    70,    71,
-     185,   186,    74,    75,    76,    77,    -1,    79,    -1,   131,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,
-     142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,
-     162,   163,   164,   165,    -1,    39,    40,   169,    -1,    -1,
-      44,    45,    46,    47,   176,   185,   186,   179,    -1,    -1,
-      -1,    -1,    56,    57,    58,    59,    60,    61,    62,    -1,
-      64,    65,    66,    -1,    -1,    69,    70,    71,    -1,    73,
-      74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   169,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   142,   143,
-      -1,    -1,    -1,    -1,   148,     4,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,   158,   159,    -1,    -1,   162,   163,
-     164,   165,    21,    22,    -1,   169,    -1,    -1,    -1,    -1,
-      -1,    -1,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,
-      39,    40,    -1,   187,    -1,    44,    45,    46,    47,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,     4,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,     5,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      23,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-       5,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,    24,
-      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,     5,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,     5,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,    -1,     5,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,     5,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    23,    -1,
-      25,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    23,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    23,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      23,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    23,    -1,
-      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
-     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
-      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
-      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-     131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,
-      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
-      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
-      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
-      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
-      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
-      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
-     143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
-     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
-      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
-      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    21,    22,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
-      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
-      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
-      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
-      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
-      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
-      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
-      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    21,    22,    23,    -1,    25,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,
-      40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,    -1,
-      50,    51,    52,    -1,    -1,    55,    56,    57,    58,    59,
-      60,    61,    62,    -1,    64,    65,    66,    -1,    -1,    69,
-      70,    71,   131,    73,    74,    75,    76,    77,    -1,    79,
-      -1,    -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,
-     169,    -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,
-     179,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,
-      -1,    -1,   162,   163,   164,   165,    21,    22,    23,   169,
-      -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,   179,
-      -1,    -1,    -1,    -1,    39,    40,    -1,    -1,    -1,    44,
-      45,    46,    47,    -1,    -1,    50,    51,    52,    -1,    -1,
-      55,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
-      65,    66,    21,    22,    69,    70,    71,    -1,    73,    74,
-      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
-      39,    40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,
-      -1,    50,    51,    52,    -1,    -1,    55,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,   142,   143,    -1,
-      -1,    -1,    -1,   148,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
-     165,    -1,    -1,    -1,   169,    -1,    -1,    -1,    -1,    -1,
-      -1,   176,    -1,    29,   179,    -1,    32,    33,    34,    35,
-      -1,    -1,    38,   142,   143,    41,    42,    43,    -1,   148,
-      -1,    -1,    48,    49,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    63,    -1,    -1,
-     169,    67,    68,    -1,    -1,    -1,    72,   176,    -1,    -1,
-     179,    -1,    78,    -1,    80,    81,    -1,    83,    -1,    85,
-      86,    87,    88,    89,    -1,    91,    92,    93,    94,    95,
-      96,    97,    98,    99,   100,   101,   102,   103,   104,   105,
-     106,    -1,    -1,   109,   110,   111,    -1,   113,   114,   115,
-      -1,   117,   118,   119,    -1,    -1,   122,    -1,   124,    -1,
-      -1,   127,   128,   129,   130,    -1,    -1,   133,   134,   135,
-      -1,    -1,    -1,    -1,    -1,   141,    -1,    -1,    -1,   145,
-     146,   147,   148,   149,   150,   151,    -1,   153,   154,   155,
-     156,   157,    -1,    -1,   160,    -1,    -1,    -1,    -1,    39,
-      40,   167,   168,   169,    44,    45,    46,    47,    -1,    -1,
-     176,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,    59,
-      60,    61,    62,    -1,    64,    65,    66,    -1,    -1,    69,
-      70,    71,    -1,    73,    74,    75,    76,    77,    -1,    79,
-      39,    40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,
-      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
-      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
-      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,
-      -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,   169,
-      -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,   179,
-      -1,    -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
-     159,    -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,
-     169,    -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,
-     179
-};
-
-/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
-   symbol of state STATE-NUM.  */
-static const yytype_uint16 yystos[] =
-{
-       0,   191,     0,     1,    36,    37,    53,    54,   144,   177,
-     187,   192,   197,   199,   205,   201,   198,   177,   200,    29,
-      32,    34,    38,    41,    42,    43,    48,    49,    63,    67,
-      68,    72,    78,    80,    81,    83,    85,    86,    87,    88,
-      89,    91,    92,    93,    94,    95,    96,    97,    98,    99,
-     100,   101,   102,   103,   104,   105,   106,   109,   110,   111,
-     113,   114,   115,   117,   118,   119,   122,   124,   127,   128,
-     129,   130,   133,   134,   135,   141,   145,   146,   147,   148,
-     149,   150,   151,   153,   154,   155,   156,   157,   160,   167,
-     168,   169,   176,   193,   194,   195,   202,   203,   206,   212,
-     224,   225,   228,   229,   234,   235,   237,   238,   239,   240,
-     241,   243,   244,   251,   253,   257,   258,   261,   262,   263,
-     298,   308,   309,   315,   316,   317,   318,   319,   321,   326,
-     327,   328,   330,   331,   333,   336,   337,   340,   341,   349,
-     351,   352,   365,   372,   201,   205,   169,   204,   179,    12,
-      21,    22,    39,    40,    44,    45,    46,    47,    56,    57,
-      58,    59,    60,    61,    62,    64,    65,    66,    69,    70,
-      71,    73,    74,    75,    76,    77,    79,   131,   142,   143,
-     148,   158,   159,   162,   163,   164,   165,   176,   179,   280,
-     281,   283,   284,   288,   290,   291,   292,   293,   298,   299,
-     300,   307,   320,   179,   187,   280,   304,   179,   217,   218,
-     179,   280,   303,     4,   187,   221,   187,   221,   304,   179,
-     169,   187,   324,   176,   179,   364,   280,   169,   325,   169,
-     324,   179,   169,   176,   179,   346,   179,   179,   221,   221,
-      20,    24,   247,   298,   179,   216,   123,   137,   127,   324,
-     324,   169,   252,    80,    81,   213,   275,   324,    27,   196,
-     198,    33,    35,   196,   158,   207,   196,   169,   179,   249,
-     250,   169,   226,   231,     3,   248,   169,   230,   247,     3,
-     236,   248,     3,   248,     3,   248,   169,   245,   246,   247,
-       3,     4,    35,   222,   223,   255,   271,   169,   176,   268,
-      23,   179,   259,    23,   179,   266,    23,     4,   329,   169,
-     310,   200,   324,   324,   324,   176,   323,   280,     5,   126,
-     189,   332,     3,   179,   334,   169,   304,   179,   345,    21,
-      22,    23,    50,    51,    52,    55,   169,   179,   281,   288,
-     299,   343,   345,   350,   353,   354,   355,   345,    84,    98,
-     105,   298,   328,   280,   280,   280,   282,   179,   179,   179,
-     282,   280,   282,   179,   179,   179,   179,   179,   179,   179,
-     179,   179,   179,   179,   179,   280,   179,   179,   179,   179,
-     179,   179,   280,   281,   283,   307,   360,   361,   362,   179,
-     280,   283,     5,     7,     8,     9,    10,    11,    13,    14,
-      15,    16,    17,    18,    21,    22,    23,    24,    25,   185,
-     186,   285,   280,   189,   179,   302,   179,   179,   169,   158,
-     301,   302,     3,     4,   180,   280,   219,   298,     3,   280,
-       4,   169,   242,   242,   280,   280,   180,   288,   292,   298,
-     330,   366,   367,   368,   176,   283,   298,   298,   367,   369,
-     298,   371,   242,    40,    44,    45,    46,    47,    56,    57,
-      58,    59,    60,    61,    62,    64,    65,    66,    69,    70,
-      71,    74,    75,    76,    77,    79,   169,   214,   215,   169,
-     298,   220,   280,     3,     3,   221,   194,   200,   204,   204,
-     196,     5,   249,     3,    24,   179,   187,   248,     3,    24,
-     230,   247,   179,   276,   230,   298,   247,   169,   169,   247,
-     276,     3,   245,    29,    82,   109,   111,   112,   113,   116,
-     117,   119,   120,   272,   273,   275,     4,   204,     3,   256,
-     254,     5,    23,   269,   280,   180,   176,   179,   169,   260,
-     269,   179,   267,   280,   268,   176,   276,     3,   205,   248,
-     298,   322,   373,   280,   280,   298,   176,    23,   280,   335,
-     338,   339,    23,    25,   179,   298,   347,   348,   353,   354,
-     280,   280,   280,   280,     5,   353,   179,   281,   288,   299,
-     342,   356,   357,   358,     3,   344,    20,    23,    24,    25,
-     355,   353,   360,   179,   179,   180,     3,   180,   282,   282,
-     280,   180,   180,   180,   280,   280,   280,   280,   280,   280,
-     280,   280,   280,   280,   280,   280,   180,   282,   282,   282,
-     282,   282,   280,   283,   361,   362,     3,   132,     3,     3,
-     282,   180,     3,     5,   280,   287,   280,   280,   280,   280,
-     280,   280,   280,   280,   280,   280,   280,   280,   280,   280,
-       5,    24,   280,   286,   280,     5,   280,     5,   280,   288,
-     303,   289,   294,   294,   280,   280,   180,     3,   180,   276,
-     218,   180,     3,   180,     3,   179,     3,   370,   180,   180,
-     180,     3,   370,     3,   180,     3,    24,     3,   180,   179,
-     169,   324,   179,   208,   208,   280,   180,   250,   227,   232,
-     233,   284,   280,   169,   169,   231,   227,   248,     4,    23,
-     277,   278,   279,   280,   248,   276,   276,   248,   246,   276,
-     179,     3,     4,   208,   254,   169,   269,   260,     5,   269,
-     180,     3,   270,    23,   180,   276,    31,   169,   311,   312,
-       5,   329,   364,   180,     3,   353,    23,    25,   179,   280,
-       3,   180,   180,   280,   180,   356,   285,   359,   359,     3,
-     359,   356,   353,   353,   353,   353,   353,   366,   369,   304,
-     280,   180,   180,   180,   180,   180,   180,   180,   180,   180,
-     180,   180,   180,   180,   180,   180,   180,   180,   180,   180,
-     180,   180,     3,     3,     3,   280,   362,   280,   362,   280,
-     362,   180,   283,   280,   280,   280,   280,   280,     4,     4,
-     280,   295,   296,   297,   180,   180,   298,   169,    84,   280,
-     295,   125,   367,   180,   367,   180,   298,   214,   280,   220,
-      23,   169,   180,   210,   211,    30,    24,     3,    21,    22,
-      23,   188,   299,   180,    24,    24,   230,   280,     3,   180,
-       4,   298,    23,   264,   264,   245,   138,   139,   140,   274,
-     273,     4,   169,   276,   180,   269,   270,   169,   180,     4,
-     126,     3,   280,   276,   339,   180,   280,   297,   189,   276,
-     348,   353,     3,   180,   285,   358,   370,   370,   169,   363,
-     363,   363,   180,   303,     4,   280,     4,     3,   302,   276,
-     180,   180,     5,   180,     3,   180,   179,   209,   227,   232,
-     232,   232,   232,   227,   278,   279,   280,   179,   265,   280,
-     180,   276,   264,   270,   269,   169,   187,   313,   314,   169,
-     312,     3,   276,   180,   330,   363,   359,   180,   180,     5,
-     180,   180,   180,   180,   280,     4,   280,   296,     3,   298,
-     211,   180,   210,    24,    23,   264,   305,   306,   126,     3,
-     280,   180,   280,   280,     4,   280,   180,   180,   305,     5,
-     126,   169,   314,     3,     3,   280,   280,   280,   280,   280,
-       3,   280
-};
-
-#define yyerrok		(yyerrstatus = 0)
-#define yyclearin	(yychar = YYEMPTY)
-#define YYEMPTY		(-2)
-#define YYEOF		0
-
-#define YYACCEPT	goto yyacceptlab
-#define YYABORT		goto yyabortlab
-#define YYERROR		goto yyerrorlab
-
-
-/* Like YYERROR except do call yyerror.  This remains here temporarily
-   to ease the transition to the new meaning of YYERROR, for GCC.
-   Once GCC version 2 has supplanted version 1, this can go.  */
-
-#define YYFAIL		goto yyerrlab
-
-#define YYRECOVERING()  (!!yyerrstatus)
-
-#define YYBACKUP(Token, Value)					\
-do								\
-  if (yychar == YYEMPTY && yylen == 1)				\
-    {								\
-      yychar = (Token);						\
-      yylval = (Value);						\
-      yytoken = YYTRANSLATE (yychar);				\
-      YYPOPSTACK (1);						\
-      goto yybackup;						\
-    }								\
-  else								\
-    {								\
-      yyerror (YY_("syntax error: cannot back up")); \
-      YYERROR;							\
-    }								\
-while (YYID (0))
-
-
-#define YYTERROR	1
-#define YYERRCODE	256
-
-
-/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
-   If N is 0, then set CURRENT to the empty location which ends
-   the previous symbol: RHS[0] (always defined).  */
-
-#define YYRHSLOC(Rhs, K) ((Rhs)[K])
-#ifndef YYLLOC_DEFAULT
-# define YYLLOC_DEFAULT(Current, Rhs, N)				\
-    do									\
-      if (YYID (N))                                                    \
-	{								\
-	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
-	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
-	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
-	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
-	}								\
-      else								\
-	{								\
-	  (Current).first_line   = (Current).last_line   =		\
-	    YYRHSLOC (Rhs, 0).last_line;				\
-	  (Current).first_column = (Current).last_column =		\
-	    YYRHSLOC (Rhs, 0).last_column;				\
-	}								\
-    while (YYID (0))
-#endif
-
-
-/* YY_LOCATION_PRINT -- Print the location on the stream.
-   This macro was not mandated originally: define only if we know
-   we won't break user code: when these are the locations we know.  */
-
-#ifndef YY_LOCATION_PRINT
-# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
-#  define YY_LOCATION_PRINT(File, Loc)			\
-     fprintf (File, "%d.%d-%d.%d",			\
-	      (Loc).first_line, (Loc).first_column,	\
-	      (Loc).last_line,  (Loc).last_column)
-# else
-#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
-# endif
-#endif
-
-
-/* YYLEX -- calling `yylex' with the right arguments.  */
-
-#ifdef YYLEX_PARAM
-# define YYLEX yylex (YYLEX_PARAM)
-#else
-# define YYLEX yylex ()
-#endif
-
-/* Enable debugging if requested.  */
-#if YYDEBUG
-
-# ifndef YYFPRINTF
-#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
-#  define YYFPRINTF fprintf
-# endif
-
-# define YYDPRINTF(Args)			\
-do {						\
-  if (yydebug)					\
-    YYFPRINTF Args;				\
-} while (YYID (0))
-
-# define YY_SYMBOL_PRINT(Title, Type, Value, Location)			  \
-do {									  \
-  if (yydebug)								  \
-    {									  \
-      YYFPRINTF (stderr, "%s ", Title);					  \
-      yy_symbol_print (stderr,						  \
-		  Type, Value); \
-      YYFPRINTF (stderr, "\n");						  \
-    }									  \
-} while (YYID (0))
-
-
-/*--------------------------------.
-| Print this symbol on YYOUTPUT.  |
-`--------------------------------*/
-
-/*ARGSUSED*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static void
-yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
-#else
-static void
-yy_symbol_value_print (yyoutput, yytype, yyvaluep)
-    FILE *yyoutput;
-    int yytype;
-    YYSTYPE const * const yyvaluep;
-#endif
-{
-  if (!yyvaluep)
-    return;
-# ifdef YYPRINT
-  if (yytype < YYNTOKENS)
-    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
-# else
-  YYUSE (yyoutput);
-# endif
-  switch (yytype)
-    {
-      default:
-	break;
-    }
-}
-
-
-/*--------------------------------.
-| Print this symbol on YYOUTPUT.  |
-`--------------------------------*/
-
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static void
-yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
-#else
-static void
-yy_symbol_print (yyoutput, yytype, yyvaluep)
-    FILE *yyoutput;
-    int yytype;
-    YYSTYPE const * const yyvaluep;
-#endif
-{
-  if (yytype < YYNTOKENS)
-    YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
-  else
-    YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
-
-  yy_symbol_value_print (yyoutput, yytype, yyvaluep);
-  YYFPRINTF (yyoutput, ")");
-}
-
-/*------------------------------------------------------------------.
-| yy_stack_print -- Print the state stack from its BOTTOM up to its |
-| TOP (included).                                                   |
-`------------------------------------------------------------------*/
-
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static void
-yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
-#else
-static void
-yy_stack_print (bottom, top)
-    yytype_int16 *bottom;
-    yytype_int16 *top;
-#endif
-{
-  YYFPRINTF (stderr, "Stack now");
-  for (; bottom <= top; ++bottom)
-    YYFPRINTF (stderr, " %d", *bottom);
-  YYFPRINTF (stderr, "\n");
-}
-
-# define YY_STACK_PRINT(Bottom, Top)				\
-do {								\
-  if (yydebug)							\
-    yy_stack_print ((Bottom), (Top));				\
-} while (YYID (0))
-
-
-/*------------------------------------------------.
-| Report that the YYRULE is going to be reduced.  |
-`------------------------------------------------*/
-
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static void
-yy_reduce_print (YYSTYPE *yyvsp, int yyrule)
-#else
-static void
-yy_reduce_print (yyvsp, yyrule)
-    YYSTYPE *yyvsp;
-    int yyrule;
-#endif
-{
-  int yynrhs = yyr2[yyrule];
-  int yyi;
-  unsigned long int yylno = yyrline[yyrule];
-  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
-	     yyrule - 1, yylno);
-  /* The symbols being reduced.  */
-  for (yyi = 0; yyi < yynrhs; yyi++)
-    {
-      fprintf (stderr, "   $%d = ", yyi + 1);
-      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
-		       &(yyvsp[(yyi + 1) - (yynrhs)])
-		       		       );
-      fprintf (stderr, "\n");
-    }
-}
-
-# define YY_REDUCE_PRINT(Rule)		\
-do {					\
-  if (yydebug)				\
-    yy_reduce_print (yyvsp, Rule); \
-} while (YYID (0))
-
-/* Nonzero means print parse trace.  It is left uninitialized so that
-   multiple parsers can coexist.  */
-int yydebug;
-#else /* !YYDEBUG */
-# define YYDPRINTF(Args)
-# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
-# define YY_STACK_PRINT(Bottom, Top)
-# define YY_REDUCE_PRINT(Rule)
-#endif /* !YYDEBUG */
-
-
-/* YYINITDEPTH -- initial size of the parser's stacks.  */
-#ifndef	YYINITDEPTH
-# define YYINITDEPTH 200
-#endif
-
-/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
-   if the built-in stack extension method is used).
-
-   Do not make this value too large; the results are undefined if
-   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
-   evaluated with infinite-precision integer arithmetic.  */
-
-#ifndef YYMAXDEPTH
-# define YYMAXDEPTH 10000
-#endif
-
-
-
-
-#if YYERROR_VERBOSE
-
-# ifndef yystrlen
-#  if defined __GLIBC__ && defined _STRING_H
-#   define yystrlen strlen
-#  else
-/* Return the length of YYSTR.  */
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static YYSIZE_T
-yystrlen (const char *yystr)
-#else
-static YYSIZE_T
-yystrlen (yystr)
-    const char *yystr;
-#endif
-{
-  YYSIZE_T yylen;
-  for (yylen = 0; yystr[yylen]; yylen++)
-    continue;
-  return yylen;
-}
-#  endif
-# endif
-
-# ifndef yystpcpy
-#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
-#   define yystpcpy stpcpy
-#  else
-/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
-   YYDEST.  */
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static char *
-yystpcpy (char *yydest, const char *yysrc)
-#else
-static char *
-yystpcpy (yydest, yysrc)
-    char *yydest;
-    const char *yysrc;
-#endif
-{
-  char *yyd = yydest;
-  const char *yys = yysrc;
-
-  while ((*yyd++ = *yys++) != '\0')
-    continue;
-
-  return yyd - 1;
-}
-#  endif
-# endif
-
-# ifndef yytnamerr
-/* Copy to YYRES the contents of YYSTR after stripping away unnecessary
-   quotes and backslashes, so that it's suitable for yyerror.  The
-   heuristic is that double-quoting is unnecessary unless the string
-   contains an apostrophe, a comma, or backslash (other than
-   backslash-backslash).  YYSTR is taken from yytname.  If YYRES is
-   null, do not copy; instead, return the length of what the result
-   would have been.  */
-static YYSIZE_T
-yytnamerr (char *yyres, const char *yystr)
-{
-  if (*yystr == '"')
-    {
-      YYSIZE_T yyn = 0;
-      char const *yyp = yystr;
-
-      for (;;)
-	switch (*++yyp)
-	  {
-	  case '\'':
-	  case ',':
-	    goto do_not_strip_quotes;
-
-	  case '\\':
-	    if (*++yyp != '\\')
-	      goto do_not_strip_quotes;
-	    /* Fall through.  */
-	  default:
-	    if (yyres)
-	      yyres[yyn] = *yyp;
-	    yyn++;
-	    break;
-
-	  case '"':
-	    if (yyres)
-	      yyres[yyn] = '\0';
-	    return yyn;
-	  }
-    do_not_strip_quotes: ;
-    }
-
-  if (! yyres)
-    return yystrlen (yystr);
-
-  return yystpcpy (yyres, yystr) - yyres;
-}
-# endif
-
-/* Copy into YYRESULT an error message about the unexpected token
-   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
-   including the terminating null byte.  If YYRESULT is null, do not
-   copy anything; just return the number of bytes that would be
-   copied.  As a special case, return 0 if an ordinary "syntax error"
-   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
-   size calculation.  */
-static YYSIZE_T
-yysyntax_error (char *yyresult, int yystate, int yychar)
-{
-  int yyn = yypact[yystate];
-
-  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
-    return 0;
-  else
-    {
-      int yytype = YYTRANSLATE (yychar);
-      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
-      YYSIZE_T yysize = yysize0;
-      YYSIZE_T yysize1;
-      int yysize_overflow = 0;
-      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
-      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
-      int yyx;
-
-# if 0
-      /* This is so xgettext sees the translatable formats that are
-	 constructed on the fly.  */
-      YY_("syntax error, unexpected %s");
-      YY_("syntax error, unexpected %s, expecting %s");
-      YY_("syntax error, unexpected %s, expecting %s or %s");
-      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
-      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
-# endif
-      char *yyfmt;
-      char const *yyf;
-      static char const yyunexpected[] = "syntax error, unexpected %s";
-      static char const yyexpecting[] = ", expecting %s";
-      static char const yyor[] = " or %s";
-      char yyformat[sizeof yyunexpected
-		    + sizeof yyexpecting - 1
-		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
-		       * (sizeof yyor - 1))];
-      char const *yyprefix = yyexpecting;
-
-      /* Start YYX at -YYN if negative to avoid negative indexes in
-	 YYCHECK.  */
-      int yyxbegin = yyn < 0 ? -yyn : 0;
-
-      /* Stay within bounds of both yycheck and yytname.  */
-      int yychecklim = YYLAST - yyn + 1;
-      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
-      int yycount = 1;
-
-      yyarg[0] = yytname[yytype];
-      yyfmt = yystpcpy (yyformat, yyunexpected);
-
-      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
-	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
-	  {
-	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
-	      {
-		yycount = 1;
-		yysize = yysize0;
-		yyformat[sizeof yyunexpected - 1] = '\0';
-		break;
-	      }
-	    yyarg[yycount++] = yytname[yyx];
-	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
-	    yysize_overflow |= (yysize1 < yysize);
-	    yysize = yysize1;
-	    yyfmt = yystpcpy (yyfmt, yyprefix);
-	    yyprefix = yyor;
-	  }
-
-      yyf = YY_(yyformat);
-      yysize1 = yysize + yystrlen (yyf);
-      yysize_overflow |= (yysize1 < yysize);
-      yysize = yysize1;
-
-      if (yysize_overflow)
-	return YYSIZE_MAXIMUM;
-
-      if (yyresult)
-	{
-	  /* Avoid sprintf, as that infringes on the user's name space.
-	     Don't have undefined behavior even if the translation
-	     produced a string with the wrong number of "%s"s.  */
-	  char *yyp = yyresult;
-	  int yyi = 0;
-	  while ((*yyp = *yyf) != '\0')
-	    {
-	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
-		{
-		  yyp += yytnamerr (yyp, yyarg[yyi++]);
-		  yyf += 2;
-		}
-	      else
-		{
-		  yyp++;
-		  yyf++;
-		}
-	    }
-	}
-      return yysize;
-    }
-}
-#endif /* YYERROR_VERBOSE */
-
-
-
-/*-----------------------------------------------.
-| Release the memory associated to this symbol.  |
-`-----------------------------------------------*/
-
-/*ARGSUSED*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-static void
-yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep)
-#else
-static void
-yydestruct (yymsg, yytype, yyvaluep)
-    const char *yymsg;
-    int yytype;
-    YYSTYPE *yyvaluep;
-#endif
-{
-  YYUSE (yyvaluep);
-
-  if (!yymsg)
-    yymsg = "Deleting";
-  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
-
-  switch (yytype)
-    {
-
-      default:
-	break;
-    }
-}
-
-
-
-/* Prevent warnings from -Wmissing-prototypes.  */
-
-#ifdef YYPARSE_PARAM
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void *YYPARSE_PARAM);
-#else
-int yyparse ();
-#endif
-#else /* ! YYPARSE_PARAM */
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void);
-#else
-int yyparse ();
-#endif
-#endif /* ! YYPARSE_PARAM */
-
-
-
-/* The look-ahead symbol.  */
-int yychar;
-
-/* The semantic value of the look-ahead symbol.  */
-YYSTYPE yylval;
-
-/* Number of syntax errors so far.  */
-int yynerrs;
-
-
-
-/*----------.
-| yyparse.  |
-`----------*/
-
-#ifdef YYPARSE_PARAM
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-int
-yyparse (void *YYPARSE_PARAM)
-#else
-int
-yyparse (YYPARSE_PARAM)
-    void *YYPARSE_PARAM;
-#endif
-#else /* ! YYPARSE_PARAM */
-#if (defined __STDC__ || defined __C99__FUNC__ \
-     || defined __cplusplus || defined _MSC_VER)
-int
-yyparse (void)
-#else
-int
-yyparse ()
-
-#endif
-#endif
-{
-  
-  int yystate;
-  int yyn;
-  int yyresult;
-  /* Number of tokens to shift before error messages enabled.  */
-  int yyerrstatus;
-  /* Look-ahead token as an internal (translated) token number.  */
-  int yytoken = 0;
-#if YYERROR_VERBOSE
-  /* Buffer for error messages, and its allocated size.  */
-  char yymsgbuf[128];
-  char *yymsg = yymsgbuf;
-  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
-#endif
-
-  /* Three stacks and their tools:
-     `yyss': related to states,
-     `yyvs': related to semantic values,
-     `yyls': related to locations.
-
-     Refer to the stacks thru separate pointers, to allow yyoverflow
-     to reallocate them elsewhere.  */
-
-  /* The state stack.  */
-  yytype_int16 yyssa[YYINITDEPTH];
-  yytype_int16 *yyss = yyssa;
-  yytype_int16 *yyssp;
-
-  /* The semantic value stack.  */
-  YYSTYPE yyvsa[YYINITDEPTH];
-  YYSTYPE *yyvs = yyvsa;
-  YYSTYPE *yyvsp;
-
-
-
-#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N))
-
-  YYSIZE_T yystacksize = YYINITDEPTH;
-
-  /* The variables used to return semantic value and location from the
-     action routines.  */
-  YYSTYPE yyval;
-
-
-  /* The number of symbols on the RHS of the reduced rule.
-     Keep to zero when no symbol should be popped.  */
-  int yylen = 0;
-
-  YYDPRINTF ((stderr, "Starting parse\n"));
-
-  yystate = 0;
-  yyerrstatus = 0;
-  yynerrs = 0;
-  yychar = YYEMPTY;		/* Cause a token to be read.  */
-
-  /* Initialize stack pointers.
-     Waste one element of value and location stack
-     so that they stay on the same level as the state stack.
-     The wasted elements are never initialized.  */
-
-  yyssp = yyss;
-  yyvsp = yyvs;
-
-  goto yysetstate;
-
-/*------------------------------------------------------------.
-| yynewstate -- Push a new state, which is found in yystate.  |
-`------------------------------------------------------------*/
- yynewstate:
-  /* In all cases, when you get here, the value and location stacks
-     have just been pushed.  So pushing a state here evens the stacks.  */
-  yyssp++;
-
- yysetstate:
-  *yyssp = yystate;
-
-  if (yyss + yystacksize - 1 <= yyssp)
-    {
-      /* Get the current used size of the three stacks, in elements.  */
-      YYSIZE_T yysize = yyssp - yyss + 1;
-
-#ifdef yyoverflow
-      {
-	/* Give user a chance to reallocate the stack.  Use copies of
-	   these so that the &'s don't force the real ones into
-	   memory.  */
-	YYSTYPE *yyvs1 = yyvs;
-	yytype_int16 *yyss1 = yyss;
-
-
-	/* Each stack pointer address is followed by the size of the
-	   data in use in that stack, in bytes.  This used to be a
-	   conditional around just the two extra args, but that might
-	   be undefined if yyoverflow is a macro.  */
-	yyoverflow (YY_("memory exhausted"),
-		    &yyss1, yysize * sizeof (*yyssp),
-		    &yyvs1, yysize * sizeof (*yyvsp),
-
-		    &yystacksize);
-
-	yyss = yyss1;
-	yyvs = yyvs1;
-      }
-#else /* no yyoverflow */
-# ifndef YYSTACK_RELOCATE
-      goto yyexhaustedlab;
-# else
-      /* Extend the stack our own way.  */
-      if (YYMAXDEPTH <= yystacksize)
-	goto yyexhaustedlab;
-      yystacksize *= 2;
-      if (YYMAXDEPTH < yystacksize)
-	yystacksize = YYMAXDEPTH;
-
-      {
-	yytype_int16 *yyss1 = yyss;
-	union yyalloc *yyptr =
-	  (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
-	if (! yyptr)
-	  goto yyexhaustedlab;
-	YYSTACK_RELOCATE (yyss);
-	YYSTACK_RELOCATE (yyvs);
-
-#  undef YYSTACK_RELOCATE
-	if (yyss1 != yyssa)
-	  YYSTACK_FREE (yyss1);
-      }
-# endif
-#endif /* no yyoverflow */
-
-      yyssp = yyss + yysize - 1;
-      yyvsp = yyvs + yysize - 1;
-
-
-      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
-		  (unsigned long int) yystacksize));
-
-      if (yyss + yystacksize - 1 <= yyssp)
-	YYABORT;
-    }
-
-  YYDPRINTF ((stderr, "Entering state %d\n", yystate));
-
-  goto yybackup;
-
-/*-----------.
-| yybackup.  |
-`-----------*/
-yybackup:
-
-  /* Do appropriate processing given the current state.  Read a
-     look-ahead token if we need one and don't already have one.  */
-
-  /* First try to decide what to do without reference to look-ahead token.  */
-  yyn = yypact[yystate];
-  if (yyn == YYPACT_NINF)
-    goto yydefault;
-
-  /* Not known => get a look-ahead token if don't already have one.  */
-
-  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
-  if (yychar == YYEMPTY)
-    {
-      YYDPRINTF ((stderr, "Reading a token: "));
-      yychar = YYLEX;
-    }
-
-  if (yychar <= YYEOF)
-    {
-      yychar = yytoken = YYEOF;
-      YYDPRINTF ((stderr, "Now at end of input.\n"));
-    }
-  else
-    {
-      yytoken = YYTRANSLATE (yychar);
-      YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);
-    }
-
-  /* If the proper action on seeing token YYTOKEN is to reduce or to
-     detect an error, take that action.  */
-  yyn += yytoken;
-  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
-    goto yydefault;
-  yyn = yytable[yyn];
-  if (yyn <= 0)
-    {
-      if (yyn == 0 || yyn == YYTABLE_NINF)
-	goto yyerrlab;
-      yyn = -yyn;
-      goto yyreduce;
-    }
-
-  if (yyn == YYFINAL)
-    YYACCEPT;
-
-  /* Count tokens shifted since error; after three, turn off error
-     status.  */
-  if (yyerrstatus)
-    yyerrstatus--;
-
-  /* Shift the look-ahead token.  */
-  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
-
-  /* Discard the shifted token unless it is eof.  */
-  if (yychar != YYEOF)
-    yychar = YYEMPTY;
-
-  yystate = yyn;
-  *++yyvsp = yylval;
-
-  goto yynewstate;
-
-
-/*-----------------------------------------------------------.
-| yydefault -- do the default action for the current state.  |
-`-----------------------------------------------------------*/
-yydefault:
-  yyn = yydefact[yystate];
-  if (yyn == 0)
-    goto yyerrlab;
-  goto yyreduce;
-
-
-/*-----------------------------.
-| yyreduce -- Do a reduction.  |
-`-----------------------------*/
-yyreduce:
-  /* yyn is the number of a rule to reduce with.  */
-  yylen = yyr2[yyn];
-
-  /* If YYLEN is nonzero, implement the default value of the action:
-     `$$ = $1'.
-
-     Otherwise, the following line sets YYVAL to garbage.
-     This behavior is undocumented and Bison
-     users should not rely upon it.  Assigning to YYVAL
-     unconditionally makes the parser a bit smaller, and it avoids a
-     GCC warning that YYVAL may be used uninitialized.  */
-  yyval = yyvsp[1-yylen];
-
-
-  YY_REDUCE_PRINT (yyn);
-  switch (yyn)
-    {
-        case 8:
-#line 344 "fortran.y"
-    {yyerrok;yyclearin;;}
-    break;
-
-  case 13:
-#line 352 "fortran.y"
-    {
-                     if (inmoduledeclare == 0 )
-                     {
-                        pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_curinclude,
-                                              pos_end-pos_curinclude);
-                     }
-                  ;}
-    break;
-
-  case 18:
-#line 368 "fortran.y"
-    {
-            /* we should ignore the declaration until the keyword             */
-            /*    TOK_ENDDONOTTREAT                                           */
-            couldaddvariable = 0 ;
-            RemoveWordCUR_0(fortranout,-20,20);
-         ;}
-    break;
-
-  case 19:
-#line 375 "fortran.y"
-    {
-             couldaddvariable = 1 ;
-             RemoveWordCUR_0(fortranout,-24,24);
-          ;}
-    break;
-
-  case 22:
-#line 382 "fortran.y"
-    {pos_cur = setposcur();;}
-    break;
-
-  case 27:
-#line 394 "fortran.y"
-    {if (incom !=1) {strcpy(curbuf,"");incom=0;};}
-    break;
-
-  case 28:
-#line 397 "fortran.y"
-    {isrecursive = 0;;}
-    break;
-
-  case 29:
-#line 399 "fortran.y"
-    {isrecursive = 1;;}
-    break;
-
-  case 31:
-#line 403 "fortran.y"
-    {
-                      if ( couldaddvariable == 1)
-                      {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (4)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-
-                      }
-                      Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(1);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            writeheadnewsub_0(1);
-                      }
-                      }
-                   ;}
-    break;
-
-  case 32:
-#line 431 "fortran.y"
-    {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(2) - (2)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-
-                      }
-                      strcpy(subroutinename,(yyvsp[(2) - (2)].nac));
-                      /* Common case                                          */
-                      insubroutinedeclare = 1;
-                      /* in the second step we should write the head of       */
-                      /*    the subroutine sub_loop_<subroutinename>          */
-                      writeheadnewsub_0(1);
-                   ;}
-    break;
-
-  case 33:
-#line 449 "fortran.y"
-    {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (6)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,(yyvsp[(3) - (6)].nac));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(4) - (6)].l));
-                         strcpy(DeclType,"");
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            /* we should to list of the subroutine argument   */
-                            /* name of the function which has to be defined   */
-                            Add_SubroutineArgument_Var_1((yyvsp[(4) - (6)].l));
-                            strcpy(DeclType,"");
-                            Add_FunctionType_Var_1((yyvsp[(3) - (6)].nac));
-                            writeheadnewsub_0(2);
-                      }
-                   ;}
-    break;
-
-  case 34:
-#line 482 "fortran.y"
-    {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (4)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,(yyvsp[(3) - (4)].nac));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
-                         strcpy(DeclType,"");
-                         Add_FunctionType_Var_1((yyvsp[(3) - (4)].nac));
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            /* we should to list of the subroutine argument   */
-                            /* name of the function which has to be defined   */
-                            Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
-                            strcpy(DeclType,"");
-                            Add_FunctionType_Var_1((yyvsp[(3) - (4)].nac));
-                            writeheadnewsub_0(2);
-                      }
-                   ;}
-    break;
-
-  case 35:
-#line 516 "fortran.y"
-    {
-                      GlobalDeclaration = 0;
-                      strcpy(curmodulename,(yyvsp[(2) - (2)].nac));
-                      strcpy(subroutinename,"");
-                      Add_NameOfModule_1((yyvsp[(2) - (2)].nac));
-                      if ( inmoduledeclare == 0 )
-                      {
-                         /* To know if there are in the module declaration    */
-                         inmoduledeclare = 1;
-                         /* to know if a module has been met                  */
-                         inmodulemeet = 1;
-                         /* to know if we are after the keyword contains      */
-                         aftercontainsdeclare = 0 ;
-                      }
-                   ;}
-    break;
-
-  case 36:
-#line 533 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));strcpy(subroutinename,(yyvsp[(1) - (1)].nac));
-                      }
-                   ;}
-    break;
-
-  case 38:
-#line 542 "fortran.y"
-    {
-                      pos_curinclude = setposcur()-9;
-                   ;}
-    break;
-
-  case 39:
-#line 546 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) Add_Include_1((yyvsp[(1) - (1)].nac));
-                   ;}
-    break;
-
-  case 40:
-#line 550 "fortran.y"
-    {
-                      if ( firstpass == 1 && couldaddvariable == 1) (yyval.l)=NULL;
-                   ;}
-    break;
-
-  case 41:
-#line 553 "fortran.y"
-    {
-                      if ( firstpass == 1 && couldaddvariable == 1 ) (yyval.l)=NULL;
-                   ;}
-    break;
-
-  case 42:
-#line 557 "fortran.y"
-    {
-                       if ( firstpass == 1 && couldaddvariable == 1 ) (yyval.l)=(yyvsp[(2) - (3)].l);
-                   ;}
-    break;
-
-  case 45:
-#line 564 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         Add_SubroutineArgument_Var_1((yyvsp[(2) - (3)].l));
-                      }
-                   ;}
-    break;
-
-  case 46:
-#line 571 "fortran.y"
-    {
-                      if ( firstpass == 1  && couldaddvariable == 1)
-                      {
-                         strcpy(nameinttypenameback,nameinttypename);
-                         strcpy(nameinttypename,"");
-                         curvar=createvar((yyvsp[(1) - (1)].na),NULL);
-                        strcpy(nameinttypename,nameinttypenameback);
-                         curlistvar=insertvar(NULL,curvar);
-                         (yyval.l)=settype("",curlistvar);
-                      }
-                   ;}
-    break;
-
-  case 47:
-#line 583 "fortran.y"
-    {
-                      if ( firstpass == 1  && couldaddvariable == 1)
-                      {
-                         strcpy(nameinttypenameback,nameinttypename);
-                         strcpy(nameinttypename,"");                      
-                         curvar=createvar((yyvsp[(3) - (3)].na),NULL);
-                         strcpy(nameinttypename,nameinttypenameback);                         
-                         (yyval.l)=insertvar((yyvsp[(1) - (3)].l),curvar);
-                      }
-                   ;}
-    break;
-
-  case 48:
-#line 594 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 49:
-#line 595 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),"*");;}
-    break;
-
-  case 50:
-#line 598 "fortran.y"
-    {
-                      if ( VarTypepar == 1 )
-                      {
-                         couldaddvariable = 1 ;
-                         VarTypepar = 0;
-                      }
-                   ;}
-    break;
-
-  case 51:
-#line 606 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         VarType = 1;
-                         couldaddvariable = 0 ;
-                      }
-                   ;}
-    break;
-
-  case 52:
-#line 614 "fortran.y"
-    {
-                      if ( VarType == 1 ) couldaddvariable = 1 ;
-                      VarType = 0;
-                      VarTypepar = 0;
-                   ;}
-    break;
-
-  case 54:
-#line 621 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         if ( insubroutinedeclare == 0 )
-                         {
-                                                  Add_GlobalParameter_Var_1((yyvsp[(3) - (4)].l));
-                                                  }
-                         else Add_Parameter_Var_1((yyvsp[(3) - (4)].l));
-                         pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                    pos_end-pos_cur_decl);
-                      }
-                      VariableIsParameter =  0 ;
-                   ;}
-    break;
-
-  case 55:
-#line 636 "fortran.y"
-    {
-                     if ( couldaddvariable == 1 )
-                     {
-                        if ( insubroutinedeclare == 0 )
-                                                  Add_GlobalParameter_Var_1((yyvsp[(2) - (2)].l));
-                         else Add_Parameter_Var_1((yyvsp[(2) - (2)].l));
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                    pos_end-pos_cur_decl);
-                      }
-                      VariableIsParameter =  0 ;
-                   ;}
-    break;
-
-  case 57:
-#line 650 "fortran.y"
-    {
-                     pos_end = setposcur();
-                     RemoveWordSET_0(fortranout,pos_cursave,
-                                                pos_end-pos_cursave);
-                  ;}
-    break;
-
-  case 59:
-#line 657 "fortran.y"
-    {
-                   /* if the variable is a parameter we can suppose that is   */
-                   /*    value is the same on each grid. It is not useless to */
-                   /*    create a copy of it on each grid                     */
-                      if ( couldaddvariable == 1 )
-                      {
-                         Add_Globliste_1((yyvsp[(1) - (1)].l));
-                         /* if variableparamlists has been declared in a      */
-                         /*    subroutine                                     */
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            Add_Dimension_Var_1((yyvsp[(1) - (1)].l));
-                         }
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curdimension,
-                                                pos_end-pos_curdimension);
-                      }
-                      /*                                                      */
-                      PublicDeclare = 0;
-                      PrivateDeclare = 0;
-                      ExternalDeclare = 0;
-                      strcpy(NamePrecision,"");
-                      c_star = 0;
-                      strcpy(InitialValueGiven," ");
-                      strcpy(IntentSpec,"");
-                      VariableIsParameter =  0 ;
-                      Allocatabledeclare = 0 ;
-                      Targetdeclare = 0 ;
-                      SaveDeclare = 0;
-                      pointerdeclare = 0;
-                      optionaldeclare = 0 ;
-                      dimsgiven=0;
-                      c_selectorgiven=0;
-                      strcpy(nameinttypename,"");
-                      strcpy(c_selectorname,"");
-                   ;}
-    break;
-
-  case 60:
-#line 694 "fortran.y"
-    {
-      if (firstpass == 0)
-      {
-      if ((yyvsp[(1) - (1)].lnn))
-      {
-      removeglobfromlist(&((yyvsp[(1) - (1)].lnn)));
-      pos_end = setposcur();
-           RemoveWordSET_0(fortranout,pos_cur,pos_end-pos_cur);
-      writelistpublic((yyvsp[(1) - (1)].lnn));
-      }
-      }
-      ;}
-    break;
-
-  case 70:
-#line 716 "fortran.y"
-    {
-                      /* we should remove the data declaration                */
-                      if ( couldaddvariable == 1 && aftercontainsdeclare != 2 )
-                      {
-                        pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_curdata,
-                                              pos_end-pos_curdata);
-                      }
-                      if ( couldaddvariable == 1 && aftercontainsdeclare == 1 )
-                      {
-                      if (firstpass == 0)
-                      {
-                        ReWriteDataStatement_0(fortranout);
-                        pos_end = setposcur();
-                  }
-                      }
-                  ;}
-    break;
-
-  case 72:
-#line 736 "fortran.y"
-    {
-         PublicDeclare = 0 ;
-         PrivateDeclare = 0 ;
-      ;}
-    break;
-
-  case 110:
-#line 787 "fortran.y"
-    {
-                      /* if the variable is a parameter we can suppose that is*/
-                      /*    value is the same on each grid. It is not useless */
-                      /*    to create a copy of it on each grid               */
-                      if ( couldaddvariable == 1 )
-                      {
-                      pos_end = setposcur();
-                      /*if (insubroutinedeclare == 0)
-                        {   */
-                         RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                 pos_end-pos_cur_decl);
-                                         
-                       /* }
-                      else
-                       {*/
-                        ReWriteDeclarationAndAddTosubroutine_01((yyvsp[(1) - (2)].l));
-                        pos_cur_decl = setposcur();
-                        
-                       /*}*/
-                      if ( firstpass == 0 &&
-                           GlobalDeclaration == 0 &&
-                           insubroutinedeclare == 0 )
-                      {
-
-                         sprintf(ligne,"\n#include \"Module_Declar_%s.h\"\n"
-                                                                ,curmodulename);
-                         tofich(fortranout,ligne,1);
-                         sprintf (ligne, "Module_Declar_%s.h",curmodulename);
-                         module_declar = associate(ligne);
-                         sprintf (ligne, " ");
-                         tofich (module_declar, ligne,1);
-                         GlobalDeclaration = 1 ;
-                         pos_cur_decl = setposcur();
-
-                      }
-                         (yyval.l) = (yyvsp[(1) - (2)].l);
-                         Add_Globliste_1((yyvsp[(1) - (2)].l));
-                                                  
-                         if ( insubroutinedeclare == 0 )
-                                                  Add_GlobalParameter_Var_1((yyvsp[(1) - (2)].l));
-                         else
-                         {
-                            if ( pointerdeclare == 1 )
-                                                Add_Pointer_Var_From_List_1((yyvsp[(1) - (2)].l));
-                            Add_Parameter_Var_1((yyvsp[(1) - (2)].l));
-                         }
-
-                         /* if variables has been declared in a subroutine    */
-                         if ( insubroutinedeclare == 1 )
-                         { 
-                       /*    Add_SubroutineDeclaration_Var_1($1);*/
-                         }
-                         /* If there are a SAVE declarations in module's      */
-                         /*    subroutines we should remove it from the       */
-                         /*    subroutines declaration and add it in the      */
-                         /*    global declarations                            */
-                         if ( aftercontainsdeclare == 1 &&
-                              SaveDeclare == 1 && firstpass == 1 )
-                         {
-                              if ( inmodulemeet == 0 ) Add_Save_Var_dcl_1((yyvsp[(1) - (2)].l));
-                              else  Add_SubroutineDeclarationSave_Var_1((yyvsp[(1) - (2)].l));
-                         }
-                      }
-                      /*                                                      */
-                      PublicDeclare = 0;
-                      PrivateDeclare = 0;
-                      ExternalDeclare = 0;
-                      strcpy(NamePrecision,"");
-                      c_star = 0;
-                      strcpy(InitialValueGiven," ");
-                      strcpy(IntentSpec,"");
-                      VariableIsParameter =  0 ;
-                      Allocatabledeclare = 0 ;
-                      Targetdeclare = 0 ;
-                      SaveDeclare = 0;
-                      pointerdeclare = 0;
-                      optionaldeclare = 0 ;
-                      dimsgiven=0;
-                      c_selectorgiven=0;
-                      strcpy(nameinttypename,"");
-                      strcpy(c_selectorname,"");
-                      GlobalDeclarationType = 0; 
-                   ;}
-    break;
-
-  case 111:
-#line 871 "fortran.y"
-    {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(2) - (3)].nac));
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,(yyvsp[(2) - (3)].nac));
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
-                         Add_FunctionType_Var_1((yyvsp[(2) - (3)].nac));
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
-                         Add_FunctionType_Var_1((yyvsp[(2) - (3)].nac));
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      strcpy(nameinttypename,"");
-
-                   ;}
-    break;
-
-  case 112:
-#line 908 "fortran.y"
-    {
-                       functiondeclarationisdone = 1;
-                   ;}
-    break;
-
-  case 113:
-#line 914 "fortran.y"
-    {
-                      VariableIsParameter = 1;
-                      pos_curparameter = setposcur()-9;
-                   ;}
-    break;
-
-  case 114:
-#line 919 "fortran.y"
-    {
-                      pos_curdata = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                      Init_List_Data_Var();
-                   ;}
-    break;
-
-  case 115:
-#line 924 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-/*                      if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
-                      else */
-/*                      sprintf(ligne,"%s",$3);*/
-                      createstringfromlistname(ligne,(yyvsp[(3) - (4)].lnn));
-                      if (firstpass == 1)
-                      Add_Data_Var_1(&List_Data_Var,(yyvsp[(1) - (4)].nac),ligne);
-                      else
-                      Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(1) - (4)].nac),ligne);
-                      }
-                   ;}
-    break;
-
-  case 116:
-#line 938 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                      /*if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
-                      else */
-                      /*sprintf(ligne,"%s",$5);   */
-                      createstringfromlistname(ligne,(yyvsp[(5) - (6)].lnn));                      
-                      if (firstpass == 1)                      
-                      Add_Data_Var_1(&List_Data_Var,(yyvsp[(3) - (6)].nac),ligne);
-                      else
-                      Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(3) - (6)].nac),ligne);                      
-                      }
-                   ;}
-    break;
-
-  case 117:
-#line 952 "fortran.y"
-    {
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       if (firstpass == 1)
-                       Add_Data_Var_Names_01(&List_Data_Var,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
-                       else
-                       Add_Data_Var_Names_01(&List_Data_Var_Cur,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
-                   ;}
-    break;
-
-  case 118:
-#line 967 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0);
-                      }
-                   ;}
-    break;
-
-  case 119:
-#line 974 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         (yyval.lnn) = Insertname((yyvsp[(3) - (3)].lnn),(yyvsp[(1) - (3)].na),1);
-                      }
-                   ;}
-    break;
-
-  case 124:
-#line 988 "fortran.y"
-    {
-                     pos_cursave = setposcur()-4;
-                  ;}
-    break;
-
-  case 126:
-#line 994 "fortran.y"
-    {
-                     if ( couldaddvariable == 1 ) Add_Save_Var_1((yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].d));
-                  ;}
-    break;
-
-  case 127:
-#line 999 "fortran.y"
-    {
-		(yyval.lnn)=Insertname(NULL,(yyvsp[(1) - (1)].nac),0);
-		;}
-    break;
-
-  case 128:
-#line 1003 "fortran.y"
-    {
-      printf("INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n");
-      exit(0);
-      ;}
-    break;
-
-  case 129:
-#line 1008 "fortran.y"
-    {
-      (yyval.lnn) = concat_listname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].lnn));
-      ;}
-    break;
-
-  case 130:
-#line 1013 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].nac));;}
-    break;
-
-  case 131:
-#line 1015 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s+%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 132:
-#line 1017 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s-%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 133:
-#line 1019 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s*%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 134:
-#line 1021 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s/%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 135:
-#line 1024 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"");;}
-    break;
-
-  case 136:
-#line 1026 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 143:
-#line 1038 "fortran.y"
-    {
-	ininterfacedeclare = 1 ;
-	printf("INTEFACE entree\n");
-	;}
-    break;
-
-  case 144:
-#line 1043 "fortran.y"
-    {
-      ininterfacedeclare = 0;
-      ;}
-    break;
-
-  case 145:
-#line 1048 "fortran.y"
-    {
-                      positioninblock=0;
-                      pos_curdimension = setposcur()-9;
-                   ;}
-    break;
-
-  case 146:
-#line 1054 "fortran.y"
-    {
-         if ( couldaddvariable == 1 )
-         {
-            /*                                                                */
-            curvar=createvar((yyvsp[(3) - (5)].nac),(yyvsp[(4) - (5)].d));
-            /*                                                                */
-            CreateAndFillin_Curvar("",curvar);
-            /*                                                                */
-            curlistvar=insertvar(NULL,curvar);
-            /*                                                                */
-            (yyval.l)=settype("",curlistvar);
-            /*                                                                */
-            strcpy(vallengspec,"");
-         }
-      ;}
-    break;
-
-  case 147:
-#line 1070 "fortran.y"
-    {
-         if ( couldaddvariable == 1 )
-         {
-            /*                                                                */
-            curvar=createvar((yyvsp[(3) - (5)].nac),(yyvsp[(4) - (5)].d));
-            /*                                                                */
-            CreateAndFillin_Curvar("",curvar);
-            /*                                                                */
-            curlistvar=insertvar((yyvsp[(1) - (5)].l),curvar);
-            /*                                                                */
-            (yyval.l)=curlistvar;
-            /*                                                                */
-            strcpy(vallengspec,"");
-         }
-      ;}
-    break;
-
-  case 150:
-#line 1090 "fortran.y"
-    {
-        (yyval.lnn)=(listname *)NULL;
-        ;}
-    break;
-
-  case 151:
-#line 1094 "fortran.y"
-    {
-          (yyval.lnn)=(yyvsp[(3) - (3)].lnn);
-         ;}
-    break;
-
-  case 152:
-#line 1099 "fortran.y"
-    {
-           (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].nac),0);
-           ;}
-    break;
-
-  case 153:
-#line 1103 "fortran.y"
-    {
-          (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].nac),0);
-          ;}
-    break;
-
-  case 154:
-#line 1108 "fortran.y"
-    {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcommon,
-                                                  pos_end-pos_curcommon);
-                   ;}
-    break;
-
-  case 155:
-#line 1114 "fortran.y"
-    {
-                         if ( couldaddvariable == 1 )
-                         {
-                            sprintf(charusemodule,"%s",(yyvsp[(2) - (3)].nac));
-                            Add_NameOfCommon_1((yyvsp[(2) - (3)].nac),subroutinename);
-                            pos_end = setposcur();
-                            RemoveWordSET_0(fortranout,pos_curcommon,
-                                                       pos_end-pos_curcommon);
-                         }
-                   ;}
-    break;
-
-  case 156:
-#line 1125 "fortran.y"
-    {
-                         if ( couldaddvariable == 1 )
-                         {
-                            sprintf(charusemodule,"%s",(yyvsp[(3) - (5)].nac));
-                            Add_NameOfCommon_1((yyvsp[(3) - (5)].nac),subroutinename);
-                            pos_end = setposcur();
-                            RemoveWordSET_0(fortranout,pos_curcommon,
-                                                       pos_end-pos_curcommon);
-                         }
-                   ;}
-    break;
-
-  case 157:
-#line 1137 "fortran.y"
-    {
-                      positioninblock=0;
-                      pos_curcommon = setposcur()-6;
-                   ;}
-    break;
-
-  case 158:
-#line 1142 "fortran.y"
-    {
-                      positioninblock=0;
-                      pos_curcommon = setposcur()-6-7;
-                   ;}
-    break;
-
-  case 159:
-#line 1148 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) Add_Common_var_1();
-                   ;}
-    break;
-
-  case 160:
-#line 1153 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) Add_Common_var_1();
-                   ;}
-    break;
-
-  case 161:
-#line 1157 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         positioninblock = positioninblock + 1 ;
-                         strcpy(commonvar,(yyvsp[(1) - (2)].nac));
-                         commondim = (yyvsp[(2) - (2)].d);
-                      }
-                   ;}
-    break;
-
-  case 162:
-#line 1167 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy((yyval.nac),"");
-                         positioninblock=0;
-                         strcpy(commonblockname,"");
-                      }
-                   ;}
-    break;
-
-  case 163:
-#line 1176 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy((yyval.nac),(yyvsp[(2) - (3)].nac));
-                         positioninblock=0;
-                         strcpy(commonblockname,(yyvsp[(2) - (3)].nac));
-                      }
-                   ;}
-    break;
-
-  case 166:
-#line 1189 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) (yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v));
-                   ;}
-    break;
-
-  case 167:
-#line 1193 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 ) (yyval.l)=insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v));
-                   ;}
-    break;
-
-  case 168:
-#line 1198 "fortran.y"
-    {
-                     if ( couldaddvariable == 1 )
-                     {
-                         curvar=(variable *) malloc(sizeof(variable));
-                         /*                                                   */
-                         Init_Variable(curvar);
-                         /*                                                   */
-                         curvar->v_VariableIsParameter=1;
-                         strcpy(curvar->v_nomvar,(yyvsp[(1) - (3)].nac));
-                         Save_Length((yyvsp[(1) - (3)].nac),4);
-                         strcpy(curvar->v_subroutinename,subroutinename);
-                         Save_Length(subroutinename,11);
-                         strcpy(curvar->v_modulename,curmodulename);
-                         Save_Length(curmodulename,6);
-                         strcpy(curvar->v_initialvalue,(yyvsp[(3) - (3)].na));
-                         Save_Length((yyvsp[(3) - (3)].na),14);
-                         strcpy(curvar->v_commoninfile,mainfile);
-                         Save_Length(mainfile,10);
-                         (yyval.v)=curvar;
-                      }
-                   ;}
-    break;
-
-  case 172:
-#line 1226 "fortran.y"
-    {
-                       if ( insubroutinedeclare == 1 )
-                       {
-                          Add_ImplicitNoneSubroutine_1();
-                          pos_end = setposcur();
-                          RemoveWordSET_0(fortranout,pos_end-13,
-                                                             13);
-                       }
-                    ;}
-    break;
-
-  case 175:
-#line 1240 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         /*                                                   */
-                         if (dimsgiven == 1)
-                         {
-                            curvar=createvar((yyvsp[(3) - (6)].nac),curdim);
-                            GlobalDeclarationType == 0;
-                         }
-                         else
-                         {
-                            curvar=createvar((yyvsp[(3) - (6)].nac),(yyvsp[(4) - (6)].d));
-                         }
-                         /*                                                   */
-                         CreateAndFillin_Curvar(DeclType,curvar);
-                         /*                                                   */
-                         curlistvar=insertvar(NULL,curvar);
-                         if (!strcasecmp(DeclType,"character"))
-                         {
-                            if (c_selectorgiven == 1)
-                            {
-                               strcpy(c_selectordim.first,"1");
-                               strcpy(c_selectordim.last,c_selectorname);
-                               Save_Length(c_selectorname,1);
-                               change_dim_char
-                                     (insertdim(NULL,c_selectordim),curlistvar);
-                            }
-                         }
-                         (yyval.l)=settype(DeclType,curlistvar);
-                      }
-                      strcpy(vallengspec,"");
-                   ;}
-    break;
-
-  case 176:
-#line 1273 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         if (dimsgiven == 1)
-                         {
-                            curvar=createvar((yyvsp[(4) - (7)].nac),curdim);
-                         }
-                         else
-                         {
-                            curvar=createvar((yyvsp[(4) - (7)].nac),(yyvsp[(5) - (7)].d));
-                         }
-                         /*                                                   */
-                         CreateAndFillin_Curvar((yyvsp[(1) - (7)].l)->var->v_typevar,curvar);
-                         /*                                                   */
-                         strcpy(curvar->v_typevar,((yyvsp[(1) - (7)].l)->var->v_typevar));
-                         Save_Length((yyvsp[(1) - (7)].l)->var->v_typevar,3);
-                         /*                                                   */
-                         curlistvar=insertvar((yyvsp[(1) - (7)].l),curvar);
-                         if (!strcasecmp(DeclType,"character"))
-                         {
-                            if (c_selectorgiven == 1)
-                            {
-                               strcpy(c_selectordim.first,"1");
-                               strcpy(c_selectordim.last,c_selectorname);
-                               Save_Length(c_selectorname,1);
-                               change_dim_char
-                                     (insertdim(NULL,c_selectordim),curlistvar);
-                            }
-                         }
-                         (yyval.l)=curlistvar;
-                      }
-                      strcpy(vallengspec,"");
-                   ;}
-    break;
-
-  case 177:
-#line 1307 "fortran.y"
-    {dimsgiven=0;;}
-    break;
-
-  case 178:
-#line 1310 "fortran.y"
-    {strcpy(DeclType,(yyvsp[(1) - (2)].nac));;}
-    break;
-
-  case 179:
-#line 1312 "fortran.y"
-    {
-                      strcpy(DeclType,"CHARACTER");
-                   ;}
-    break;
-
-  case 180:
-#line 1316 "fortran.y"
-    {
-                      strcpy(DeclType,(yyvsp[(1) - (3)].nac));
-                      strcpy(nameinttypename,(yyvsp[(3) - (3)].nac));
-                   ;}
-    break;
-
-  case 181:
-#line 1321 "fortran.y"
-    {
-                      strcpy(DeclType,"TYPE");
-                      GlobalDeclarationType = 1
-                   ;}
-    break;
-
-  case 182:
-#line 1327 "fortran.y"
-    {
-                 /*     if ( couldaddvariable == 1 ) VarTypepar = 1 ;
-                      couldaddvariable = 0 ;
-                      pos_cur_decl = setposcur()-5;*/
-                   pos_cur_decl = setposcur()-5;
-                   ;}
-    break;
-
-  case 184:
-#line 1336 "fortran.y"
-    {c_selectorgiven=1;strcpy(c_selectorname,(yyvsp[(2) - (2)].nac));;}
-    break;
-
-  case 185:
-#line 1337 "fortran.y"
-    {c_star = 1;;}
-    break;
-
-  case 190:
-#line 1345 "fortran.y"
-    {
-                      pos_cur_decl = setposcur()-9;
-                   ;}
-    break;
-
-  case 191:
-#line 1349 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 192:
-#line 1352 "fortran.y"
-    {
-                      strcpy((yyval.nac),"INTEGER");
-                      pos_cur_decl = setposcur()-7;
-                   ;}
-    break;
-
-  case 193:
-#line 1356 "fortran.y"
-    {
-                      strcpy((yyval.nac),"REAL");
-                      pos_cur_decl = setposcur()-4;
-                   ;}
-    break;
-
-  case 194:
-#line 1361 "fortran.y"
-    {strcpy((yyval.nac),"COMPLEX");
-                   pos_cur_decl = setposcur()-7;;}
-    break;
-
-  case 195:
-#line 1364 "fortran.y"
-    {
-                      pos_cur_decl = setposcur()-16;
-                      strcpy((yyval.nac),"REAL");
-                      strcpy(nameinttypename,"8");
-                   ;}
-    break;
-
-  case 196:
-#line 1370 "fortran.y"
-    {strcpy((yyval.nac),"DOUBLE COMPLEX");;}
-    break;
-
-  case 197:
-#line 1372 "fortran.y"
-    {
-                      strcpy((yyval.nac),"LOGICAL");
-                      pos_cur_decl = setposcur()-7;
-                   ;}
-    break;
-
-  case 199:
-#line 1378 "fortran.y"
-    {strcpy(vallengspec,(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 200:
-#line 1380 "fortran.y"
-    {sprintf((yyval.na),"*%s",(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 201:
-#line 1381 "fortran.y"
-    {strcpy((yyval.na),"*(*)");;}
-    break;
-
-  case 208:
-#line 1392 "fortran.y"
-    {
-                      if ( strstr((yyvsp[(3) - (3)].na),"0.d0") )
-                      {
-                         strcpy(nameinttypename,"8");
-                         sprintf(NamePrecision,"");
-                      }
-                      else sprintf(NamePrecision,"%s = %s",(yyvsp[(1) - (3)].nac),(yyvsp[(3) - (3)].na));
-                   ;}
-    break;
-
-  case 209:
-#line 1401 "fortran.y"
-    {
-                      strcpy(NamePrecision,(yyvsp[(1) - (1)].nac));
-                   ;}
-    break;
-
-  case 210:
-#line 1405 "fortran.y"
-    {
-                      strcpy(NamePrecision,(yyvsp[(1) - (1)].nac));
-                   ;}
-    break;
-
-  case 211:
-#line 1409 "fortran.y"
-    {strcpy(CharacterSize,(yyvsp[(1) - (1)].na));
-                    strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 212:
-#line 1411 "fortran.y"
-    {strcpy(CharacterSize,"*");
-                    strcpy((yyval.na),"*");;}
-    break;
-
-  case 220:
-#line 1425 "fortran.y"
-    {
-                      VariableIsParameter = 1;
-                   ;}
-    break;
-
-  case 222:
-#line 1430 "fortran.y"
-    {Allocatabledeclare = 1;;}
-    break;
-
-  case 223:
-#line 1432 "fortran.y"
-    {
-                      dimsgiven=1;
-                      curdim=(yyvsp[(2) - (2)].d);
-                   ;}
-    break;
-
-  case 224:
-#line 1437 "fortran.y"
-    {ExternalDeclare = 1;;}
-    break;
-
-  case 225:
-#line 1439 "fortran.y"
-    {strcpy(IntentSpec,(yyvsp[(3) - (4)].nac));;}
-    break;
-
-  case 227:
-#line 1441 "fortran.y"
-    {optionaldeclare = 1 ;;}
-    break;
-
-  case 228:
-#line 1442 "fortran.y"
-    {pointerdeclare = 1 ;;}
-    break;
-
-  case 229:
-#line 1443 "fortran.y"
-    {
-/*                       if ( inmodulemeet == 1 )
-                       {*/
-                          SaveDeclare = 1 ;
-                     /*  }*/
-                    ;}
-    break;
-
-  case 230:
-#line 1450 "fortran.y"
-    {Targetdeclare = 1;;}
-    break;
-
-  case 231:
-#line 1452 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 232:
-#line 1453 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 233:
-#line 1454 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac)); ;}
-    break;
-
-  case 234:
-#line 1457 "fortran.y"
-    {PublicDeclare = 1;;}
-    break;
-
-  case 235:
-#line 1459 "fortran.y"
-    {PrivateDeclare = 1;;}
-    break;
-
-  case 236:
-#line 1461 "fortran.y"
-    {if ( created_dimensionlist == 1 )
-                       {
-                           (yyval.d)=(listdim *)NULL;
-                       }
-                   ;}
-    break;
-
-  case 237:
-#line 1467 "fortran.y"
-    {if ( created_dimensionlist == 1 ||
-                         agrif_parentcall      == 1 ) (yyval.d)=(yyvsp[(2) - (3)].d);;}
-    break;
-
-  case 238:
-#line 1470 "fortran.y"
-    {if ( created_dimensionlist == 1 ||
-                         agrif_parentcall      == 1 ) (yyval.d)=insertdim(NULL,(yyvsp[(1) - (1)].dim1));;}
-    break;
-
-  case 239:
-#line 1473 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                         if ( created_dimensionlist == 1 ) (yyval.d)=insertdim((yyvsp[(1) - (3)].d),(yyvsp[(3) - (3)].dim1));;}
-    break;
-
-  case 240:
-#line 1476 "fortran.y"
-    {
-                      strcpy((yyval.dim1).first,"1");
-                      strcpy((yyval.dim1).last,(yyvsp[(1) - (1)].na));
-                      Save_Length((yyvsp[(1) - (1)].na),1);
-                   ;}
-    break;
-
-  case 241:
-#line 1481 "fortran.y"
-    {
-                      strcpy((yyval.dim1).first,"");
-                      strcpy((yyval.dim1).last,"");
-                   ;}
-    break;
-
-  case 242:
-#line 1485 "fortran.y"
-    {
-                      strcpy((yyval.dim1).first,(yyvsp[(1) - (2)].na));
-                      Save_Length((yyvsp[(1) - (2)].na),2);
-                      strcpy((yyval.dim1).last,"");
-                   ;}
-    break;
-
-  case 243:
-#line 1490 "fortran.y"
-    {
-                      strcpy((yyval.dim1).first,"");
-                      strcpy((yyval.dim1).last,(yyvsp[(2) - (2)].na));
-                      Save_Length((yyvsp[(2) - (2)].na),1);
-                   ;}
-    break;
-
-  case 244:
-#line 1496 "fortran.y"
-    {
-                      strcpy((yyval.dim1).first,(yyvsp[(1) - (3)].na));
-                      Save_Length((yyvsp[(1) - (3)].na),2);
-                      strcpy((yyval.dim1).last,(yyvsp[(3) - (3)].na));
-                      Save_Length((yyvsp[(3) - (3)].na),1);
-                   ;}
-    break;
-
-  case 245:
-#line 1503 "fortran.y"
-    {strcpy((yyval.na),"*");;}
-    break;
-
-  case 246:
-#line 1504 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 247:
-#line 1506 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 248:
-#line 1508 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 249:
-#line 1510 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 250:
-#line 1512 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 251:
-#line 1516 "fortran.y"
-    {sprintf((yyval.na),"SUM(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 252:
-#line 1518 "fortran.y"
-    {sprintf((yyval.na),"MAX(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 253:
-#line 1520 "fortran.y"
-    {sprintf((yyval.na),"TANH(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 254:
-#line 1522 "fortran.y"
-    {sprintf((yyval.na),"MAXVAL(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 255:
-#line 1524 "fortran.y"
-    {sprintf((yyval.na),"MIN(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 256:
-#line 1526 "fortran.y"
-    {sprintf((yyval.na),"MINVAL(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 257:
-#line 1528 "fortran.y"
-    {sprintf((yyval.na),"TRIM(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 258:
-#line 1530 "fortran.y"
-    {sprintf((yyval.na),"SQRT(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 259:
-#line 1532 "fortran.y"
-    {sprintf((yyval.na),"REAL(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 260:
-#line 1534 "fortran.y"
-    {sprintf((yyval.na),"NINT(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 261:
-#line 1536 "fortran.y"
-    {sprintf((yyval.na),"FLOAT(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 262:
-#line 1538 "fortran.y"
-    {sprintf((yyval.na),"EXP(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 263:
-#line 1540 "fortran.y"
-    {sprintf((yyval.na),"COS(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 264:
-#line 1542 "fortran.y"
-    {sprintf((yyval.na),"COSH(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 265:
-#line 1544 "fortran.y"
-    {sprintf((yyval.na),"ACOS(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 266:
-#line 1546 "fortran.y"
-    {sprintf((yyval.na),"SIN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 267:
-#line 1548 "fortran.y"
-    {sprintf((yyval.na),"SINH(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 268:
-#line 1550 "fortran.y"
-    {sprintf((yyval.na),"ASIN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 269:
-#line 1552 "fortran.y"
-    {sprintf((yyval.na),"LOG(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 270:
-#line 1554 "fortran.y"
-    {sprintf((yyval.na),"TAN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 271:
-#line 1556 "fortran.y"
-    {sprintf((yyval.na),"ATAN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 272:
-#line 1558 "fortran.y"
-    {sprintf((yyval.na),"ABS(%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 273:
-#line 1560 "fortran.y"
-    {sprintf((yyval.na),"MOD(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 274:
-#line 1562 "fortran.y"
-    {sprintf((yyval.na),"SIGN(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 275:
-#line 1564 "fortran.y"
-    {sprintf((yyval.na),"MINLOC(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 276:
-#line 1566 "fortran.y"
-    {sprintf((yyval.na),"MAXLOC(%s)",(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 277:
-#line 1568 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 278:
-#line 1570 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                   { strcpy((yyval.na),(yyvsp[(1) - (3)].na));strcat((yyval.na),",");strcat((yyval.na),(yyvsp[(3) - (3)].na));};}
-    break;
-
-  case 279:
-#line 1573 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 280:
-#line 1575 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 281:
-#line 1577 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 282:
-#line 1579 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 283:
-#line 1581 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 284:
-#line 1583 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 285:
-#line 1585 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"+");;}
-    break;
-
-  case 286:
-#line 1586 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"-");;}
-    break;
-
-  case 287:
-#line 1589 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"+%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 288:
-#line 1591 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"-%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 289:
-#line 1593 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 290:
-#line 1595 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 291:
-#line 1597 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 292:
-#line 1599 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 293:
-#line 1601 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 294:
-#line 1603 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," > %s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 295:
-#line 1605 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 296:
-#line 1607 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," < %s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 297:
-#line 1609 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 298:
-#line 1611 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," >= %s",(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 299:
-#line 1613 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 300:
-#line 1615 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," <= %s",(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 301:
-#line 1617 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 302:
-#line 1619 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 303:
-#line 1621 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 304:
-#line 1623 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 305:
-#line 1625 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 306:
-#line 1627 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 307:
-#line 1629 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 308:
-#line 1631 "fortran.y"
-    {strcpy((yyval.na),"");;}
-    break;
-
-  case 309:
-#line 1633 "fortran.y"
-    {sprintf((yyval.na),"/%s",(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 310:
-#line 1635 "fortran.y"
-    {sprintf((yyval.na),"/= %s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 311:
-#line 1637 "fortran.y"
-    {sprintf((yyval.na),"//%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 312:
-#line 1640 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"==%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 313:
-#line 1642 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"= %s",(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 314:
-#line 1645 "fortran.y"
-    {if ( couldaddvariable == 1 )
-						{
-						printf("ident = %s\n",(yyvsp[(1) - (1)].nac));
-						strcpy((yyval.na),(yyvsp[(1) - (1)].nac));}
-						;}
-    break;
-
-  case 315:
-#line 1651 "fortran.y"
-    {if ( couldaddvariable == 1 ) {
-                   printf("struct = %s\n",(yyvsp[(1) - (1)].na));
-                   strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
-                   ;}
-    break;
-
-  case 316:
-#line 1656 "fortran.y"
-    {if ( couldaddvariable == 1 ) {
-                   printf("arrayref = %s\n",(yyvsp[(1) - (1)].na));
-                   strcpy((yyval.na),(yyvsp[(1) - (1)].na));
-                   };}
-    break;
-
-  case 317:
-#line 1661 "fortran.y"
-    {
-                      agrif_parentcall =0;
-                      if (!strcasecmp(identcopy,"Agrif_Parent") )
-                                                            agrif_parentcall =1;
-                      if ( Agrif_in_Tok_NAME(identcopy) == 1 )
-                      {
-                         inagrifcallargument = 1;
-                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                      }
-                   ;}
-    break;
-
-  case 318:
-#line 1674 "fortran.y"
-    {
-                     strcpy((yyval.na),(yyvsp[(1) - (1)].na));
-                     if ( incalldeclare == 0 ) inagrifcallargument = 0;
-                   ;}
-    break;
-
-  case 319:
-#line 1679 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," %s %s ",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 320:
-#line 1681 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                                sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na));;}
-    break;
-
-  case 321:
-#line 1684 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                         sprintf((yyval.na)," %s ( %s ) %s ",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
-    break;
-
-  case 322:
-#line 1688 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                         sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].nac),(yyvsp[(3) - (4)].na));
-                         ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].na));
-                         agrif_parentcall =0;
-                      }
-                   ;}
-    break;
-
-  case 323:
-#line 1698 "fortran.y"
-    {
-                      sprintf((yyval.na)," %s %% %s ",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));
-                      if ( incalldeclare == 0 ) inagrifcallargument = 0;
-                   ;}
-    break;
-
-  case 324:
-#line 1704 "fortran.y"
-    {sprintf((yyval.na),"(/%s/)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 325:
-#line 1706 "fortran.y"
-    {strcpy((yyval.na)," ");;}
-    break;
-
-  case 326:
-#line 1708 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 327:
-#line 1710 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 328:
-#line 1712 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 329:
-#line 1714 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 330:
-#line 1715 "fortran.y"
-    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 331:
-#line 1718 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s :%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 332:
-#line 1720 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                               sprintf((yyval.na),"%s :%s :%s",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
-    break;
-
-  case 333:
-#line 1723 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":%s :%s",(yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].na));;}
-    break;
-
-  case 334:
-#line 1724 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),": : %s",(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 335:
-#line 1725 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":%s",(yyvsp[(2) - (2)].na));;}
-    break;
-
-  case 336:
-#line 1726 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s :",(yyvsp[(1) - (2)].na));;}
-    break;
-
-  case 337:
-#line 1727 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":");;}
-    break;
-
-  case 338:
-#line 1729 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 && afterpercent == 0)
-                       {
-                       if ( Vartonumber((yyvsp[(1) - (1)].nac)) == 1 )
-                       {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                       if (!strcasecmp((yyvsp[(1) - (1)].nac),"Agrif_Parent") )
-                                                            agrif_parentcall =1;
-                       if ( VariableIsNotFunction((yyvsp[(1) - (1)].nac)) == 0 )
-                       {
-                       printf("var = %s\n",(yyvsp[(1) - (1)].nac));
-                          if ( inagrifcallargument == 1 )
-                          {
-                             if ( !strcasecmp((yyvsp[(1) - (1)].nac),identcopy) )
-                             {
-                                strcpy(sameagrifname,identcopy);
-                                sameagrifargument = 1;
-                             }
-                          }
-                          strcpy(identcopy,(yyvsp[(1) - (1)].nac));
-                          pointedvar=0;
-                          strcpy(truename,(yyvsp[(1) - (1)].nac));
-                          if (variscoupled_0((yyvsp[(1) - (1)].nac))) strcpy(truename,getcoupledname_0((yyvsp[(1) - (1)].nac)));
-
-                          if ( VarIsNonGridDepend(truename) == 0 &&
-                               Variableshouldberemove(truename) == 0 )
-                          {                      
-                             if ( inagrifcallargument == 1 ||
-                                  varispointer_0(truename) == 1 )
-                             {
-                             printf("var2 = %s\n",(yyvsp[(1) - (1)].nac));
-                            if ((IsinListe(List_UsedInSubroutine_Var,(yyvsp[(1) - (1)].nac)) == 1) || (inagrifcallargument == 1))
-                             {
-                              if (varistyped_0(truename) == 0)
-                                 {
-                                 ModifyTheVariableName_0(truename,strlen((yyvsp[(1) - (1)].nac)));
-                                 }
-                                 }
-                             }
-                             printf("ici3\n");
-                             if ( inagrifcallargument != 1 ||
-                                  sameagrifargument ==1 )
-                                  {
-                                  printf("ici5 %s\n",truename);
-                                  Add_UsedInSubroutine_Var_1(truename);
-                          }
-                          }
-                          NotifyAgrifFunction_0(truename);
-                       }
-                       }
-                       else
-                       {
-                       afterpercent = 0;
-                    }
-                    ;}
-    break;
-
-  case 339:
-#line 1788 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),".TRUE.");;}
-    break;
-
-  case 340:
-#line 1789 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),".FALSE.");;}
-    break;
-
-  case 341:
-#line 1790 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 342:
-#line 1791 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 343:
-#line 1792 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 344:
-#line 1793 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 345:
-#line 1795 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.nac),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].nac));;}
-    break;
-
-  case 347:
-#line 1799 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 349:
-#line 1802 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 350:
-#line 1804 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 351:
-#line 1806 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
-    break;
-
-  case 352:
-#line 1807 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 353:
-#line 1810 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s :%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 354:
-#line 1812 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
-    break;
-
-  case 355:
-#line 1813 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 356:
-#line 1815 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
-    break;
-
-  case 357:
-#line 1816 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 358:
-#line 1818 "fortran.y"
-    {   strcpy(InitialValueGiven," ");;}
-    break;
-
-  case 359:
-#line 1820 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                          strcpy(InitValue,(yyvsp[(3) - (3)].na));
-                          strcpy(InitialValueGiven,"=");
-                       }
-                    ;}
-    break;
-
-  case 360:
-#line 1828 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                          strcpy(InitValue,(yyvsp[(3) - (3)].na));
-                          strcpy(InitialValueGiven,"=>");
-                       }
-                    ;}
-    break;
-
-  case 361:
-#line 1836 "fortran.y"
-    {pos_curinit = setposcur();;}
-    break;
-
-  case 362:
-#line 1839 "fortran.y"
-    {sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 363:
-#line 1842 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                      /* if variables has been declared in a subroutine       */
-                      if (insubroutinedeclare == 1)
-                      {
-                         copyuse_0((yyvsp[(2) - (2)].nac));
-                      }
-                      sprintf(charusemodule,"%s",(yyvsp[(2) - (2)].nac));
-                      Add_NameOfModuleUsed_1((yyvsp[(2) - (2)].nac));
-
-                      if ( inmoduledeclare == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curuse,
-                                               pos_end-pos_curuse);
-                      }
-                      }
-                    ;}
-    break;
-
-  case 364:
-#line 1862 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                      if (insubroutinedeclare == 1)
-                      {
-                         Add_CouplePointed_Var_1((yyvsp[(2) - (4)].nac),(yyvsp[(4) - (4)].lc));
-                      }
-                      if ( firstpass == 1 )
-                      {
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            coupletmp = (yyvsp[(4) - (4)].lc);
-                            strcpy(ligne,"");
-                            while ( coupletmp )
-                            {
-                               strcat(ligne,coupletmp->c_namevar);
-                               strcat(ligne," => ");
-                               strcat(ligne,coupletmp->c_namepointedvar);
-                               coupletmp = coupletmp->suiv;
-                               if ( coupletmp ) strcat(ligne,",");
-                            }
-                            sprintf(charusemodule,"%s",(yyvsp[(2) - (4)].nac));
-                         }
-                         Add_NameOfModuleUsed_1((yyvsp[(2) - (4)].nac));
-                      }
-                      if ( inmoduledeclare == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curuse,
-                                               pos_end-pos_curuse);
-                      }
-                      }
-                    ;}
-    break;
-
-  case 365:
-#line 1896 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                      /* if variables has been declared in a subroutine       */
-                      if (insubroutinedeclare == 1)
-                      {
-                         copyuseonly_0((yyvsp[(2) - (6)].nac));
-                      }
-                      sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].nac));
-                      Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].nac));
-
-                       if ( inmoduledeclare == 0 )
-                       {
-                          pos_end = setposcur();
-                          RemoveWordSET_0(fortranout,pos_curuse,
-                                                pos_end-pos_curuse);
-                       }
-                       }
-                    ;}
-    break;
-
-  case 366:
-#line 1916 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       /* if variables has been declared in a subroutine      */
-                       if (insubroutinedeclare == 1)
-                       {
-                          Add_CouplePointed_Var_1((yyvsp[(2) - (6)].nac),(yyvsp[(6) - (6)].lc));
-                       }
-                       if ( firstpass == 1 )
-                       {
-                         if ( insubroutinedeclare == 1 )
-                         {
-                             coupletmp = (yyvsp[(6) - (6)].lc);
-                             strcpy(ligne,"");
-                             while ( coupletmp )
-                             {
-                                strcat(ligne,coupletmp->c_namevar);
-                               if ( strcasecmp(coupletmp->c_namepointedvar,"") )
-                                                           strcat(ligne," => ");
-                                strcat(ligne,coupletmp->c_namepointedvar);
-                                coupletmp = coupletmp->suiv;
-                                if ( coupletmp ) strcat(ligne,",");
-                             }
-                             sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].nac));
-                          }
-                          Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].nac));
-                       }
-                       if ( firstpass == 0 )
-                       {
-                          if ( inmoduledeclare == 0 )
-                          {
-
-                            pos_end = setposcur();
-                             RemoveWordSET_0(fortranout,pos_curuse,
-                                                   pos_end-pos_curuse);
-                       if (oldfortranout) 
-                         variableisglobalinmodule((yyvsp[(6) - (6)].lc),(yyvsp[(2) - (6)].nac),oldfortranout,pos_curuseold);
-                        
-                          }
-                          else
-                          {
-
-                             /* if we are in the module declare and if the    */
-                             /* onlylist is a list of global variable         */
-                             variableisglobalinmodule((yyvsp[(6) - (6)].lc), (yyvsp[(2) - (6)].nac), fortranout,pos_curuse);
-                          }
-                       }
-                       }
-                    ;}
-    break;
-
-  case 367:
-#line 1967 "fortran.y"
-    {
-                      pos_curuse = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                     if (firstpass == 0 && oldfortranout) {
-                     pos_curuseold = setposcurname(oldfortranout);
-                     }
-                   ;}
-    break;
-
-  case 368:
-#line 1975 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 369:
-#line 1978 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 ) (yyval.lc) = (yyvsp[(1) - (1)].lc);
-                    ;}
-    break;
-
-  case 370:
-#line 1982 "fortran.y"
-    {
-                        if ( couldaddvariable == 1 )
-                        {
-                        /* insert the variable in the list $1                 */
-                        (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
-                        (yyval.lc) = (yyvsp[(3) - (3)].lc);
-                        }
-                    ;}
-    break;
-
-  case 371:
-#line 1992 "fortran.y"
-    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].nac));
-                       Save_Length((yyvsp[(1) - (3)].nac),21);
-                       strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].nac));
-                       Save_Length((yyvsp[(3) - (3)].nac),22);
-                       coupletmp->suiv = NULL;
-                       (yyval.lc) = coupletmp;
-                     ;}
-    break;
-
-  case 372:
-#line 2003 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 ) (yyval.lc) = (yyvsp[(1) - (1)].lc);
-                    ;}
-    break;
-
-  case 373:
-#line 2007 "fortran.y"
-    {
-                        if ( couldaddvariable == 1 )
-                        {
-                        /* insert the variable in the list $1                 */
-                        (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
-                        (yyval.lc) = (yyvsp[(3) - (3)].lc);
-                        }
-                    ;}
-    break;
-
-  case 374:
-#line 2017 "fortran.y"
-    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].nac));
-                       Save_Length((yyvsp[(1) - (3)].nac),21);
-                       strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].nac));
-                       Save_Length((yyvsp[(3) - (3)].nac),22);
-                       coupletmp->suiv = NULL;
-                       (yyval.lc) = coupletmp;
-                       pointedvar=1;
-                       Add_UsedInSubroutine_Var_1((yyvsp[(1) - (3)].nac));
-                    ;}
-    break;
-
-  case 375:
-#line 2028 "fortran.y"
-    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (1)].nac));
-                       Save_Length((yyvsp[(1) - (1)].nac),21);
-                       strcpy(coupletmp->c_namepointedvar,"");
-                       coupletmp->suiv = NULL;
-                       (yyval.lc) = coupletmp;
-                     ;}
-    break;
-
-  case 377:
-#line 2039 "fortran.y"
-    {
-                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     ;}
-    break;
-
-  case 378:
-#line 2045 "fortran.y"
-    {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                         curmodulename);
-                                                         inallocate = 0;
-                     ;}
-    break;
-
-  case 380:
-#line 2052 "fortran.y"
-    {
-                       GlobalDeclaration = 0 ;
-                       if ( firstpass == 0 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                          if ( module_declar && insubroutinedeclare == 0 )
-                          {
-                              fclose(module_declar);
-                          }
-                       }
-                       if ( couldaddvariable == 1 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                       if ( inmodulemeet == 1 )
-                       {
-                         /* we are in a module                                */
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            /* it is like an end subroutine <name>            */
-                            insubroutinedeclare = 0 ;
-                            /*                                                */
-                            pos_cur = setposcur();
-                            closeandcallsubloopandincludeit_0(1);
-                            functiondeclarationisdone = 0;
-                         }
-                         else
-                         {
-                            /* it is like an end module <name>                */
-                            inmoduledeclare = 0 ;
-                            inmodulemeet = 0 ;
-                         }
-                       }
-                       else
-                       {
-                          insubroutinedeclare = 0;
-                          /*                                                  */
-                          pos_cur = setposcur();                        
-                          closeandcallsubloopandincludeit_0(2);
-                            functiondeclarationisdone = 0;
-                          if ( firstpass == 0 )
-                          {
-                             if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                             else fprintf(paramout,"C\n");
-                             fclose(paramout);
-                           }
-                        }
-                      }
-                      strcpy(subroutinename,"");
-                    ;}
-    break;
-
-  case 381:
-#line 2102 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();                      
-                       closeandcallsubloopandincludeit_0(3);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    ;}
-    break;
-
-  case 382:
-#line 2120 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();
-                                             
-                       closeandcallsubloopandincludeit_0(1);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    ;}
-    break;
-
-  case 383:
-#line 2140 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();
-
-                       closeandcallsubloopandincludeit_0(0);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    ;}
-    break;
-
-  case 384:
-#line 2159 "fortran.y"
-    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       /* if we never meet the contains keyword               */
-                      Remove_Word_end_module_0(strlen((yyvsp[(2) - (2)].nac)));
-                       if ( inmoduledeclare == 1 )
-                       {
-                          if ( aftercontainsdeclare == 0 )
-                          {
-                             Write_GlobalParameter_Declaration_0();
-                             Write_NotGridDepend_Declaration_0();
-                             Write_GlobalType_Declaration_0();
-                             if ( module_declar_type )
-                             {
-                             strcpy (ligne, "\n#include \"Module_DeclarType_");
-                             strcat (ligne, curmodulename);
-                             strcat (ligne, ".h\"\n");
-                             tofich(fortranout,ligne,1); 
-                             }
-                             Write_Alloc_Subroutine_For_End_0();
-                          }
-                       }
-                                           
-                       inmoduledeclare = 0 ;
-                       inmodulemeet = 0 ;
-
-                      Write_Word_end_module_0();
-                      strcpy(curmodulename,"");
-                      aftercontainsdeclare = 1;
-                      if ( firstpass == 0 )
-                      {
-                         if ( module_declar && insubroutinedeclare == 0)
-                         {
-                           fclose(module_declar);
-                         }
-                         if ( module_declar_type && insubroutinedeclare == 0)
-                         {
-                          fclose(module_declar_type);
-                          module_declar_type = 0;
-                         }
-                      }
-                      GlobalDeclaration = 0 ;
-                      }
-                  ;}
-    break;
-
-  case 398:
-#line 2217 "fortran.y"
-    {
-                      if (inmoduledeclare == 1 )
-                      {
-                         Remove_Word_Contains_0();
-                         Write_GlobalParameter_Declaration_0();
-                         Write_GlobalType_Declaration_0();
-                             if ( module_declar_type)
-                             {                         
-                             strcpy (ligne, "\n#include \"Module_DeclarType_");
-                             strcat (ligne, curmodulename);
-                             strcat (ligne, ".h\"\n");
-                             tofich(fortranout,ligne,1); 
-                             }
-                         Write_NotGridDepend_Declaration_0();
-                         Write_Alloc_Subroutine_0();
-                         inmoduledeclare = 0 ;
-                         aftercontainsdeclare = 1;
-                      }
-                      else
-                      {
-                      incontainssubroutine = 1;
-                      strcpy(previoussubroutinename,subroutinename);
-                       if ( couldaddvariable == 1 )
-                       {
-                          if ( firstpass == 1 ) List_ContainsSubroutine =
-                                                Addtolistnom(subroutinename,
-                                                     List_ContainsSubroutine,0);
-                          insubroutinedeclare = 0;
-                          /*                                                  */
-
-                          closeandcallsubloop_contains_0();
-                            functiondeclarationisdone = 0;
-                         if ( firstpass == 0 )
-                         {
-                            if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                            else fprintf(paramout,"C\n");
-                            fclose(paramout);
-                         }
-                         }
-                         strcpy(subroutinename,"");
-                      }
-                   ;}
-    break;
-
-  case 399:
-#line 2261 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       functiondeclarationisdone = 0;
-                       }
-                    ;}
-    break;
-
-  case 400:
-#line 2271 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       }
-                    ;}
-    break;
-
-  case 401:
-#line 2280 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       }
-                    ;}
-    break;
-
-  case 402:
-#line 2289 "fortran.y"
-    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
-                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
-                       }
-                    ;}
-    break;
-
-  case 414:
-#line 2311 "fortran.y"
-    {strcpy((yyval.nac),"");;}
-    break;
-
-  case 415:
-#line 2312 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-  case 425:
-#line 2332 "fortran.y"
-    {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     ;}
-    break;
-
-  case 426:
-#line 2338 "fortran.y"
-    {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     ;}
-    break;
-
-  case 432:
-#line 2349 "fortran.y"
-    {if ( couldaddvariable == 1 ) created_dimensionlist = 0;;}
-    break;
-
-  case 433:
-#line 2351 "fortran.y"
-    {
-                  created_dimensionlist = 1;
-                  if  ( agrif_parentcall == 1 )
-                  {
-                      ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].d)->dim.last);
-                      agrif_parentcall =0;
-                      fprintf(fortranout," = ");
-                  }
-              ;}
-    break;
-
-  case 434:
-#line 2361 "fortran.y"
-    {created_dimensionlist = 1;;}
-    break;
-
-  case 439:
-#line 2369 "fortran.y"
-    {
-                      inagrifcallargument = 0 ;
-                      incalldeclare=0;
-                      if ( oldfortranout &&
-                           !strcasecmp(meetagrifinitgrids,subroutinename) &&
-                           firstpass == 0 &&
-                           callmpiinit == 1)
-                      {
-                      /*   pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcall,
-                                               pos_end-pos_curcall);
-                         fprintf(oldfortranout,"      Call MPI_Init (%s) \n"
-                                                                   ,mpiinitvar);*/
-                      }
-                      if ( oldfortranout           &&
-                           callagrifinitgrids == 1 &&
-                           firstpass == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcall,
-                                               pos_end-pos_curcall);
-
-                         strcpy(subofagrifinitgrids,subroutinename);
-                      }
-                      Instanciation_0(sameagrifname);
-                   ;}
-    break;
-
-  case 444:
-#line 2403 "fortran.y"
-    {
-                       if (!strcasecmp((yyvsp[(2) - (2)].nac),"MPI_Init") )
-                       {
-                          callmpiinit = 1;
-                       }
-                       else
-                       {
-                          callmpiinit = 0;
-                       }
-                       if (!strcasecmp((yyvsp[(2) - (2)].nac),"Agrif_Init_Grids") )
-                       {
-                          callagrifinitgrids = 1;
-                          strcpy(meetagrifinitgrids,subroutinename);
-                       }
-                       else callagrifinitgrids = 0;
-                       if ( !strcasecmp((yyvsp[(2) - (2)].nac),"Agrif_Open_File") )
-                       {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                       if ( Vartonumber((yyvsp[(2) - (2)].nac)) == 1 )
-                       {
-                          incalldeclare=1;
-                          inagrifcallargument = 1 ;
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                    ;}
-    break;
-
-  case 445:
-#line 2433 "fortran.y"
-    {pos_curcall=setposcur()-4;;}
-    break;
-
-  case 448:
-#line 2438 "fortran.y"
-    {
-                  if ( callmpiinit == 1 )
-                  {
-                     strcpy(mpiinitvar,(yyvsp[(1) - (1)].na));
-                     if ( firstpass == 1 )
-                     {
-                        Add_UsedInSubroutine_Var_1 (mpiinitvar);
-/*                        curvar=createvar($1,NULL);
-                        curlistvar=insertvar(NULL,curvar);
-                        List_Subr outineArgument_Var = AddListvarToListvar
-                         (curlistvar,List_SubroutineAr gument_Var,1);*/
-                     }
-                  }
-               ;}
-    break;
-
-  case 520:
-#line 2562 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 521:
-#line 2563 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 522:
-#line 2564 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 523:
-#line 2567 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 524:
-#line 2569 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 525:
-#line 2571 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 526:
-#line 2573 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 527:
-#line 2575 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 528:
-#line 2577 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
-    break;
-
-  case 529:
-#line 2578 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 530:
-#line 2579 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 531:
-#line 2582 "fortran.y"
-    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
-    break;
-
-  case 532:
-#line 2584 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," (%s)",(yyvsp[(2) - (3)].na));;}
-    break;
-
-  case 533:
-#line 2586 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 534:
-#line 2588 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 535:
-#line 2590 "fortran.y"
-    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
-    break;
-
-  case 536:
-#line 2594 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                              sprintf((yyval.na),"%s=%s,%s)",(yyvsp[(1) - (5)].nac),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
-    break;
-
-  case 537:
-#line 2597 "fortran.y"
-    {if ( couldaddvariable == 1 )
-                                        sprintf((yyval.na),"%s=%s,%s,%s)",(yyvsp[(1) - (7)].nac),(yyvsp[(3) - (7)].na),(yyvsp[(5) - (7)].na),(yyvsp[(7) - (7)].na));;}
-    break;
-
-  case 544:
-#line 2613 "fortran.y"
-    {Add_Allocate_Var_1((yyvsp[(1) - (1)].nac),curmodulename);;}
-    break;
-
-  case 547:
-#line 2618 "fortran.y"
-    {Add_Allocate_Var_1((yyvsp[(1) - (4)].nac),curmodulename);;}
-    break;
-
-  case 555:
-#line 2641 "fortran.y"
-    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
-    break;
-
-
-/* Line 1267 of yacc.c.  */
-#line 6522 "fortran.tab.c"
-      default: break;
-    }
-  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
-
-  YYPOPSTACK (yylen);
-  yylen = 0;
-  YY_STACK_PRINT (yyss, yyssp);
-
-  *++yyvsp = yyval;
-
-
-  /* Now `shift' the result of the reduction.  Determine what state
-     that goes to, based on the state we popped back to and the rule
-     number reduced by.  */
-
-  yyn = yyr1[yyn];
-
-  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
-  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
-    yystate = yytable[yystate];
-  else
-    yystate = yydefgoto[yyn - YYNTOKENS];
-
-  goto yynewstate;
-
-
-/*------------------------------------.
-| yyerrlab -- here on detecting error |
-`------------------------------------*/
-yyerrlab:
-  /* If not already recovering from an error, report this error.  */
-  if (!yyerrstatus)
-    {
-      ++yynerrs;
-#if ! YYERROR_VERBOSE
-      yyerror (YY_("syntax error"));
-#else
-      {
-	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
-	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
-	  {
-	    YYSIZE_T yyalloc = 2 * yysize;
-	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
-	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
-	    if (yymsg != yymsgbuf)
-	      YYSTACK_FREE (yymsg);
-	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
-	    if (yymsg)
-	      yymsg_alloc = yyalloc;
-	    else
-	      {
-		yymsg = yymsgbuf;
-		yymsg_alloc = sizeof yymsgbuf;
-	      }
-	  }
-
-	if (0 < yysize && yysize <= yymsg_alloc)
-	  {
-	    (void) yysyntax_error (yymsg, yystate, yychar);
-	    yyerror (yymsg);
-	  }
-	else
-	  {
-	    yyerror (YY_("syntax error"));
-	    if (yysize != 0)
-	      goto yyexhaustedlab;
-	  }
-      }
-#endif
-    }
-
-
-
-  if (yyerrstatus == 3)
-    {
-      /* If just tried and failed to reuse look-ahead token after an
-	 error, discard it.  */
-
-      if (yychar <= YYEOF)
-	{
-	  /* Return failure if at end of input.  */
-	  if (yychar == YYEOF)
-	    YYABORT;
-	}
-      else
-	{
-	  yydestruct ("Error: discarding",
-		      yytoken, &yylval);
-	  yychar = YYEMPTY;
-	}
-    }
-
-  /* Else will try to reuse look-ahead token after shifting the error
-     token.  */
-  goto yyerrlab1;
-
-
-/*---------------------------------------------------.
-| yyerrorlab -- error raised explicitly by YYERROR.  |
-`---------------------------------------------------*/
-yyerrorlab:
-
-  /* Pacify compilers like GCC when the user code never invokes
-     YYERROR and the label yyerrorlab therefore never appears in user
-     code.  */
-  if (/*CONSTCOND*/ 0)
-     goto yyerrorlab;
-
-  /* Do not reclaim the symbols of the rule which action triggered
-     this YYERROR.  */
-  YYPOPSTACK (yylen);
-  yylen = 0;
-  YY_STACK_PRINT (yyss, yyssp);
-  yystate = *yyssp;
-  goto yyerrlab1;
-
-
-/*-------------------------------------------------------------.
-| yyerrlab1 -- common code for both syntax error and YYERROR.  |
-`-------------------------------------------------------------*/
-yyerrlab1:
-  yyerrstatus = 3;	/* Each real token shifted decrements this.  */
-
-  for (;;)
-    {
-      yyn = yypact[yystate];
-      if (yyn != YYPACT_NINF)
-	{
-	  yyn += YYTERROR;
-	  if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
-	    {
-	      yyn = yytable[yyn];
-	      if (0 < yyn)
-		break;
-	    }
-	}
-
-      /* Pop the current state because it cannot handle the error token.  */
-      if (yyssp == yyss)
-	YYABORT;
-
-
-      yydestruct ("Error: popping",
-		  yystos[yystate], yyvsp);
-      YYPOPSTACK (1);
-      yystate = *yyssp;
-      YY_STACK_PRINT (yyss, yyssp);
-    }
-
-  if (yyn == YYFINAL)
-    YYACCEPT;
-
-  *++yyvsp = yylval;
-
-
-  /* Shift the error token.  */
-  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);
-
-  yystate = yyn;
-  goto yynewstate;
-
-
-/*-------------------------------------.
-| yyacceptlab -- YYACCEPT comes here.  |
-`-------------------------------------*/
-yyacceptlab:
-  yyresult = 0;
-  goto yyreturn;
-
-/*-----------------------------------.
-| yyabortlab -- YYABORT comes here.  |
-`-----------------------------------*/
-yyabortlab:
-  yyresult = 1;
-  goto yyreturn;
-
-#ifndef yyoverflow
-/*-------------------------------------------------.
-| yyexhaustedlab -- memory exhaustion comes here.  |
-`-------------------------------------------------*/
-yyexhaustedlab:
-  yyerror (YY_("memory exhausted"));
-  yyresult = 2;
-  /* Fall through.  */
-#endif
-
-yyreturn:
-  if (yychar != YYEOF && yychar != YYEMPTY)
-     yydestruct ("Cleanup: discarding lookahead",
-		 yytoken, &yylval);
-  /* Do not reclaim the symbols of the rule which action triggered
-     this YYABORT or YYACCEPT.  */
-  YYPOPSTACK (yylen);
-  YY_STACK_PRINT (yyss, yyssp);
-  while (yyssp != yyss)
-    {
-      yydestruct ("Cleanup: popping",
-		  yystos[*yyssp], yyvsp);
-      YYPOPSTACK (1);
-    }
-#ifndef yyoverflow
-  if (yyss != yyssa)
-    YYSTACK_FREE (yyss);
-#endif
-#if YYERROR_VERBOSE
-  if (yymsg != yymsgbuf)
-    YYSTACK_FREE (yymsg);
-#endif
-  /* Make sure YYID is used.  */
-  return YYID (yyresult);
-}
-
-
-#line 2643 "fortran.y"
-
-
-void processfortran(char *fichier_entree)
-{
-   extern FILE *fortranin;
-   extern FILE *fortranout;
-   char nomfile[LONG_C];
-   int c;
-   int confirmyes;
-
-/*   fortrandebug = 1;*/
-   if ( mark == 1 ) printf("Firstpass == %d \n",firstpass);
-/******************************************************************************/
-/*  1-  Open input and output files                                           */
-/******************************************************************************/
-   strcpy(nomfile,commondirin);
-   strcat(nomfile,"/");
-   strcat(nomfile,fichier_entree);
-   fortranin=fopen( nomfile,"r");
-   if (! fortranin)
-   {
-      printf("Error : File %s does not exist\n",nomfile);
-      exit(1);
-   }
-
-   strcpy(curfile,nomfile);
-   strcpy(nomfile,commondirout);
-   strcat(nomfile,"/");
-   strcat(nomfile,fichier_entree);
-   strcpy(nomfileoutput,nomfile);
-   Save_Length(nomfileoutput,31);
-   if (firstpass == 1)
-   {
-      if (checkexistcommon == 1)
-      {
-         if (fopen(nomfile,"r"))
-         {
-            printf("Warning : file %s already exist\n",nomfile);
-            confirmyes = 0;
-            while (confirmyes==0)
-            {
-               printf("Override file %s ? [Y/N]\n",nomfile);
-               c=getchar();
-               getchar();
-               if (c==79 || c==110)
-               {
-                  printf("We stop\n");
-                  exit(1);
-               }
-               if (c==89 || c==121)
-               {
-                  confirmyes=1;
-               }
-            }
-         }
-      }
-   }
-
-/******************************************************************************/
-/*  2-  Variables initialization                                              */
-/******************************************************************************/
-
-   line_num_fortran_common=1;
-   line_num_fortran=1;
-   PublicDeclare = 0;
-   PrivateDeclare = 0;
-   ExternalDeclare = 0;
-   SaveDeclare = 0;
-   pointerdeclare = 0;
-   optionaldeclare = 0;
-   incalldeclare = 0;
-   VarType = 0;
-   VarTypepar = 0;
-   Allocatabledeclare = 0 ;
-   Targetdeclare = 0 ;
-   strcpy(NamePrecision," ");
-   VariableIsParameter =  0 ;
-   strcpy(NamePrecision,"");
-   c_star = 0 ;
-   functiondeclarationisdone = 0;
-   insubroutinedeclare = 0 ;
-   ininterfacedeclare = 0 ;   
-   strcpy(subroutinename," ");
-   isrecursive = 0;
-   strcpy(InitialValueGiven," ");
-   strcpy(EmptyChar," ");
-   inmoduledeclare = 0;
-   incontainssubroutine = 0;
-   module_declar_type = 0;
-   GlobalDeclarationType = 0;
-   colnum=0;
-   incom=0;
-   couldaddvariable=1;
-   afterpercent = 0;
-   aftercontainsdeclare = 1;
-   strcpy(nameinttypename,"");
-   /* Name of the file without format                                         */
-   tmp = strchr(fichier_entree, '.');
-   strncpy(curfilename,fichier_entree,strlen(fichier_entree)-strlen(tmp));
-   Save_Length(curfilename,30);
-/******************************************************************************/
-/*  3-  Parsing of the input file (1 time)                                    */
-/******************************************************************************/
-   if (firstpass == 0 )
-   {
-      fortranout=fopen(nomfileoutput,"w");
-
-/*      NewModule_Creation_0();*/
-   }
-
-   fortranparse();
-
-   if (firstpass == 0 )
-   {
-   NewModule_Creation_0();
-   }
-   
-   strcpy(curfile,mainfile);
-
-   if (firstpass == 0 )
-   {
-   fclose(fortranout);
-   }
-}
-
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y	(revision 5659)
+++ 	(revision )
@@ -1,2766 +1,0 @@
-/******************************************************************************/
-/*                                                                            */
-/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
-/*                                                                            */
-/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
-/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
-/* This software is governed by the CeCILL-C license under French law and     */
-/* abiding by the rules of distribution of free software.  You can  use,      */
-/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
-/* license as circulated by CEA, CNRS and INRIA at the following URL          */
-/* "http ://www.cecill.info".                                                  */
-/*                                                                            */
-/* As a counterpart to the access to the source code and  rights to copy,     */
-/* modify and redistribute granted by the license, users are provided only    */
-/* with a limited warranty  and the software's author,  the holder of the     */
-/* economic rights,  and the successive licensors  have only  limited         */
-/* liability.                                                                 */
-/*                                                                            */
-/* In this respect, the user's attention is drawn to the risks associated     */
-/* with loading,  using,  modifying and/or developing or reproducing the      */
-/* software by the user in light of its specific status of free software,     */
-/* that may mean  that it is complicated to manipulate,  and  that  also      */
-/* therefore means  that it is reserved for developers  and  experienced      */
-/* professionals having in-depth computer knowledge. Users are therefore      */
-/* encouraged to load and test the software's suitability as regards their    */
-/* requirements in conditions enabling the security of their systems and/or   */
-/* data to be ensured and,  more generally, to use and operate it in the      */
-/* same conditions as regards security.                                       */
-/*                                                                            */
-/* The fact that you are presently reading this means that you have had       */
-/* knowledge of the CeCILL-C license and that you accept its terms.           */
-/******************************************************************************/
-/* version 1.7                                                                */
-/******************************************************************************/
-
-%{
-#define YYMAXDEPTH 1000
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include "decl.h"
-extern int line_num_fortran;
-extern int line_num_fortran_common;
-char *tmp;
-char c_selectorname[LONG_C];
-char ligne[LONG_C];
-char truename[LONGNOM];
-char identcopy[LONG_C];
-int c_selectorgiven=0;
-int incom;
-listvar *curlistvar;
-typedim c_selectordim;
-listcouple *coupletmp;
-listdim *parcoursdim;
-int removeline=0;
-listvar *test;
-%}
-
-%union {
-       char      nac[LONG_C];
-       char      na[LONGNOM];
-       listdim  *d;
-       listvar  *l;
-       listnom  *ln;
-       listcouple  *lc;
-       listname *lnn;
-       typedim   dim1;
-       variable *v;
-       }
-
-%left ','
-%nonassoc ':'
-%right '='
-%left TOK_BINARY_OP
-%left TOK_EQV TOK_NEQV
-%left TOK_OR TOK_XOR
-%left TOK_AND
-%left TOK_NOT
-%nonassoc TOK_LT TOK_GT TOK_LE TOK_GE TOK_EQ TOK_NE
-%nonassoc TOK_UNARY_OP
-%left TOK_DSLASH
-%left '+' '-'
-%left '*' TOK_SLASH
-%right TOK_DASTER
-
-%token TOK_SEP
-%token TOK_SEMICOLON
-%token TOK_NEXTLINE
-%token TOK_PARAMETER
-%token TOK_RESULT
-%token TOK_ONLY
-%token TOK_INCLUDE
-%token TOK_SUBROUTINE
-%token TOK_PROGRAM
-%token TOK_FUNCTION
-%token TOK_OMP
-%token TOK_DOLLAR
-%token TOK_FORMAT
-%token TOK_MAX
-%token TOK_TANH
-%token TOK_WHERE
-%token TOK_ELSEWHERE
-%token TOK_ENDWHERE
-%token TOK_MAXVAL
-%token TOK_TRIM
-%token TOK_SUM
-%token TOK_SQRT
-%token TOK_CASE
-%token TOK_SELECTCASE
-%token TOK_FILE
-%token TOK_END
-%token TOK_ERR
-%token TOK_DONOTTREAT
-%token TOK_ENDDONOTTREAT
-%token TOK_EXIST
-%token TOK_MIN
-%token TOK_FLOAT
-%token TOK_EXP
-%token TOK_COS
-%token TOK_COSH
-%token TOK_ACOS
-%token TOK_NINT
-%token TOK_CYCLE
-%token TOK_SIN
-%token TOK_SINH
-%token TOK_ASIN
-%token TOK_EQUIVALENCE
-%token TOK_BACKSPACE
-%token TOK_LOG
-%token TOK_TAN
-%token TOK_ATAN
-%token TOK_RECURSIVE
-%token TOK_ABS
-%token TOK_MOD
-%token TOK_SIGN
-%token TOK_MINLOC
-%token TOK_MAXLOC
-%token TOK_EXIT
-%token TOK_MINVAL
-%token TOK_PUBLIC
-%token TOK_PRIVATE
-%token TOK_ALLOCATABLE
-%token TOK_RETURN
-%token TOK_THEN
-%token TOK_ELSEIF
-%token TOK_ELSE
-%token TOK_ENDIF
-%token TOK_PRINT
-%token TOK_PLAINGOTO
-%token TOK_CONSTRUCTID
-%token TOK_LOGICALIF
-%token TOK_PLAINDO
-%token TOK_CONTAINS
-%token TOK_ENDDO
-%token TOK_MODULE
-%token TOK_ENDMODULE
-%token TOK_DOWHILE
-%token TOK_ALLOCATE
-%token TOK_OPEN
-%token TOK_CLOSE
-%token TOK_INQUIRE
-%token TOK_WRITE
-%token TOK_READ
-%token TOK_REWIND
-%token TOK_DEALLOCATE
-%token TOK_NULLIFY
-%token TOK_FIN
-%token TOK_DEBUT
-%token TOK_DIMENSION
-%token TOK_ENDSELECT
-%token TOK_EXTERNAL
-%token TOK_INTENT
-%token TOK_INTRINSIC
-%token TOK_NAMELIST
-%token TOK_CASEDEFAULT
-%token TOK_OPTIONAL
-%token TOK_POINTER
-%token TOK_CONTINUE
-%token TOK_SAVE
-%token TOK_TARGET
-%token TOK_QUOTE
-%token TOK_IMPLICIT
-%token TOK_NONE
-%token TOK_CALL
-%token TOK_STAT
-%token TOK_POINT_TO
-%token TOK_COMMON
-%token TOK_GLOBAL
-%token TOK_INTERFACE
-%token TOK_ENDINTERFACE
-%token TOK_LEFTAB
-%token TOK_RIGHTAB
-%token TOK_PAUSE
-%token TOK_PROCEDURE
-%token TOK_STOP
-%token TOK_NAMEEQ
-%token TOK_REAL8
-%token <nac> TOK_OUT
-%token <nac> TOK_INOUT
-%token <nac> TOK_IN
-%token <nac> TOK_USE
-%token <nac> TOK_DSLASH
-%token <nac> TOK_DASTER
-%token <nac> TOK_EQ
-%token <nac> TOK_EQV
-%token <nac> TOK_GT
-%token <nac> TOK_LT
-%token <nac> TOK_GE
-%token <nac> TOK_NE
-%token <nac> TOK_NEQV
-%token <nac> TOK_LE
-%token <nac> TOK_OR
-%token <nac> TOK_XOR
-%token <nac> TOK_NOT
-%token <nac> TOK_AND
-%token <nac> TOK_TRUE
-%token <nac> TOK_FALSE
-%token <nac> TOK_LABEL
-%token <nac> TOK_TYPE
-%token <nac> TOK_TYPEPAR
-%token <nac> TOK_ENDTYPE
-%token <nac> TOK_REAL
-%token <nac> TOK_INTEGER
-%token <nac> TOK_LOGICAL
-%token <nac> TOK_DOUBLEPRECISION
-%token <nac> TOK_DOUBLEREAL
-%token <nac> TOK_ENDSUBROUTINE
-%token <nac> TOK_ENDFUNCTION
-%token <nac> TOK_ENDPROGRAM
-%token <nac> TOK_ENDUNIT
-%token <nac> TOK_CHARACTER
-%token <nac> TOK_CHAR_CONSTANT
-%token <nac> TOK_CHAR_CUT
-%token <nac> TOK_DATA
-%token <nac> TOK_CHAR_INT
-%token <nac> TOK_CHAR_MESSAGE
-%token <nac> TOK_CSTREAL
-%token <nac> TOK_CSTREALDP
-%token <nac> TOK_CSTREALQP
-%token <nac> TOK_SFREAL
-%token <nac> TOK_COMPLEX
-%token <nac> TOK_DOUBLECOMPLEX
-%token <nac> TOK_NAME
-%token <nac> TOK_NAME_CHAR
-%token <nac> TOK_PROBTYPE  /* dimension of the problem                        */
-%token <nac> TOK_INTERPTYPE/* kind of interpolation                           */
-%token <nac> TOK_VARTYPE   /* posit ion of the grid variable on the cells of  */
-                          /*     the mesh                                     */
-%token <nac> TOK_SLASH
-%token <nac> TOK_BC        /* calculation of the boundary conditions           */
-%token <nac> TOK_OP
-%token <nac> TOK_CSTINT
-%token <nac> TOK_COMMENT
-%token <nac> TOK_FILENAME
-%token ','
-%token ':'
-%token '('
-%token ')'
-%token '['
-%token ']'
-%token '!'
-%token '_'
-%token '<'
-%token '>'
-%type <l> dcl
-%type <l> after_type
-%type <l> dimension
-%type <l> paramlist
-%type <l> args
-%type <l> arglist
-%type <lc> only_list
-%type <lc> only_name
-%type <lc> rename_list
-%type <lc> rename_name
-%type <d> dims
-%type <d> dimlist
-%type <dim1> dim
-%type <v> paramitem
-%type <nac> comblock
-%type <nac> name_routine
-%type <nac> module_name
-%type <nac> opt_name
-%type <nac> type
-%type <nac> word_endsubroutine
-%type <nac> word_endfunction
-%type <nac> word_endprogram
-%type <nac> word_endunit
-%type <nac> typename
-%type <nac> typespec
-%type <nac> string_constant
-%type <nac> simple_const
-%type <nac> ident
-%type <nac> do_var
-%type <nac> intent_spec
-%type <nac> signe
-%type <nac> opt_signe
-%type <nac> filename
-%type <nac> attribute
-%type <na> complex_const
-%type <na> begin_array
-%type <na> clause
-%type <na> arg
-%type <na> uexpr
-%type <na> minmaxlist
-%type <na> lhs
-%type <na> vec
-%type <na> outlist
-%type <na> out2
-%type <na> other
-%type <na> dospec
-%type <na> expr_data
-%type <na> structure_component
-%type <na> array_ele_substring_func_ref
-%type <na> funarglist
-%type <na> funarg
-%type <na> funargs
-%type <na> triplet
-%type <na> substring
-%type <na> opt_substring
-%type <na> opt_expr
-%type <na> optexpr
-%type <lnn> datavallist
-%type <lnn> datanamelist
-%type <na> after_slash
-%type <na> after_equal
-%type <na> predefinedfunction
-%type <na> expr
-%type <na> ubound
-%type <na> operation
-%type <na> proper_lengspec
-%type <lnn> use_name_list
-%type <lnn> public
-
-%left TOK_OP
-%%
-input :
-      | input line
-      ;
-line :  '\n' position
-      | thislabel suite_line_list
-      | TOK_COMMENT
-      | keyword cmnt writedeclar
-      | error writedeclar nulcurbuf
-                   {yyerrok;yyclearin;}
-      ;
-suite_line_list : suite_line
-      |   suite_line_list TOK_SEMICOLON suite_line
-      ;
-suite_line : entry fin_line  /* subroutine, function, module                    */
-      | spec fin_line      /* declaration                                     */
-      | before_include filename fin_line
-                  {
-                     if (inmoduledeclare == 0 )
-                     {
-                        pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_curinclude,
-                                              pos_end-pos_curinclude);
-                     }
-                  }
-      | exec cmnt writedeclar /* if, do etc ...                               */
-      | instr fin_line    /* instruction ident  : do i = 1 ...                */
-      ;
-instr : ident ':'
-      ;
-fin_line : position cmnt
-      ;
-keyword : TOK_DONOTTREAT
-         {
-            /* we should ignore the declaration until the keyword             */
-            /*    TOK_ENDDONOTTREAT                                           */
-            couldaddvariable = 0 ;
-            RemoveWordCUR_0(fortranout,-20,20);
-         }
-      | TOK_ENDDONOTTREAT
-         {
-             couldaddvariable = 1 ;
-             RemoveWordCUR_0(fortranout,-24,24);
-          }
-      | TOK_OMP
-      | TOK_DOLLAR
-      ;
-position : {pos_cur = setposcur();}
-      ;
-thislabel :
-      | TOK_LABEL nulcurbuf
-      ;
-cmnt :
-      | TOK_COMMENT
-      ;
-incomment :
-                   {incom = 1;}
-      ;
-nulcurbuf :
-                   {if (incom !=1) {strcpy(curbuf,"");incom=0;}}
-      ;
-opt_recursive :
-		{isrecursive = 0;}
-      | TOK_RECURSIVE
-		{isrecursive = 1;}
-      ;
-entry :
-      | opt_recursive TOK_SUBROUTINE name_routine arglist
-                   {
-                      if ( couldaddvariable == 1)
-                      {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$3);
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-
-                      }
-                      Add_SubroutineArgument_Var_1($4);
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(1);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            writeheadnewsub_0(1);
-                      }
-                      }
-                   }
-      | TOK_PROGRAM name_routine
-                   {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$2);
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-
-                      }
-                      strcpy(subroutinename,$2);
-                      /* Common case                                          */
-                      insubroutinedeclare = 1;
-                      /* in the second step we should write the head of       */
-                      /*    the subroutine sub_loop_<subroutinename>          */
-                      writeheadnewsub_0(1);
-                   }
-      | opt_recursive TOK_FUNCTION name_routine arglist TOK_RESULT arglist1
-                   {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$3);
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,$3);
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1($4);
-                         strcpy(DeclType,"");
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            /* we should to list of the subroutine argument   */
-                            /* name of the function which has to be defined   */
-                            Add_SubroutineArgument_Var_1($4);
-                            strcpy(DeclType,"");
-                            Add_FunctionType_Var_1($3);
-                            writeheadnewsub_0(2);
-                      }
-                   }
-      | opt_recursive TOK_FUNCTION name_routine arglist
-                   {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$3);
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,$3);
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1($4);
-                         strcpy(DeclType,"");
-                         Add_FunctionType_Var_1($3);
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                            insubroutinedeclare = 1;
-                            /* we should to list of the subroutine argument   */
-                            /* name of the function which has to be defined   */
-                            Add_SubroutineArgument_Var_1($4);
-                            strcpy(DeclType,"");
-                            Add_FunctionType_Var_1($3);
-                            writeheadnewsub_0(2);
-                      }
-                   }
-      | TOK_MODULE TOK_NAME
-                   {
-                      GlobalDeclaration = 0;
-                      strcpy(curmodulename,$2);
-                      strcpy(subroutinename,"");
-                      Add_NameOfModule_1($2);
-                      if ( inmoduledeclare == 0 )
-                      {
-                         /* To know if there are in the module declaration    */
-                         inmoduledeclare = 1;
-                         /* to know if a module has been met                  */
-                         inmodulemeet = 1;
-                         /* to know if we are after the keyword contains      */
-                         aftercontainsdeclare = 0 ;
-                      }
-                   }
-      ;
-name_routine : TOK_NAME
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy($$,$1);strcpy(subroutinename,$1);
-                      }
-                   }
-writedeclar :
-      ;
-before_include : TOK_INCLUDE
-                   {
-                      pos_curinclude = setposcur()-9;
-                   }
-filename : TOK_CHAR_CONSTANT
-                   {
-                      if ( couldaddvariable == 1 ) Add_Include_1($1);
-                   }
-      ;
-arglist :           {
-                      if ( firstpass == 1 && couldaddvariable == 1) $$=NULL;
-                   }
-      | '(' ')'    {
-                      if ( firstpass == 1 && couldaddvariable == 1 ) $$=NULL;
-                   }
-      | '(' args ')'
-                   {
-                       if ( firstpass == 1 && couldaddvariable == 1 ) $$=$2;
-                   }
-      ;
-arglist1:
-      | '(' ')'
-      | '(' args ')'
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         Add_SubroutineArgument_Var_1($2);
-                      }
-                   }
-      ;
-args :arg           {
-                      if ( firstpass == 1  && couldaddvariable == 1)
-                      {
-                         strcpy(nameinttypenameback,nameinttypename);
-                         strcpy(nameinttypename,"");
-                         curvar=createvar($1,NULL);
-                        strcpy(nameinttypename,nameinttypenameback);
-                         curlistvar=insertvar(NULL,curvar);
-                         $$=settype("",curlistvar);
-                      }
-                   }
-      | args ',' arg
-                   {
-                      if ( firstpass == 1  && couldaddvariable == 1)
-                      {
-                         strcpy(nameinttypenameback,nameinttypename);
-                         strcpy(nameinttypename,"");                      
-                         curvar=createvar($3,NULL);
-                         strcpy(nameinttypename,nameinttypenameback);                         
-                         $$=insertvar($1,curvar);
-                      }
-                   }
-      ;
-arg : TOK_NAME      {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | '*'        {if ( couldaddvariable == 1 ) strcpy($$,"*");}
-      ;
-spec : type after_type
-                   {
-                      if ( VarTypepar == 1 )
-                      {
-                         couldaddvariable = 1 ;
-                         VarTypepar = 0;
-                      }
-                   }
-      | TOK_TYPE opt_spec opt_sep opt_name
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         VarType = 1;
-                         couldaddvariable = 0 ;
-                      }
-                   }
-      | TOK_ENDTYPE opt_name
-                   {
-                      if ( VarType == 1 ) couldaddvariable = 1 ;
-                      VarType = 0;
-                      VarTypepar = 0;
-                   }
-      | TOK_POINTER list_couple
-      | before_parameter  '(' paramlist ')'
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         if ( insubroutinedeclare == 0 )
-                         {
-                                                  Add_GlobalParameter_Var_1($3);
-                                                  }
-                         else Add_Parameter_Var_1($3);
-                         pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                    pos_end-pos_cur_decl);
-                      }
-                      VariableIsParameter =  0 ;
-                   }
-      | before_parameter  paramlist
-                   {
-                     if ( couldaddvariable == 1 )
-                     {
-                        if ( insubroutinedeclare == 0 )
-                                                  Add_GlobalParameter_Var_1($2);
-                         else Add_Parameter_Var_1($2);
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                    pos_end-pos_cur_decl);
-                      }
-                      VariableIsParameter =  0 ;
-                   }
-      | common
-      | save
-                  {
-                     pos_end = setposcur();
-                     RemoveWordSET_0(fortranout,pos_cursave,
-                                                pos_end-pos_cursave);
-                  }
-      | implicit
-      | dimension
-                  {
-                   /* if the variable is a parameter we can suppose that is   */
-                   /*    value is the same on each grid. It is not useless to */
-                   /*    create a copy of it on each grid                     */
-                      if ( couldaddvariable == 1 )
-                      {
-                         Add_Globliste_1($1);
-                         /* if variableparamlists has been declared in a      */
-                         /*    subroutine                                     */
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            Add_Dimension_Var_1($1);
-                         }
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curdimension,
-                                                pos_end-pos_curdimension);
-                      }
-                      /*                                                      */
-                      PublicDeclare = 0;
-                      PrivateDeclare = 0;
-                      ExternalDeclare = 0;
-                      strcpy(NamePrecision,"");
-                      c_star = 0;
-                      strcpy(InitialValueGiven," ");
-                      strcpy(IntentSpec,"");
-                      VariableIsParameter =  0 ;
-                      Allocatabledeclare = 0 ;
-                      Targetdeclare = 0 ;
-                      SaveDeclare = 0;
-                      pointerdeclare = 0;
-                      optionaldeclare = 0 ;
-                      dimsgiven=0;
-                      c_selectorgiven=0;
-                      strcpy(nameinttypename,"");
-                      strcpy(c_selectorname,"");
-                   }
-      | public
-      {
-      if (firstpass == 0)
-      {
-      if ($1)
-      {
-      removeglobfromlist(&($1));
-      pos_end = setposcur();
-           RemoveWordSET_0(fortranout,pos_cur,pos_end-pos_cur);
-      writelistpublic($1);
-      }
-      }
-      }
-      | private
-      | use_stat
-      | module_proc_stmt
-      | interface
-      | namelist
-      | TOK_BACKSPACE '(' expr ')'
-      | TOK_EXTERNAL opt_sep use_name_list
-      | TOK_INTRINSIC opt_sep use_intrinsic_list
-      | TOK_EQUIVALENCE list_expr_equi
-      | before_data data '\n'
-                   {
-                      /* we should remove the data declaration                */
-                      if ( couldaddvariable == 1 && aftercontainsdeclare != 2 )
-                      {
-                        pos_end = setposcur();
-                        RemoveWordSET_0(fortranout,pos_curdata,
-                                              pos_end-pos_curdata);
-                      }
-                      if ( couldaddvariable == 1 && aftercontainsdeclare == 1 )
-                      {
-                      if (firstpass == 0)
-                      {
-                        ReWriteDataStatement_0(fortranout);
-                        pos_end = setposcur();
-                  }
-                      }
-                  }
-      ;
-opt_spec :
-      | access_spec
-      {
-         PublicDeclare = 0 ;
-         PrivateDeclare = 0 ;
-      }
-      ;
-name_intrinsic : TOK_SUM
-      | TOK_TANH
-      | TOK_MAXVAL
-      | TOK_MIN
-      | TOK_MINVAL
-      | TOK_TRIM
-      | TOK_SQRT
-      | TOK_NINT
-      | TOK_FLOAT
-      | TOK_EXP
-      | TOK_COS
-      | TOK_COSH
-      | TOK_ACOS
-      | TOK_SIN
-      | TOK_SINH
-      | TOK_ASIN
-      | TOK_LOG
-      | TOK_TAN
-      | TOK_ATAN
-      | TOK_MOD
-      | TOK_SIGN
-      | TOK_MINLOC
-      | TOK_MAXLOC
-      | TOK_NAME
-      ;
-use_intrinsic_list : name_intrinsic
-      | use_intrinsic_list ',' name_intrinsic
-      ;
-list_couple : '(' list_expr ')'
-      | list_couple ',' '(' list_expr ')'
-      ;
-list_expr_equi : expr_equi
-      | list_expr_equi ',' expr_equi
-      ;
-expr_equi : '(' list_expr_equi1 ')'
-      ;
-list_expr_equi1 : ident dims
-      | list_expr_equi1 ',' ident dims
-      ;
-list_expr : expr
-      | list_expr ',' expr
-      ;
-opt_sep :
-      | ':' ':'
-      ;
-after_type : dcl nodimsgiven
-                   {
-                      /* if the variable is a parameter we can suppose that is*/
-                      /*    value is the same on each grid. It is not useless */
-                      /*    to create a copy of it on each grid               */
-                      if ( couldaddvariable == 1 )
-                      {
-                      pos_end = setposcur();
-                      /*if (insubroutinedeclare == 0)
-                        {   */
-                         RemoveWordSET_0(fortranout,pos_cur_decl,
-                                                 pos_end-pos_cur_decl);
-                                         
-                       /* }
-                      else
-                       {*/
-                        ReWriteDeclarationAndAddTosubroutine_01($1);
-                        pos_cur_decl = setposcur();
-                        
-                       /*}*/
-                      if ( firstpass == 0 &&
-                           GlobalDeclaration == 0 &&
-                           insubroutinedeclare == 0 )
-                      {
-
-                         sprintf(ligne,"\n#include \"Module_Declar_%s.h\"\n"
-                                                                ,curmodulename);
-                         tofich(fortranout,ligne,1);
-                         sprintf (ligne, "Module_Declar_%s.h",curmodulename);
-                         module_declar = associate(ligne);
-                         sprintf (ligne, " ");
-                         tofich (module_declar, ligne,1);
-                         GlobalDeclaration = 1 ;
-                         pos_cur_decl = setposcur();
-
-                      }
-                         $$ = $1;
-                         Add_Globliste_1($1);
-                                                  
-                         if ( insubroutinedeclare == 0 )
-                                                  Add_GlobalParameter_Var_1($1);
-                         else
-                         {
-                            if ( pointerdeclare == 1 )
-                                                Add_Pointer_Var_From_List_1($1);
-                            Add_Parameter_Var_1($1);
-                         }
-
-                         /* if variables has been declared in a subroutine    */
-                         if ( insubroutinedeclare == 1 )
-                         { 
-                       /*    Add_SubroutineDeclaration_Var_1($1);*/
-                         }
-                         /* If there are a SAVE declarations in module's      */
-                         /*    subroutines we should remove it from the       */
-                         /*    subroutines declaration and add it in the      */
-                         /*    global declarations                            */
-                         if ( aftercontainsdeclare == 1 &&
-                              SaveDeclare == 1 && firstpass == 1 )
-                         {
-                              if ( inmodulemeet == 0 ) Add_Save_Var_dcl_1($1);
-                              else  Add_SubroutineDeclarationSave_Var_1($1);
-                         }
-                      }
-                      /*                                                      */
-                      PublicDeclare = 0;
-                      PrivateDeclare = 0;
-                      ExternalDeclare = 0;
-                      strcpy(NamePrecision,"");
-                      c_star = 0;
-                      strcpy(InitialValueGiven," ");
-                      strcpy(IntentSpec,"");
-                      VariableIsParameter =  0 ;
-                      Allocatabledeclare = 0 ;
-                      Targetdeclare = 0 ;
-                      SaveDeclare = 0;
-                      pointerdeclare = 0;
-                      optionaldeclare = 0 ;
-                      dimsgiven=0;
-                      c_selectorgiven=0;
-                      strcpy(nameinttypename,"");
-                      strcpy(c_selectorname,"");
-                      GlobalDeclarationType = 0; 
-                   }
-      | before_function name_routine arglist
-                   {
-                      /* open param file                                      */
-                      if ( firstpass == 0 )
-                      {
-                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$2);
-                         paramout=fopen(ligne,"w");
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                      }
-                      strcpy(subroutinename,$2);
-                      if ( inmodulemeet == 1 )
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1($3);
-                         Add_FunctionType_Var_1($2);
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      else
-                      {
-                         insubroutinedeclare = 1;
-                         /* we should to list of the subroutine argument the  */
-                         /*    name of the function which has to be defined   */
-                         Add_SubroutineArgument_Var_1($3);
-                         Add_FunctionType_Var_1($2);
-                         /* in the second step we should write the head of    */
-                         /*    the subroutine sub_loop_<subroutinename>       */
-                         writeheadnewsub_0(2);
-                      }
-                      strcpy(nameinttypename,"");
-
-                   }
-      ;
-before_function : TOK_FUNCTION
-                   {
-                       functiondeclarationisdone = 1;
-                   }
-                   ;
-
-before_parameter : TOK_PARAMETER
-                   {
-                      VariableIsParameter = 1;
-                      pos_curparameter = setposcur()-9;
-                   }
-before_data : TOK_DATA
-                   {
-                      pos_curdata = setposcur()-strlen($1);
-                      Init_List_Data_Var();
-                   }
-data : TOK_NAME TOK_SLASH datavallist TOK_SLASH
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-/*                      if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
-                      else */
-/*                      sprintf(ligne,"%s",$3);*/
-                      createstringfromlistname(ligne,$3);
-                      if (firstpass == 1)
-                      Add_Data_Var_1(&List_Data_Var,$1,ligne);
-                      else
-                      Add_Data_Var_1(&List_Data_Var_Cur,$1,ligne);
-                      }
-                   }
-      | data opt_comma TOK_NAME TOK_SLASH datavallist TOK_SLASH
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                      /*if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
-                      else */
-                      /*sprintf(ligne,"%s",$5);   */
-                      createstringfromlistname(ligne,$5);                      
-                      if (firstpass == 1)                      
-                      Add_Data_Var_1(&List_Data_Var,$3,ligne);
-                      else
-                      Add_Data_Var_1(&List_Data_Var_Cur,$3,ligne);                      
-                      }
-                   }
-      | datanamelist TOK_SLASH datavallist TOK_SLASH
-                   {
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       /*******************************************************/
-                       if (firstpass == 1)
-                       Add_Data_Var_Names_01(&List_Data_Var,$1,$3);
-                       else
-                       Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3);
-                   }
-      ;
-datavallist : expr_data
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         $$ = Insertname(NULL,$1,0);
-                      }
-                   }
-      | expr_data ',' datavallist
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         $$ = Insertname($3,$1,1);
-                      }
-                   }
-      ;
-
-save :  before_save varsave
-      | before_save  comblock varsave
-      | save opt_comma comblock opt_comma varsave
-      | save ',' varsave
-      ;
-before_save : TOK_SAVE
-                  {
-                     pos_cursave = setposcur()-4;
-                  }
-      ;
-varsave :
-      | TOK_NAME dims
-                  {
-                     if ( couldaddvariable == 1 ) Add_Save_Var_1($1,$2);
-                  }
-      ;
-datanamelist : TOK_NAME
-		{
-		$$=Insertname(NULL,$1,0);
-		}
-      | TOK_NAME '(' expr ')'
-      {
-      printf("INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n");
-      exit(0);
-      }
-      | datanamelist ',' datanamelist
-      {
-      $$ = concat_listname($1,$3);
-      }
-      ;
-expr_data : opt_signe simple_const
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      | expr_data '+' expr_data
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s+%s",$1,$3);}
-      | expr_data '-' expr_data
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s-%s",$1,$3);}
-      | expr_data '*' expr_data
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s*%s",$1,$3);}
-      | expr_data '/' expr_data
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s/%s",$1,$3);}
-      ;
-opt_signe :
-                   {if ( couldaddvariable == 1 ) strcpy($$,"");}
-      | signe
-                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-namelist :  namelist_action after_namelist
-      ;
-namelist_action : TOK_NAMELIST  ident
-      | TOK_NAMELIST  comblock ident
-      | namelist_action opt_comma comblock opt_comma ident
-      | namelist_action ',' ident
-      ;
-after_namelist :
-      ;
-interface : TOK_INTERFACE opt_name
-	{
-	ininterfacedeclare = 1 ;
-	printf("INTEFACE entree\n");
-	}
-      | TOK_ENDINTERFACE opt_name
-      {
-      ininterfacedeclare = 0;
-      }
-      ;
-before_dimension : TOK_DIMENSION
-                   {
-                      positioninblock=0;
-                      pos_curdimension = setposcur()-9;
-                   }
-
-dimension :  before_dimension opt_comma TOK_NAME dims lengspec
-      {
-         if ( couldaddvariable == 1 )
-         {
-            /*                                                                */
-            curvar=createvar($3,$4);
-            /*                                                                */
-            CreateAndFillin_Curvar("",curvar);
-            /*                                                                */
-            curlistvar=insertvar(NULL,curvar);
-            /*                                                                */
-            $$=settype("",curlistvar);
-            /*                                                                */
-            strcpy(vallengspec,"");
-         }
-      }
-      | dimension ',' TOK_NAME dims lengspec
-      {
-         if ( couldaddvariable == 1 )
-         {
-            /*                                                                */
-            curvar=createvar($3,$4);
-            /*                                                                */
-            CreateAndFillin_Curvar("",curvar);
-            /*                                                                */
-            curlistvar=insertvar($1,curvar);
-            /*                                                                */
-            $$=curlistvar;
-            /*                                                                */
-            strcpy(vallengspec,"");
-         }
-      }
-      ;
-private : TOK_PRIVATE '\n'
-      | TOK_PRIVATE opt_sep use_name_list
-      ;
-public : TOK_PUBLIC '\n'
-        {
-        $$=(listname *)NULL;
-        }
-      | TOK_PUBLIC opt_sep use_name_list
-         {
-          $$=$3;
-         }
-      ;
-use_name_list : TOK_NAME
-           {
-           $$ = Insertname(NULL,$1,0);
-           }
-      | use_name_list ',' TOK_NAME
-          {
-          $$ = Insertname($1,$3,0);
-          }
-      ;
-common : before_common var_common_list
-                   {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcommon,
-                                                  pos_end-pos_curcommon);
-                   }
-      | before_common comblock var_common_list
-                   {
-                         if ( couldaddvariable == 1 )
-                         {
-                            sprintf(charusemodule,"%s",$2);
-                            Add_NameOfCommon_1($2,subroutinename);
-                            pos_end = setposcur();
-                            RemoveWordSET_0(fortranout,pos_curcommon,
-                                                       pos_end-pos_curcommon);
-                         }
-                   }
-      | common opt_comma comblock opt_comma var_common_list
-                   {
-                         if ( couldaddvariable == 1 )
-                         {
-                            sprintf(charusemodule,"%s",$3);
-                            Add_NameOfCommon_1($3,subroutinename);
-                            pos_end = setposcur();
-                            RemoveWordSET_0(fortranout,pos_curcommon,
-                                                       pos_end-pos_curcommon);
-                         }
-                   }
-      ;
-before_common : TOK_COMMON
-                   {
-                      positioninblock=0;
-                      pos_curcommon = setposcur()-6;
-                   }
-      | TOK_GLOBAL TOK_COMMON
-                   {
-                      positioninblock=0;
-                      pos_curcommon = setposcur()-6-7;
-                   }
-      ;
-var_common_list : var_common
-                   {
-                      if ( couldaddvariable == 1 ) Add_Common_var_1();
-                   }
-
-     | var_common_list ',' var_common
-                   {
-                      if ( couldaddvariable == 1 ) Add_Common_var_1();
-                   }
-var_common : TOK_NAME dims
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         positioninblock = positioninblock + 1 ;
-                         strcpy(commonvar,$1);
-                         commondim = $2;
-                      }
-                   }
-      ;
-comblock : TOK_DSLASH
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy($$,"");
-                         positioninblock=0;
-                         strcpy(commonblockname,"");
-                      }
-                   }
-      | TOK_SLASH TOK_NAME TOK_SLASH
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         strcpy($$,$2);
-                         positioninblock=0;
-                         strcpy(commonblockname,$2);
-                      }
-                   }
-      ;
-opt_comma :
-      | ','
-      ;
-paramlist : paramitem
-                   {
-                      if ( couldaddvariable == 1 ) $$=insertvar(NULL,$1);
-                   }
-      | paramlist ',' paramitem
-                   {
-                      if ( couldaddvariable == 1 ) $$=insertvar($1,$3);
-                   }
-      ;
-paramitem : TOK_NAME '=' expr
-                   {
-                     if ( couldaddvariable == 1 )
-                     {
-                         curvar=(variable *) malloc(sizeof(variable));
-                         /*                                                   */
-                         Init_Variable(curvar);
-                         /*                                                   */
-                         curvar->v_VariableIsParameter=1;
-                         strcpy(curvar->v_nomvar,$1);
-                         Save_Length($1,4);
-                         strcpy(curvar->v_subroutinename,subroutinename);
-                         Save_Length(subroutinename,11);
-                         strcpy(curvar->v_modulename,curmodulename);
-                         Save_Length(curmodulename,6);
-                         strcpy(curvar->v_initialvalue,$3);
-                         Save_Length($3,14);
-                         strcpy(curvar->v_commoninfile,mainfile);
-                         Save_Length(mainfile,10);
-                         $$=curvar;
-                      }
-                   }
-      ;
-module_proc_stmt : TOK_PROCEDURE proc_name_list
-      ;
-proc_name_list : TOK_NAME
-      | proc_name_list ',' TOK_NAME
-      ;
-implicit : TOK_IMPLICIT TOK_NONE
-                    {
-                       if ( insubroutinedeclare == 1 )
-                       {
-                          Add_ImplicitNoneSubroutine_1();
-                          pos_end = setposcur();
-                          RemoveWordSET_0(fortranout,pos_end-13,
-                                                             13);
-                       }
-                    }
-      | TOK_IMPLICIT TOK_REAL8
-      ;
-opt_retour :
-      ;
-dcl : options opt_retour TOK_NAME dims lengspec initial_value
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         /*                                                   */
-                         if (dimsgiven == 1)
-                         {
-                            curvar=createvar($3,curdim);
-                            GlobalDeclarationType == 0;
-                         }
-                         else
-                         {
-                            curvar=createvar($3,$4);
-                         }
-                         /*                                                   */
-                         CreateAndFillin_Curvar(DeclType,curvar);
-                         /*                                                   */
-                         curlistvar=insertvar(NULL,curvar);
-                         if (!strcasecmp(DeclType,"character"))
-                         {
-                            if (c_selectorgiven == 1)
-                            {
-                               strcpy(c_selectordim.first,"1");
-                               strcpy(c_selectordim.last,c_selectorname);
-                               Save_Length(c_selectorname,1);
-                               change_dim_char
-                                     (insertdim(NULL,c_selectordim),curlistvar);
-                            }
-                         }
-                         $$=settype(DeclType,curlistvar);
-                      }
-                      strcpy(vallengspec,"");
-                   }
-      | dcl ',' opt_retour TOK_NAME dims lengspec initial_value
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         if (dimsgiven == 1)
-                         {
-                            curvar=createvar($4,curdim);
-                         }
-                         else
-                         {
-                            curvar=createvar($4,$5);
-                         }
-                         /*                                                   */
-                         CreateAndFillin_Curvar($1->var->v_typevar,curvar);
-                         /*                                                   */
-                         strcpy(curvar->v_typevar,($1->var->v_typevar));
-                         Save_Length($1->var->v_typevar,3);
-                         /*                                                   */
-                         curlistvar=insertvar($1,curvar);
-                         if (!strcasecmp(DeclType,"character"))
-                         {
-                            if (c_selectorgiven == 1)
-                            {
-                               strcpy(c_selectordim.first,"1");
-                               strcpy(c_selectordim.last,c_selectorname);
-                               Save_Length(c_selectorname,1);
-                               change_dim_char
-                                     (insertdim(NULL,c_selectordim),curlistvar);
-                            }
-                         }
-                         $$=curlistvar;
-                      }
-                      strcpy(vallengspec,"");
-                   }
-      ;
-nodimsgiven :       {dimsgiven=0;}
-      ;
-type : typespec selector
-                   {strcpy(DeclType,$1);}
-      | before_character c_selector
-                   {
-                      strcpy(DeclType,"CHARACTER");
-                   }
-      | typename '*' TOK_CSTINT
-                   {
-                      strcpy(DeclType,$1);
-                      strcpy(nameinttypename,$3);
-                   }
-      | before_typepar attribute ')'
-                   {
-                      strcpy(DeclType,"TYPE");
-                      GlobalDeclarationType = 1
-                   }
-      ;
-before_typepar : TOK_TYPEPAR
-                   {
-                 /*     if ( couldaddvariable == 1 ) VarTypepar = 1 ;
-                      couldaddvariable = 0 ;
-                      pos_cur_decl = setposcur()-5;*/
-                   pos_cur_decl = setposcur()-5;
-                   }
-      ;
-c_selector :
-      | '*' TOK_CSTINT
-                   {c_selectorgiven=1;strcpy(c_selectorname,$2);}
-      | '*' '(' c_attribute ')' {c_star = 1;}
-      | '(' c_attribute ')'
-      ;
-c_attribute : TOK_NAME clause opt_clause
-      | TOK_NAME '=' clause opt_clause
-      | clause opt_clause
-      ;
-before_character : TOK_CHARACTER
-                   {
-                      pos_cur_decl = setposcur()-9;
-                   }
-      ;
-typespec : typename {strcpy($$,$1);}
-      ;
-typename : TOK_INTEGER
-                   {
-                      strcpy($$,"INTEGER");
-                      pos_cur_decl = setposcur()-7;
-                   }
-      | TOK_REAL   {
-                      strcpy($$,"REAL");
-                      pos_cur_decl = setposcur()-4;
-                   }
-      | TOK_COMPLEX
-                   {strcpy($$,"COMPLEX");
-                   pos_cur_decl = setposcur()-7;}
-      | TOK_DOUBLEPRECISION
-                   {
-                      pos_cur_decl = setposcur()-16;
-                      strcpy($$,"REAL");
-                      strcpy(nameinttypename,"8");
-                   }
-      | TOK_DOUBLECOMPLEX
-                   {strcpy($$,"DOUBLE COMPLEX");}
-      | TOK_LOGICAL
-                   {
-                      strcpy($$,"LOGICAL");
-                      pos_cur_decl = setposcur()-7;
-                   }
-      ;
-lengspec :
-      | '*' proper_lengspec {strcpy(vallengspec,$2);}
-      ;
-proper_lengspec : expr {sprintf($$,"*%s",$1);}
-      | '(' '*' ')'{strcpy($$,"*(*)");}
-      ;
-selector :
-      | '*' proper_selector
-      | '(' attribute ')'
-      ;
-proper_selector : expr
-      | '(' '*' ')'
-      ;
-attribute : TOK_NAME clause
-      | TOK_NAME '=' clause
-                   {
-                      if ( strstr($3,"0.d0") )
-                      {
-                         strcpy(nameinttypename,"8");
-                         sprintf(NamePrecision,"");
-                      }
-                      else sprintf(NamePrecision,"%s = %s",$1,$3);
-                   }
-      | TOK_NAME
-                   {
-                      strcpy(NamePrecision,$1);
-                   }
-      | TOK_CSTINT
-                   {
-                      strcpy(NamePrecision,$1);
-                   }
-      ;
-clause : expr       {strcpy(CharacterSize,$1);
-                    strcpy($$,$1);}
-      | '*'        {strcpy(CharacterSize,"*");
-                    strcpy($$,"*");}
-      ;
-opt_clause :
-      | ',' TOK_NAME clause
-      ;
-options :
-      | ':' ':'
-      | ',' attr_spec_list ':' ':'
-      ;
-attr_spec_list : attr_spec
-      | attr_spec_list ',' attr_spec
-      ;
-attr_spec : TOK_PARAMETER
-                   {
-                      VariableIsParameter = 1;
-                   }
-      | access_spec
-      | TOK_ALLOCATABLE
-                   {Allocatabledeclare = 1;}
-      | TOK_DIMENSION dims
-                   {
-                      dimsgiven=1;
-                      curdim=$2;
-                   }
-      | TOK_EXTERNAL
-                   {ExternalDeclare = 1;}
-      | TOK_INTENT '(' intent_spec ')'
-                   {strcpy(IntentSpec,$3);}
-      | TOK_INTRINSIC
-      | TOK_OPTIONAL{optionaldeclare = 1 ;}
-      | TOK_POINTER {pointerdeclare = 1 ;}
-      | TOK_SAVE    {
-/*                       if ( inmodulemeet == 1 )
-                       {*/
-                          SaveDeclare = 1 ;
-                     /*  }*/
-                    }
-      | TOK_TARGET
-      				{Targetdeclare = 1;}
-      ;
-intent_spec : TOK_IN {strcpy($$,$1);}
-      | TOK_OUT     {strcpy($$,$1);}
-      | TOK_INOUT   {strcpy($$,$1); }
-      ;
-access_spec : TOK_PUBLIC
-                   {PublicDeclare = 1;}
-      | TOK_PRIVATE
-                   {PrivateDeclare = 1;}
-      ;
-dims :              {if ( created_dimensionlist == 1 )
-                       {
-                           $$=(listdim *)NULL;
-                       }
-                   }
-      | '(' dimlist ')'
-                   {if ( created_dimensionlist == 1 ||
-                         agrif_parentcall      == 1 ) $$=$2;}
-      ;
-dimlist :   dim     {if ( created_dimensionlist == 1 ||
-                         agrif_parentcall      == 1 ) $$=insertdim(NULL,$1);}
-      | dimlist ',' dim
-                   {if ( couldaddvariable == 1 )
-                         if ( created_dimensionlist == 1 ) $$=insertdim($1,$3);}
-      ;
-dim : ubound         {
-                      strcpy($$.first,"1");
-                      strcpy($$.last,$1);
-                      Save_Length($1,1);
-                   }
-      | ':'        {
-                      strcpy($$.first,"");
-                      strcpy($$.last,"");
-                   }
-      | expr ':'   {
-                      strcpy($$.first,$1);
-                      Save_Length($1,2);
-                      strcpy($$.last,"");
-                   }
-      | ':' expr   {
-                      strcpy($$.first,"");
-                      strcpy($$.last,$2);
-                      Save_Length($2,1);
-                   }
-      | expr ':' ubound
-                   {
-                      strcpy($$.first,$1);
-                      Save_Length($1,2);
-                      strcpy($$.last,$3);
-                      Save_Length($3,1);
-                   }
-      ;
-ubound :  '*'       {strcpy($$,"*");}
-      | expr       {strcpy($$,$1);}
-      ;
-expr :  uexpr       {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | '(' expr ')'
-                   {if ( couldaddvariable == 1 ) sprintf($$,"(%s)",$2);}
-      | complex_const
-                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | predefinedfunction
-                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-
-predefinedfunction : TOK_SUM minmaxlist ')'
-                   {sprintf($$,"SUM(%s)",$2);}
-      | TOK_MAX minmaxlist ')'
-                   {sprintf($$,"MAX(%s)",$2);}
-      | TOK_TANH '(' minmaxlist ')'
-                   {sprintf($$,"TANH(%s)",$3);}
-      | TOK_MAXVAL '(' minmaxlist ')'
-                   {sprintf($$,"MAXVAL(%s)",$3);}
-      | TOK_MIN minmaxlist ')'
-                   {sprintf($$,"MIN(%s)",$2);}
-      | TOK_MINVAL '(' minmaxlist ')'
-                   {sprintf($$,"MINVAL(%s)",$3);}
-      | TOK_TRIM '(' expr ')'
-                   {sprintf($$,"TRIM(%s)",$3);}
-      | TOK_SQRT expr ')'
-                   {sprintf($$,"SQRT(%s)",$2);}
-      | TOK_REAL '(' minmaxlist ')'
-                   {sprintf($$,"REAL(%s)",$3);}
-      | TOK_NINT '(' expr ')'
-                   {sprintf($$,"NINT(%s)",$3);}
-      | TOK_FLOAT '(' expr ')'
-                   {sprintf($$,"FLOAT(%s)",$3);}
-      | TOK_EXP '(' expr ')'
-                   {sprintf($$,"EXP(%s)",$3);}
-      | TOK_COS '(' expr ')'
-                   {sprintf($$,"COS(%s)",$3);}
-      | TOK_COSH '(' expr ')'
-                   {sprintf($$,"COSH(%s)",$3);}
-      | TOK_ACOS '(' expr ')'
-                   {sprintf($$,"ACOS(%s)",$3);}
-      | TOK_SIN '(' expr ')'
-                   {sprintf($$,"SIN(%s)",$3);}
-      | TOK_SINH '(' expr ')'
-                   {sprintf($$,"SINH(%s)",$3);}
-      | TOK_ASIN '(' expr ')'
-                   {sprintf($$,"ASIN(%s)",$3);}
-      | TOK_LOG '(' expr ')'
-                   {sprintf($$,"LOG(%s)",$3);}
-      | TOK_TAN '(' expr ')'
-                   {sprintf($$,"TAN(%s)",$3);}
-      | TOK_ATAN '(' expr ')'
-                   {sprintf($$,"ATAN(%s)",$3);}
-      | TOK_ABS expr ')'
-                   {sprintf($$,"ABS(%s)",$2);}
-      | TOK_MOD '(' minmaxlist ')'
-                   {sprintf($$,"MOD(%s)",$3);}
-      | TOK_SIGN '(' minmaxlist ')'
-                   {sprintf($$,"SIGN(%s)",$3);}
-      | TOK_MINLOC '(' minmaxlist ')'
-                   {sprintf($$,"MINLOC(%s)",$3);}
-      | TOK_MAXLOC '(' minmaxlist ')'
-                   {sprintf($$,"MAXLOC(%s)",$3);}
-      ;
-minmaxlist : expr {strcpy($$,$1);}
-      | minmaxlist ',' expr
-                   {if ( couldaddvariable == 1 )
-                   { strcpy($$,$1);strcat($$,",");strcat($$,$3);}}
-      ;
-uexpr :  lhs        {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | simple_const
-                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | vec
-                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | expr operation
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      | signe expr %prec '*' 
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      | TOK_NOT expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      ;
-signe : '+'        {if ( couldaddvariable == 1 ) strcpy($$,"+");}
-      | '-'        {if ( couldaddvariable == 1 ) strcpy($$,"-");}
-      ;
-operation : '+' expr %prec '+'
-                   {if ( couldaddvariable == 1 ) sprintf($$,"+%s",$2);}
-      |  '-' expr %prec '+'
-                   {if ( couldaddvariable == 1 ) sprintf($$,"-%s",$2);}
-      |  '*' expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"*%s",$2);}
-      |  TOK_DASTER expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  TOK_EQ expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  TOK_EQV expr %prec TOK_EQV
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}                   
-      |  TOK_GT expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  '>' expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$," > %s",$2);}
-      |  TOK_LT expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  '<' expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$," < %s",$2);}
-      |  TOK_GE expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  '>''=' expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$," >= %s",$3);}
-      |  TOK_LE expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  '<''=' expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$," <= %s",$3);}
-      |  TOK_NE expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  TOK_NEQV expr %prec TOK_EQV
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}                   
-      |  TOK_XOR expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  TOK_OR expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  TOK_AND expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      |  TOK_SLASH after_slash
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s",$2);}
-      |  '=' after_equal
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s",$2);}
-
-after_slash : {strcpy($$,"");}
-      | expr
-                   {sprintf($$,"/%s",$1);}
-      | '=' expr %prec TOK_EQ
-                   {sprintf($$,"/= %s",$2);}
-      | TOK_SLASH expr
-                   {sprintf($$,"//%s",$2);}
-      ;
-after_equal : '=' expr %prec TOK_EQ
-                   {if ( couldaddvariable == 1 ) sprintf($$,"==%s",$2);}
-      | expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"= %s",$1);}
-      ;
-
-lhs : ident         {if ( couldaddvariable == 1 )
-						{
-						printf("ident = %s\n",$1);
-						strcpy($$,$1);}
-						}
-      | structure_component
-                   {if ( couldaddvariable == 1 ) {
-                   printf("struct = %s\n",$1);
-                   strcpy($$,$1);}
-                   }
-      | array_ele_substring_func_ref
-                   {if ( couldaddvariable == 1 ) {
-                   printf("arrayref = %s\n",$1);
-                   strcpy($$,$1);
-                   }}
-      ;
-beforefunctionuse : {
-                      agrif_parentcall =0;
-                      if (!strcasecmp(identcopy,"Agrif_Parent") )
-                                                            agrif_parentcall =1;
-                      if ( Agrif_in_Tok_NAME(identcopy) == 1 )
-                      {
-                         inagrifcallargument = 1;
-                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                      }
-                   }
-      ;
-array_ele_substring_func_ref : begin_array
-                   {
-                     strcpy($$,$1);
-                     if ( incalldeclare == 0 ) inagrifcallargument = 0;
-                   }
-      | begin_array substring
-                   {if ( couldaddvariable == 1 ) sprintf($$," %s %s ",$1,$2);}
-      | structure_component '(' funarglist ')'
-                   {if ( couldaddvariable == 1 )
-                                                sprintf($$," %s ( %s )",$1,$3);}
-      | structure_component '(' funarglist ')' substring
-                   {if ( couldaddvariable == 1 )
-                                         sprintf($$," %s ( %s ) %s ",$1,$3,$5);}
-      ;
-begin_array : ident '(' funarglist ')'
-                   {
-                      if ( couldaddvariable == 1 )
-                      {
-                         sprintf($$," %s ( %s )",$1,$3);
-                         ModifyTheAgrifFunction_0($3);
-                         agrif_parentcall =0;
-                      }
-                   }
-      ;
-structure_component : lhs '%' lhs
-                   {
-                      sprintf($$," %s %% %s ",$1,$3);
-                      if ( incalldeclare == 0 ) inagrifcallargument = 0;
-                   }
-      ;
-vec :  TOK_LEFTAB outlist TOK_RIGHTAB
-                   {sprintf($$,"(/%s/)",$2);}
-      ;
-funarglist : beforefunctionuse    {strcpy($$," ");}
-      | beforefunctionuse funargs
-                   {strcpy($$,$2);}
-      ;
-funargs : funarg     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | funargs ',' funarg
-                    {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      ;
-funarg : expr       {strcpy($$,$1);}
-      | triplet    {strcpy($$,$1);}
-      ;
-triplet : expr ':' expr
-                    {if ( couldaddvariable == 1 ) sprintf($$,"%s :%s",$1,$3);}
-      | expr ':' expr ':' expr
-                    {if ( couldaddvariable == 1 )
-                                               sprintf($$,"%s :%s :%s",$1,$3,$5);}
-      | ':' expr ':' expr
-                    {if ( couldaddvariable == 1 ) sprintf($$,":%s :%s",$2,$4);}
-      | ':' ':' expr{if ( couldaddvariable == 1 ) sprintf($$,": : %s",$3);}
-      | ':' expr    {if ( couldaddvariable == 1 ) sprintf($$,":%s",$2);}
-      | expr ':'    {if ( couldaddvariable == 1 ) sprintf($$,"%s :",$1);}
-      | ':'         {if ( couldaddvariable == 1 ) sprintf($$,":");}
-      ;
-ident : TOK_NAME    {
-                       if ( couldaddvariable == 1 && afterpercent == 0)
-                       {
-                       if ( Vartonumber($1) == 1 )
-                       {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                       if (!strcasecmp($1,"Agrif_Parent") )
-                                                            agrif_parentcall =1;
-                       if ( VariableIsNotFunction($1) == 0 )
-                       {
-                       printf("var = %s\n",$1);
-                          if ( inagrifcallargument == 1 )
-                          {
-                             if ( !strcasecmp($1,identcopy) )
-                             {
-                                strcpy(sameagrifname,identcopy);
-                                sameagrifargument = 1;
-                             }
-                          }
-                          strcpy(identcopy,$1);
-                          pointedvar=0;
-                          strcpy(truename,$1);
-                          if (variscoupled_0($1)) strcpy(truename,getcoupledname_0($1));
-
-                          if ( VarIsNonGridDepend(truename) == 0 &&
-                               Variableshouldberemove(truename) == 0 )
-                          {                      
-                             if ( inagrifcallargument == 1 ||
-                                  varispointer_0(truename) == 1 )
-                             {
-                             printf("var2 = %s\n",$1);
-                            if ((IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1))
-                             {
-                              if (varistyped_0(truename) == 0)
-                                 {
-                                 ModifyTheVariableName_0(truename,strlen($1));
-                                 }
-                                 }
-                             }
-                             printf("ici3\n");
-                             if ( inagrifcallargument != 1 ||
-                                  sameagrifargument ==1 )
-                                  {
-                                  printf("ici5 %s\n",truename);
-                                  Add_UsedInSubroutine_Var_1(truename);
-                          }
-                          }
-                          NotifyAgrifFunction_0(truename);
-                       }
-                       }
-                       else
-                       {
-                       afterpercent = 0;
-                    }
-                    }
-      ;
-simple_const : TOK_TRUE
-                     {if ( couldaddvariable == 1 ) strcpy($$,".TRUE.");}
-      | TOK_FALSE    {if ( couldaddvariable == 1 ) strcpy($$,".FALSE.");}
-      | TOK_CSTINT   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | TOK_CSTREAL  {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | TOK_CSTREALDP{if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | TOK_CSTREALQP{if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | simple_const TOK_NAME
-                     {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
-      | string_constant opt_substring
-      ;
-string_constant : TOK_CHAR_CONSTANT
-                     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | string_constant TOK_CHAR_CONSTANT
-      | TOK_CHAR_MESSAGE
-                     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | TOK_CHAR_CUT
-                     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-opt_substring :      {if ( couldaddvariable == 1 ) strcpy($$," ");}
-      | substring   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-substring : '(' optexpr ':' optexpr ')'
-                    {if ( couldaddvariable == 1 ) sprintf($$,"(%s :%s)",$2,$4);}
-      ;
-optexpr :           {if ( couldaddvariable == 1 ) strcpy($$," ");}
-      | expr        {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-opt_expr : '\n'          {if ( couldaddvariable == 1 ) strcpy($$," ");}
-      | expr        {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-initial_value :      {   strcpy(InitialValueGiven," ");}
-      | before_initial '=' expr
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                          strcpy(InitValue,$3);
-                          strcpy(InitialValueGiven,"=");
-                       }
-                    }
-      | before_initial TOK_POINT_TO expr
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                          strcpy(InitValue,$3);
-                          strcpy(InitialValueGiven,"=>");
-                       }
-                    }
-      ;
-before_initial : {pos_curinit = setposcur();}
-      ;
-complex_const : '(' uexpr ',' uexpr ')'
-                    {sprintf($$,"(%s,%s)",$2,$4);}
-      ;
-use_stat : word_use  module_name
-                    {
-                      if ( couldaddvariable == 1 )
-                      {
-                      /* if variables has been declared in a subroutine       */
-                      if (insubroutinedeclare == 1)
-                      {
-                         copyuse_0($2);
-                      }
-                      sprintf(charusemodule,"%s",$2);
-                      Add_NameOfModuleUsed_1($2);
-
-                      if ( inmoduledeclare == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curuse,
-                                               pos_end-pos_curuse);
-                      }
-                      }
-                    }
-      | word_use  module_name ',' rename_list
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                      if (insubroutinedeclare == 1)
-                      {
-                         Add_CouplePointed_Var_1($2,$4);
-                      }
-                      if ( firstpass == 1 )
-                      {
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            coupletmp = $4;
-                            strcpy(ligne,"");
-                            while ( coupletmp )
-                            {
-                               strcat(ligne,coupletmp->c_namevar);
-                               strcat(ligne," => ");
-                               strcat(ligne,coupletmp->c_namepointedvar);
-                               coupletmp = coupletmp->suiv;
-                               if ( coupletmp ) strcat(ligne,",");
-                            }
-                            sprintf(charusemodule,"%s",$2);
-                         }
-                         Add_NameOfModuleUsed_1($2);
-                      }
-                      if ( inmoduledeclare == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curuse,
-                                               pos_end-pos_curuse);
-                      }
-                      }
-                    }
-      | word_use  module_name ',' TOK_ONLY ':' '\n'
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                      /* if variables has been declared in a subroutine       */
-                      if (insubroutinedeclare == 1)
-                      {
-                         copyuseonly_0($2);
-                      }
-                      sprintf(charusemodule,"%s",$2);
-                      Add_NameOfModuleUsed_1($2);
-
-                       if ( inmoduledeclare == 0 )
-                       {
-                          pos_end = setposcur();
-                          RemoveWordSET_0(fortranout,pos_curuse,
-                                                pos_end-pos_curuse);
-                       }
-                       }
-                    }
-      | word_use  module_name ',' TOK_ONLY ':' only_list
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       /* if variables has been declared in a subroutine      */
-                       if (insubroutinedeclare == 1)
-                       {
-                          Add_CouplePointed_Var_1($2,$6);
-                       }
-                       if ( firstpass == 1 )
-                       {
-                         if ( insubroutinedeclare == 1 )
-                         {
-                             coupletmp = $6;
-                             strcpy(ligne,"");
-                             while ( coupletmp )
-                             {
-                                strcat(ligne,coupletmp->c_namevar);
-                               if ( strcasecmp(coupletmp->c_namepointedvar,"") )
-                                                           strcat(ligne," => ");
-                                strcat(ligne,coupletmp->c_namepointedvar);
-                                coupletmp = coupletmp->suiv;
-                                if ( coupletmp ) strcat(ligne,",");
-                             }
-                             sprintf(charusemodule,"%s",$2);
-                          }
-                          Add_NameOfModuleUsed_1($2);
-                       }
-                       if ( firstpass == 0 )
-                       {
-                          if ( inmoduledeclare == 0 )
-                          {
-
-                            pos_end = setposcur();
-                             RemoveWordSET_0(fortranout,pos_curuse,
-                                                   pos_end-pos_curuse);
-                       if (oldfortranout) 
-                         variableisglobalinmodule($6,$2,oldfortranout,pos_curuseold);
-                        
-                          }
-                          else
-                          {
-
-                             /* if we are in the module declare and if the    */
-                             /* onlylist is a list of global variable         */
-                             variableisglobalinmodule($6, $2, fortranout,pos_curuse);
-                          }
-                       }
-                       }
-                    }
-      ;
-word_use : TOK_USE
-                   {
-                      pos_curuse = setposcur()-strlen($1);
-                     if (firstpass == 0 && oldfortranout) {
-                     pos_curuseold = setposcurname(oldfortranout);
-                     }
-                   }
-      ;
-module_name : TOK_NAME
-                    {strcpy($$,$1);}
-      ;
-rename_list : rename_name
-                    {
-                       if ( couldaddvariable == 1 ) $$ = $1;
-                    }
-      | rename_list ',' rename_name
-                    {
-                        if ( couldaddvariable == 1 )
-                        {
-                        /* insert the variable in the list $1                 */
-                        $3->suiv = $1;
-                        $$ = $3;
-                        }
-                    }
-      ;
-rename_name : TOK_NAME TOK_POINT_TO TOK_NAME
-                    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,$1);
-                       Save_Length($1,21);
-                       strcpy(coupletmp->c_namepointedvar,$3);
-                       Save_Length($3,22);
-                       coupletmp->suiv = NULL;
-                       $$ = coupletmp;
-                     }
-      ;
-only_list : only_name
-                    {
-                       if ( couldaddvariable == 1 ) $$ = $1;
-                    }
-      | only_list ',' only_name
-                    {
-                        if ( couldaddvariable == 1 )
-                        {
-                        /* insert the variable in the list $1                 */
-                        $3->suiv = $1;
-                        $$ = $3;
-                        }
-                    }
-      ;
-only_name : TOK_NAME TOK_POINT_TO TOK_NAME
-                    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,$1);
-                       Save_Length($1,21);
-                       strcpy(coupletmp->c_namepointedvar,$3);
-                       Save_Length($3,22);
-                       coupletmp->suiv = NULL;
-                       $$ = coupletmp;
-                       pointedvar=1;
-                       Add_UsedInSubroutine_Var_1($1);
-                    }
-      | TOK_NAME    {
-                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
-                       strcpy(coupletmp->c_namevar,$1);
-                       Save_Length($1,21);
-                       strcpy(coupletmp->c_namepointedvar,"");
-                       coupletmp->suiv = NULL;
-                       $$ = coupletmp;
-                     }
-      ;
-exec : iffable
-      | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'
-                     {
-                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     }
-      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'
-                     {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                         curmodulename);
-                                                         inallocate = 0;
-                     }
-      | TOK_NULLIFY '(' pointer_name_list ')'
-      | word_endunit /* end                                                   */
-                    {
-                       GlobalDeclaration = 0 ;
-                       if ( firstpass == 0 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                          if ( module_declar && insubroutinedeclare == 0 )
-                          {
-                              fclose(module_declar);
-                          }
-                       }
-                       if ( couldaddvariable == 1 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                       if ( inmodulemeet == 1 )
-                       {
-                         /* we are in a module                                */
-                         if ( insubroutinedeclare == 1 )
-                         {
-                            /* it is like an end subroutine <name>            */
-                            insubroutinedeclare = 0 ;
-                            /*                                                */
-                            pos_cur = setposcur();
-                            closeandcallsubloopandincludeit_0(1);
-                            functiondeclarationisdone = 0;
-                         }
-                         else
-                         {
-                            /* it is like an end module <name>                */
-                            inmoduledeclare = 0 ;
-                            inmodulemeet = 0 ;
-                         }
-                       }
-                       else
-                       {
-                          insubroutinedeclare = 0;
-                          /*                                                  */
-                          pos_cur = setposcur();                        
-                          closeandcallsubloopandincludeit_0(2);
-                            functiondeclarationisdone = 0;
-                          if ( firstpass == 0 )
-                          {
-                             if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                             else fprintf(paramout,"C\n");
-                             fclose(paramout);
-                           }
-                        }
-                      }
-                      strcpy(subroutinename,"");
-                    }
-      | word_endprogram opt_name
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();                      
-                       closeandcallsubloopandincludeit_0(3);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    }
-      | word_endsubroutine opt_name
-                    {
-                       if ( couldaddvariable == 1 &&
-                            strcasecmp(subroutinename,"") )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();
-                                             
-                       closeandcallsubloopandincludeit_0(1);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    }
-      | word_endfunction opt_name
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       insubroutinedeclare = 0;
-                       /*                                                     */
-                       pos_cur = setposcur();
-
-                       closeandcallsubloopandincludeit_0(0);
-                            functiondeclarationisdone = 0;
-                      if ( firstpass == 0 )
-                      {
-                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                         else fprintf(paramout,"C\n");
-                         fclose(paramout);
-                      }
-                      strcpy(subroutinename,"");
-                      }
-                    }
-      | TOK_ENDMODULE opt_name
-                    {
-                       if ( couldaddvariable == 1 )
-                       {
-                       /* if we never meet the contains keyword               */
-                      Remove_Word_end_module_0(strlen($2));
-                       if ( inmoduledeclare == 1 )
-                       {
-                          if ( aftercontainsdeclare == 0 )
-                          {
-                             Write_GlobalParameter_Declaration_0();
-                             Write_NotGridDepend_Declaration_0();
-                             Write_GlobalType_Declaration_0();
-                             if ( module_declar_type )
-                             {
-                             strcpy (ligne, "\n#include \"Module_DeclarType_");
-                             strcat (ligne, curmodulename);
-                             strcat (ligne, ".h\"\n");
-                             tofich(fortranout,ligne,1); 
-                             }
-                             Write_Alloc_Subroutine_For_End_0();
-                          }
-                       }
-                                           
-                       inmoduledeclare = 0 ;
-                       inmodulemeet = 0 ;
-
-                      Write_Word_end_module_0();
-                      strcpy(curmodulename,"");
-                      aftercontainsdeclare = 1;
-                      if ( firstpass == 0 )
-                      {
-                         if ( module_declar && insubroutinedeclare == 0)
-                         {
-                           fclose(module_declar);
-                         }
-                         if ( module_declar_type && insubroutinedeclare == 0)
-                         {
-                          fclose(module_declar_type);
-                          module_declar_type = 0;
-                         }
-                      }
-                      GlobalDeclaration = 0 ;
-                      }
-                  }
-      | boucledo
-      | logif iffable
-      | TOK_WHERE '(' expr ')' opt_expr
-      | TOK_ELSEWHERE
-      | TOK_ENDWHERE
-      | logif TOK_THEN
-      | TOK_ELSEIF  '(' expr ')' TOK_THEN
-      | TOK_ELSE
-      | TOK_ENDIF opt_name
-      | TOK_CASE caselist ')'
-      | TOK_SELECTCASE '(' expr ')'
-      | TOK_CASEDEFAULT
-      | TOK_ENDSELECT
-      | TOK_CONTAINS
-                   {
-                      if (inmoduledeclare == 1 )
-                      {
-                         Remove_Word_Contains_0();
-                         Write_GlobalParameter_Declaration_0();
-                         Write_GlobalType_Declaration_0();
-                             if ( module_declar_type)
-                             {                         
-                             strcpy (ligne, "\n#include \"Module_DeclarType_");
-                             strcat (ligne, curmodulename);
-                             strcat (ligne, ".h\"\n");
-                             tofich(fortranout,ligne,1); 
-                             }
-                         Write_NotGridDepend_Declaration_0();
-                         Write_Alloc_Subroutine_0();
-                         inmoduledeclare = 0 ;
-                         aftercontainsdeclare = 1;
-                      }
-                      else
-                      {
-                      incontainssubroutine = 1;
-                      strcpy(previoussubroutinename,subroutinename);
-                       if ( couldaddvariable == 1 )
-                       {
-                          if ( firstpass == 1 ) List_ContainsSubroutine =
-                                                Addtolistnom(subroutinename,
-                                                     List_ContainsSubroutine,0);
-                          insubroutinedeclare = 0;
-                          /*                                                  */
-
-                          closeandcallsubloop_contains_0();
-                            functiondeclarationisdone = 0;
-                         if ( firstpass == 0 )
-                         {
-                            if ( retour77 == 0 ) fprintf(paramout,"!\n");
-                            else fprintf(paramout,"C\n");
-                            fclose(paramout);
-                         }
-                         }
-                         strcpy(subroutinename,"");
-                      }
-                   }
-      ;
-word_endsubroutine : TOK_ENDSUBROUTINE
-                    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy($$,$1);
-                       pos_endsubroutine = setposcur()-strlen($1);
-                       functiondeclarationisdone = 0;
-                       }
-                    }
-      ;
-word_endunit : TOK_ENDUNIT
-                    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy($$,$1);
-                       pos_endsubroutine = setposcur()-strlen($1);
-                       }
-                    }
-      ;
-word_endprogram :  TOK_ENDPROGRAM
-                    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy($$,$1);
-                       pos_endsubroutine = setposcur()-strlen($1);
-                       }
-                    }
-      ;
-word_endfunction : TOK_ENDFUNCTION
-                    {
-                      if ( couldaddvariable == 1 )
-                      {
-                       strcpy($$,$1);
-                       pos_endsubroutine = setposcur()-strlen($1);
-                       }
-                    }
-      ;
-caselist : expr
-      | caselist ',' expr
-      | caselist ':' expr
-      ;
-boucledo : worddo opt_int do_arg
-      | wordwhile expr
-      | TOK_ENDDO optname
-      ;
-do_arg :
-      | do_var '=' expr ',' expr
-      | do_var '=' expr ',' expr ',' expr
-opt_int :
-      | TOK_CSTINT opt_comma
-      ;
-opt_name : '\n'  {strcpy($$,"");}
-      | TOK_NAME {strcpy($$,$1);}
-      ;
-optname :
-      | TOK_NAME
-      ;
-worddo :  TOK_PLAINDO
-      ;
-wordwhile :TOK_DOWHILE
-      ;
-
-dotarget :
-      | TOK_CSTINT
-      ;
-
-iffable : TOK_CONTINUE
-      | ident_dims after_ident_dims
-      | goto
-      | io
-      | call
-      | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'
-                     {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     }
-      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'
-                     {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                                                        inallocate = 0;
-                     }
-      | TOK_EXIT optexpr
-      | TOK_RETURN opt_expr
-      | TOK_CYCLE opt_expr
-      | stop opt_expr
-      | int_list
-      ;
-before_dims : {if ( couldaddvariable == 1 ) created_dimensionlist = 0;}
-ident_dims : ident before_dims dims dims
-              {
-                  created_dimensionlist = 1;
-                  if  ( agrif_parentcall == 1 )
-                  {
-                      ModifyTheAgrifFunction_0($3->dim.last);
-                      agrif_parentcall =0;
-                      fprintf(fortranout," = ");
-                  }
-              }
-      | ident_dims '%' ident before_dims dims dims
-      {created_dimensionlist = 1;}
-int_list : TOK_CSTINT
-      | int_list ',' TOK_CSTINT
-      ;
-after_ident_dims : '=' expr
-      | TOK_POINT_TO expr
-      ;
-call : keywordcall opt_call
-                   {
-                      inagrifcallargument = 0 ;
-                      incalldeclare=0;
-                      if ( oldfortranout &&
-                           !strcasecmp(meetagrifinitgrids,subroutinename) &&
-                           firstpass == 0 &&
-                           callmpiinit == 1)
-                      {
-                      /*   pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcall,
-                                               pos_end-pos_curcall);
-                         fprintf(oldfortranout,"      Call MPI_Init (%s) \n"
-                                                                   ,mpiinitvar);*/
-                      }
-                      if ( oldfortranout           &&
-                           callagrifinitgrids == 1 &&
-                           firstpass == 0 )
-                      {
-                         pos_end = setposcur();
-                         RemoveWordSET_0(fortranout,pos_curcall,
-                                               pos_end-pos_curcall);
-
-                         strcpy(subofagrifinitgrids,subroutinename);
-                      }
-                      Instanciation_0(sameagrifname);
-                   }
-      ;
-opt_call :
-      | '(' opt_callarglist  ')'
-      ;
-opt_callarglist :
-      | callarglist
-      ;
-keywordcall : before_call TOK_NAME
-                    {
-                       if (!strcasecmp($2,"MPI_Init") )
-                       {
-                          callmpiinit = 1;
-                       }
-                       else
-                       {
-                          callmpiinit = 0;
-                       }
-                       if (!strcasecmp($2,"Agrif_Init_Grids") )
-                       {
-                          callagrifinitgrids = 1;
-                          strcpy(meetagrifinitgrids,subroutinename);
-                       }
-                       else callagrifinitgrids = 0;
-                       if ( !strcasecmp($2,"Agrif_Open_File") )
-                       {
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                       if ( Vartonumber($2) == 1 )
-                       {
-                          incalldeclare=1;
-                          inagrifcallargument = 1 ;
-                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
-                                                        curmodulename);
-                       }
-                    }
-      ;
-before_call : TOK_CALL
-                    {pos_curcall=setposcur()-4;}
-callarglist :  callarg
-      | callarglist ',' callarg
-      ;
-
-callarg :  expr {
-                  if ( callmpiinit == 1 )
-                  {
-                     strcpy(mpiinitvar,$1);
-                     if ( firstpass == 1 )
-                     {
-                        Add_UsedInSubroutine_Var_1 (mpiinitvar);
-/*                        curvar=createvar($1,NULL);
-                        curlistvar=insertvar(NULL,curvar);
-                        List_Subr outineArgument_Var = AddListvarToListvar
-                         (curlistvar,List_SubroutineAr gument_Var,1);*/
-                     }
-                  }
-               }
-      | '*' label
-      ;
-
-stop : TOK_PAUSE
-      | TOK_STOP
-      ;
-
-io : iofctl ioctl
-      | read option_read
-      | write ioctl
-      | write ioctl outlist
-      | TOK_REWIND after_rewind
-      | TOK_FORMAT
-      ;
-opt_CHAR_INT :
-      | TOK_CSTINT TOK_NAME
-      ;
-idfile : '*'
-      | TOK_CSTINT
-      | ident
-      ;
-option_print :
-      | ',' outlist
-      ;
-option_inlist :
-      | inlist
-      ;
-option_read : ioctl option_inlist
-      | infmt opt_inlist
-      ;
-opt_outlist :
-      | outlist
-      ;
-opt_inlist :
-      | ',' inlist
-      ;
-ioctl :  '(' ctllist ')'
-      | '(' fexpr ')'
-      ;
-after_rewind :  '(' ident ')'
-      | '(' TOK_CSTINT ')'
-      | TOK_CSTINT
-      | '(' uexpr ')'
-      | TOK_NAME
-      ;
-ctllist : ioclause
-      | ctllist ',' ioclause
-      ;
-ioclause : fexpr
-      | '*'
-      | TOK_DASTER
-      | ident expr dims      
-      | ident expr
-      | ident expr '%' ident_dims
-      | ident '(' triplet ')'
-      | ident '*'
-      | ident TOK_DASTER
-      ;
-iofctl : TOK_OPEN
-      | TOK_CLOSE
-      ;
-infmt :  unpar_fexpr
-      | '*'
-      ;
-
-read :TOK_READ
-      | TOK_INQUIRE
-      | TOK_PRINT
-      ;
-
-write : TOK_WRITE
-      ;
-
-fexpr : unpar_fexpr
-      | '(' fexpr ')'
-      ;
-unpar_fexpr : lhs
-      | simple_const
-      | fexpr addop fexpr %prec '+'
-      | fexpr '*' fexpr
-      | fexpr TOK_SLASH fexpr
-      | fexpr TOK_DASTER fexpr
-      | addop fexpr %prec '*'
-      | fexpr TOK_DSLASH fexpr
-      | TOK_FILE expr
-      | TOK_EXIST expr
-      | TOK_ERR expr
-      | TOK_END expr
-      | TOK_NAME '=' expr
-      | predefinedfunction
-      ;
-addop : '+'
-      | '-'
-      ;
-inlist : inelt
-      | inlist ',' inelt
-      ;
-opt_lhs :
-      | lhs
-      ;
-inelt : opt_lhs opt_operation
-      | '(' inlist ')' opt_operation
-      | predefinedfunction opt_operation
-      | simple_const opt_operation
-      | '(' inlist ',' dospec ')'
-      ;
-opt_operation :
-      | operation
-      | opt_operation operation
-      ;
-outlist : uexpr    {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | other      {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | out2       {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-out2: uexpr ',' expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      | uexpr ',' other
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      | other ',' expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      | other ',' other
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      | out2 ',' expr
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      | out2 ',' other
-                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
-      | uexpr     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | predefinedfunction {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      ;
-other :  complex_const
-                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
-      | '(' expr ')'
-                   {if ( couldaddvariable == 1 ) sprintf($$," (%s)",$2);}
-      | '(' uexpr ',' dospec ')'
-                   {if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);}
-      | '(' other ',' dospec ')'
-                   {if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);}
-      | '(' out2 ',' dospec ')'
-                   {if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);}
-      ;
-
-dospec : TOK_NAME '=' expr ',' expr
-                   {if ( couldaddvariable == 1 )
-                                              sprintf($$,"%s=%s,%s)",$1,$3,$5);}
-      | TOK_NAME '=' expr ',' expr ',' expr
-                   {if ( couldaddvariable == 1 )
-                                        sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);}
-      ;
-labellist : label
-      | labellist ',' label
-      ;
-label : TOK_CSTINT
-      ;
-goto : TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
-      | TOK_PLAINGOTO label
-      ;
-allocation_list : allocate_object
-      | ident_dims
-      | allocation_list ',' allocate_object
-      ;
-allocate_object : ident
-                   {Add_Allocate_Var_1($1,curmodulename);}
-      | structure_component
-      | array_element
-      ;
-array_element : ident '(' funargs ')'
-                   {Add_Allocate_Var_1($1,curmodulename);}
-      ;
-subscript_list : expr
-      | subscript_list ',' expr
-      ;
-
-allocate_object_list :allocate_object
-      | allocate_object_list ',' allocate_object
-      ;
-opt_stat_spec :
-      | ',' TOK_STAT '=' ident
-      ;
-pointer_name_list : ident
-      | pointer_name_list ',' ident
-      ;
-opt_construct_name :
-      | TOK_NAME
-      ;
-opt_construct_name_colon :
-      | TOK_CONSTRUCTID ':'
-      ;
-logif : TOK_LOGICALIF expr ')'
-      ;
-do_var : ident {strcpy($$,$1);}
-      ;
-%%
-
-void processfortran(char *fichier_entree)
-{
-   extern FILE *fortranin;
-   extern FILE *fortranout;
-   char nomfile[LONG_C];
-   int c;
-   int confirmyes;
-
-/*   fortrandebug = 1;*/
-   if ( mark == 1 ) printf("Firstpass == %d \n",firstpass);
-/******************************************************************************/
-/*  1-  Open input and output files                                           */
-/******************************************************************************/
-   strcpy(nomfile,commondirin);
-   strcat(nomfile,"/");
-   strcat(nomfile,fichier_entree);
-   fortranin=fopen( nomfile,"r");
-   if (! fortranin)
-   {
-      printf("Error : File %s does not exist\n",nomfile);
-      exit(1);
-   }
-
-   strcpy(curfile,nomfile);
-   strcpy(nomfile,commondirout);
-   strcat(nomfile,"/");
-   strcat(nomfile,fichier_entree);
-   strcpy(nomfileoutput,nomfile);
-   Save_Length(nomfileoutput,31);
-   if (firstpass == 1)
-   {
-      if (checkexistcommon == 1)
-      {
-         if (fopen(nomfile,"r"))
-         {
-            printf("Warning : file %s already exist\n",nomfile);
-            confirmyes = 0;
-            while (confirmyes==0)
-            {
-               printf("Override file %s ? [Y/N]\n",nomfile);
-               c=getchar();
-               getchar();
-               if (c==79 || c==110)
-               {
-                  printf("We stop\n");
-                  exit(1);
-               }
-               if (c==89 || c==121)
-               {
-                  confirmyes=1;
-               }
-            }
-         }
-      }
-   }
-
-/******************************************************************************/
-/*  2-  Variables initialization                                              */
-/******************************************************************************/
-
-   line_num_fortran_common=1;
-   line_num_fortran=1;
-   PublicDeclare = 0;
-   PrivateDeclare = 0;
-   ExternalDeclare = 0;
-   SaveDeclare = 0;
-   pointerdeclare = 0;
-   optionaldeclare = 0;
-   incalldeclare = 0;
-   VarType = 0;
-   VarTypepar = 0;
-   Allocatabledeclare = 0 ;
-   Targetdeclare = 0 ;
-   strcpy(NamePrecision," ");
-   VariableIsParameter =  0 ;
-   strcpy(NamePrecision,"");
-   c_star = 0 ;
-   functiondeclarationisdone = 0;
-   insubroutinedeclare = 0 ;
-   ininterfacedeclare = 0 ;   
-   strcpy(subroutinename," ");
-   isrecursive = 0;
-   strcpy(InitialValueGiven," ");
-   strcpy(EmptyChar," ");
-   inmoduledeclare = 0;
-   incontainssubroutine = 0;
-   module_declar_type = 0;
-   GlobalDeclarationType = 0;
-   colnum=0;
-   incom=0;
-   couldaddvariable=1;
-   afterpercent = 0;
-   aftercontainsdeclare = 1;
-   strcpy(nameinttypename,"");
-   /* Name of the file without format                                         */
-   tmp = strchr(fichier_entree, '.');
-   strncpy(curfilename,fichier_entree,strlen(fichier_entree)-strlen(tmp));
-   Save_Length(curfilename,30);
-/******************************************************************************/
-/*  3-  Parsing of the input file (1 time)                                    */
-/******************************************************************************/
-   if (firstpass == 0 )
-   {
-      fortranout=fopen(nomfileoutput,"w");
-
-/*      NewModule_Creation_0();*/
-   }
-
-   fortranparse();
-
-   if (firstpass == 0 )
-   {
-   NewModule_Creation_0();
-   }
-   
-   strcpy(curfile,mainfile);
-
-   if (firstpass == 0 )
-   {
-   fclose(fortranout);
-   }
-}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.yy.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.yy.c	(revision 5659)
+++ 	(revision )
@@ -1,5248 +1,0 @@
-#line 2 "fortran.yy.c"
-
-#line 4 "fortran.yy.c"
-
-#define  YY_INT_ALIGNED short int
-
-/* A lexical scanner generated by flex */
-
-#define yy_create_buffer fortran_create_buffer
-#define yy_delete_buffer fortran_delete_buffer
-#define yy_flex_debug fortran_flex_debug
-#define yy_init_buffer fortran_init_buffer
-#define yy_flush_buffer fortran_flush_buffer
-#define yy_load_buffer_state fortran_load_buffer_state
-#define yy_switch_to_buffer fortran_switch_to_buffer
-#define yyin fortranin
-#define yyleng fortranleng
-#define yylex fortranlex
-#define yylineno fortranlineno
-#define yyout fortranout
-#define yyrestart fortranrestart
-#define yytext fortrantext
-#define yywrap fortranwrap
-#define yyalloc fortranalloc
-#define yyrealloc fortranrealloc
-#define yyfree fortranfree
-
-#define FLEX_SCANNER
-#define YY_FLEX_MAJOR_VERSION 2
-#define YY_FLEX_MINOR_VERSION 5
-#define YY_FLEX_SUBMINOR_VERSION 35
-#if YY_FLEX_SUBMINOR_VERSION > 0
-#define FLEX_BETA
-#endif
-
-/* First, we deal with  platform-specific or compiler-specific issues. */
-
-/* begin standard C headers. */
-#include <stdio.h>
-#include <string.h>
-#include <errno.h>
-#include <stdlib.h>
-
-/* end standard C headers. */
-
-/* flex integer type definitions */
-
-#ifndef FLEXINT_H
-#define FLEXINT_H
-
-/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
-
-#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
-
-/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,
- * if you want the limit (max/min) macros for int types. 
- */
-#ifndef __STDC_LIMIT_MACROS
-#define __STDC_LIMIT_MACROS 1
-#endif
-
-#include <inttypes.h>
-typedef int8_t flex_int8_t;
-typedef uint8_t flex_uint8_t;
-typedef int16_t flex_int16_t;
-typedef uint16_t flex_uint16_t;
-typedef int32_t flex_int32_t;
-typedef uint32_t flex_uint32_t;
-#else
-typedef signed char flex_int8_t;
-typedef short int flex_int16_t;
-typedef int flex_int32_t;
-typedef unsigned char flex_uint8_t; 
-typedef unsigned short int flex_uint16_t;
-typedef unsigned int flex_uint32_t;
-#endif /* ! C99 */
-
-/* Limits of integral types. */
-#ifndef INT8_MIN
-#define INT8_MIN               (-128)
-#endif
-#ifndef INT16_MIN
-#define INT16_MIN              (-32767-1)
-#endif
-#ifndef INT32_MIN
-#define INT32_MIN              (-2147483647-1)
-#endif
-#ifndef INT8_MAX
-#define INT8_MAX               (127)
-#endif
-#ifndef INT16_MAX
-#define INT16_MAX              (32767)
-#endif
-#ifndef INT32_MAX
-#define INT32_MAX              (2147483647)
-#endif
-#ifndef UINT8_MAX
-#define UINT8_MAX              (255U)
-#endif
-#ifndef UINT16_MAX
-#define UINT16_MAX             (65535U)
-#endif
-#ifndef UINT32_MAX
-#define UINT32_MAX             (4294967295U)
-#endif
-
-#endif /* ! FLEXINT_H */
-
-#ifdef __cplusplus
-
-/* The "const" storage-class-modifier is valid. */
-#define YY_USE_CONST
-
-#else	/* ! __cplusplus */
-
-/* C99 requires __STDC__ to be defined as 1. */
-#if defined (__STDC__)
-
-#define YY_USE_CONST
-
-#endif	/* defined (__STDC__) */
-#endif	/* ! __cplusplus */
-
-#ifdef YY_USE_CONST
-#define yyconst const
-#else
-#define yyconst
-#endif
-
-/* Returned upon end-of-file. */
-#define YY_NULL 0
-
-/* Promotes a possibly negative, possibly signed char to an unsigned
- * integer for use as an array index.  If the signed char is negative,
- * we want to instead treat it as an 8-bit unsigned char, hence the
- * double cast.
- */
-#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
-
-/* Enter a start condition.  This macro really ought to take a parameter,
- * but we do it the disgusting crufty way forced on us by the ()-less
- * definition of BEGIN.
- */
-#define BEGIN (yy_start) = 1 + 2 *
-
-/* Translate the current start state into a value that can be later handed
- * to BEGIN to return to the state.  The YYSTATE alias is for lex
- * compatibility.
- */
-#define YY_START (((yy_start) - 1) / 2)
-#define YYSTATE YY_START
-
-/* Action number for EOF rule of a given start state. */
-#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
-
-/* Special action meaning "start processing a new file". */
-#define YY_NEW_FILE fortranrestart(fortranin  )
-
-#define YY_END_OF_BUFFER_CHAR 0
-
-/* Size of default input buffer. */
-#ifndef YY_BUF_SIZE
-#define YY_BUF_SIZE 16384
-#endif
-
-/* The state buf must be large enough to hold one state per character in the main buffer.
- */
-#define YY_STATE_BUF_SIZE   ((YY_BUF_SIZE + 2) * sizeof(yy_state_type))
-
-#ifndef YY_TYPEDEF_YY_BUFFER_STATE
-#define YY_TYPEDEF_YY_BUFFER_STATE
-typedef struct yy_buffer_state *YY_BUFFER_STATE;
-#endif
-
-#ifndef YY_TYPEDEF_YY_SIZE_T
-#define YY_TYPEDEF_YY_SIZE_T
-typedef size_t yy_size_t;
-#endif
-
-extern yy_size_t fortranleng;
-
-extern FILE *fortranin, *fortranout;
-
-#define EOB_ACT_CONTINUE_SCAN 0
-#define EOB_ACT_END_OF_FILE 1
-#define EOB_ACT_LAST_MATCH 2
-
-    #define YY_LESS_LINENO(n)
-    
-/* Return all but the first "n" matched characters back to the input stream. */
-#define yyless(n) \
-	do \
-		{ \
-		/* Undo effects of setting up fortrantext. */ \
-        int yyless_macro_arg = (n); \
-        YY_LESS_LINENO(yyless_macro_arg);\
-		*yy_cp = (yy_hold_char); \
-		YY_RESTORE_YY_MORE_OFFSET \
-		(yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
-		YY_DO_BEFORE_ACTION; /* set up fortrantext again */ \
-		} \
-	while ( 0 )
-
-#define unput(c) yyunput( c, (yytext_ptr)  )
-
-#ifndef YY_STRUCT_YY_BUFFER_STATE
-#define YY_STRUCT_YY_BUFFER_STATE
-struct yy_buffer_state
-	{
-	FILE *yy_input_file;
-
-	char *yy_ch_buf;		/* input buffer */
-	char *yy_buf_pos;		/* current position in input buffer */
-
-	/* Size of input buffer in bytes, not including room for EOB
-	 * characters.
-	 */
-	yy_size_t yy_buf_size;
-
-	/* Number of characters read into yy_ch_buf, not including EOB
-	 * characters.
-	 */
-	yy_size_t yy_n_chars;
-
-	/* Whether we "own" the buffer - i.e., we know we created it,
-	 * and can realloc() it to grow it, and should free() it to
-	 * delete it.
-	 */
-	int yy_is_our_buffer;
-
-	/* Whether this is an "interactive" input source; if so, and
-	 * if we're using stdio for input, then we want to use getc()
-	 * instead of fread(), to make sure we stop fetching input after
-	 * each newline.
-	 */
-	int yy_is_interactive;
-
-	/* Whether we're considered to be at the beginning of a line.
-	 * If so, '^' rules will be active on the next match, otherwise
-	 * not.
-	 */
-	int yy_at_bol;
-
-    int yy_bs_lineno; /**< The line count. */
-    int yy_bs_column; /**< The column count. */
-    
-	/* Whether to try to fill the input buffer when we reach the
-	 * end of it.
-	 */
-	int yy_fill_buffer;
-
-	int yy_buffer_status;
-
-#define YY_BUFFER_NEW 0
-#define YY_BUFFER_NORMAL 1
-	/* When an EOF's been seen but there's still some text to process
-	 * then we mark the buffer as YY_EOF_PENDING, to indicate that we
-	 * shouldn't try reading from the input source any more.  We might
-	 * still have a bunch of tokens to match, though, because of
-	 * possible backing-up.
-	 *
-	 * When we actually see the EOF, we change the status to "new"
-	 * (via fortranrestart()), so that the user can continue scanning by
-	 * just pointing fortranin at a new input file.
-	 */
-#define YY_BUFFER_EOF_PENDING 2
-
-	};
-#endif /* !YY_STRUCT_YY_BUFFER_STATE */
-
-/* Stack of input buffers. */
-static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
-static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
-static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
-
-/* We provide macros for accessing buffer states in case in the
- * future we want to put the buffer states in a more general
- * "scanner state".
- *
- * Returns the top of the stack, or NULL.
- */
-#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
-                          ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
-                          : NULL)
-
-/* Same as previous macro, but useful when we know that the buffer stack is not
- * NULL or when we need an lvalue. For internal use only.
- */
-#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
-
-/* yy_hold_char holds the character lost when fortrantext is formed. */
-static char yy_hold_char;
-static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
-yy_size_t fortranleng;
-
-/* Points to current character in buffer. */
-static char *yy_c_buf_p = (char *) 0;
-static int yy_init = 0;		/* whether we need to initialize */
-static int yy_start = 0;	/* start state number */
-
-/* Flag which is used to allow fortranwrap()'s to do buffer switches
- * instead of setting up a fresh fortranin.  A bit of a hack ...
- */
-static int yy_did_buffer_switch_on_eof;
-
-void fortranrestart (FILE *input_file  );
-void fortran_switch_to_buffer (YY_BUFFER_STATE new_buffer  );
-YY_BUFFER_STATE fortran_create_buffer (FILE *file,int size  );
-void fortran_delete_buffer (YY_BUFFER_STATE b  );
-void fortran_flush_buffer (YY_BUFFER_STATE b  );
-void fortranpush_buffer_state (YY_BUFFER_STATE new_buffer  );
-void fortranpop_buffer_state (void );
-
-static void fortranensure_buffer_stack (void );
-static void fortran_load_buffer_state (void );
-static void fortran_init_buffer (YY_BUFFER_STATE b,FILE *file  );
-
-#define YY_FLUSH_BUFFER fortran_flush_buffer(YY_CURRENT_BUFFER )
-
-YY_BUFFER_STATE fortran_scan_buffer (char *base,yy_size_t size  );
-YY_BUFFER_STATE fortran_scan_string (yyconst char *yy_str  );
-YY_BUFFER_STATE fortran_scan_bytes (yyconst char *bytes,yy_size_t len  );
-
-void *fortranalloc (yy_size_t  );
-void *fortranrealloc (void *,yy_size_t  );
-void fortranfree (void *  );
-
-#define yy_new_buffer fortran_create_buffer
-
-#define yy_set_interactive(is_interactive) \
-	{ \
-	if ( ! YY_CURRENT_BUFFER ){ \
-        fortranensure_buffer_stack (); \
-		YY_CURRENT_BUFFER_LVALUE =    \
-            fortran_create_buffer(fortranin,YY_BUF_SIZE ); \
-	} \
-	YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
-	}
-
-#define yy_set_bol(at_bol) \
-	{ \
-	if ( ! YY_CURRENT_BUFFER ){\
-        fortranensure_buffer_stack (); \
-		YY_CURRENT_BUFFER_LVALUE =    \
-            fortran_create_buffer(fortranin,YY_BUF_SIZE ); \
-	} \
-	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
-	}
-
-#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
-
-/* Begin user sect3 */
-
-typedef unsigned char YY_CHAR;
-
-FILE *fortranin = (FILE *) 0, *fortranout = (FILE *) 0;
-
-typedef int yy_state_type;
-
-extern int fortranlineno;
-
-int fortranlineno = 1;
-
-extern char *fortrantext;
-#define yytext_ptr fortrantext
-
-static yy_state_type yy_get_previous_state (void );
-static yy_state_type yy_try_NUL_trans (yy_state_type current_state  );
-static int yy_get_next_buffer (void );
-static void yy_fatal_error (yyconst char msg[]  );
-
-/* Done after the current pattern has been matched and before the
- * corresponding action - sets up fortrantext.
- */
-#define YY_DO_BEFORE_ACTION \
-	(yytext_ptr) = yy_bp; \
-	fortranleng = (size_t) (yy_cp - yy_bp); \
-	(yy_hold_char) = *yy_cp; \
-	*yy_cp = '\0'; \
-	(yy_c_buf_p) = yy_cp;
-
-#define YY_NUM_RULES 176
-#define YY_END_OF_BUFFER 177
-/* This struct is not used in this scanner,
-   but its presence is necessary. */
-struct yy_trans_info
-	{
-	flex_int32_t yy_verify;
-	flex_int32_t yy_nxt;
-	};
-static yyconst flex_int16_t yy_accept[1162] =
-    {   0,
-        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-        0,    0,  177,  176,  165,  161,  164,  175,  152,  151,
-      155,  167,  152,  154,  154,  154,  157,  153,  137,  150,
-      156,  159,  158,  160,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  165,  161,  164,  175,  150,  145,  145,  145,
-      145,  145,  145,  176,  176,  173,  176,  176,  176,  161,
-      161,  154,  145,    0,    0,  165,    0,  166,    0,  164,
-      175,  175,  175,    0,  141,    0,    0,  167,  167,  167,
-      167,    0,    0,    0,  140,    0,    0,  132,   26,    0,
-
-      146,    0,    0,    0,    0,    0,    0,    0,  133,    0,
-      150,   25,    0,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-       43,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,   85,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  165,  163,    0,  163,    0,    0,    0,    0,
-        0,    0,  166,  162,  163,    0,  175,  174,  175,  175,
-      175,  163,  150,    4,  145,  145,  145,  145,   85,  145,
-
-      145,    0,  173,    0,    0,    0,    0,    0,    0,    0,
-      169,   26,    0,    0,    4,    0,  145,  145,  145,  145,
-      145,  145,    0,    0,    0,  175,  175,    0,    0,  167,
-      167,    0,    0,    0,    0,  139,    0,    0,    0,    0,
-        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-        0,  149,  146,    0,    0,    0,  142,    0,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  115,  145,  145,  145,    0,  145,  145,  145,  145,
-      145,   16,  145,  145,  145,  114,  145,  145,  145,  145,
-      145,    0,  145,    0,   96,  145,  145,  145,  145,  145,
-
-      121,  145,  145,  126,  145,  145,  145,  145,  145,  145,
-      145,   89,  145,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  118,  145,  145,  145,
-      145,  145,  122,  145,  145,  145,  145,  145,  165,  163,
-        0,  166,    0,    0,    0,    0,    0,    0,    0,    0,
-      163,    0,  163,  175,  175,  175,  150,    4,    4,    4,
-        4,  145,  145,  145,  145,  145,  145,  145,    0,    0,
-        0,    0,  170,    0,    0,  169,    0,    0,    4,    4,
-        4,    4,  142,    0,  145,  145,    0,  145,  145,  145,
-      145,    0,    0,    0,  175,  175,    0,    0,  167,  167,
-
-        0,    0,    0,    0,  147,    0,  146,    0,  148,    0,
-       28,    0,   30,   29,   32,   31,   34,    0,    0,   36,
-        0,  146,    0,  147,    0,  146,    0,  148,    0,  142,
-        0,  125,  117,  145,  145,  120,  123,  145,  145,   22,
-      145,  145,  145,  145,  145,  116,  145,  145,  145,    0,
-      145,  145,  145,   94,    0,  108,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,    0,  109,  145,  145,  145,
-      145,  145,  145,  145,    0,   88,  145,  145,  145,  145,
-      145,  145,  145,    0,   98,  145,  145,    0,  111,  145,
-      145,  145,  145,  112,   21,  145,   60,   74,  145,  145,
-
-      145,  145,  145,  145,  145,  145,   79,   44,  145,  145,
-      145,  145,   69,  145,  127,  119,  145,   72,   54,  145,
-        0,   97,   99,  145,   92,  101,  145,  145,  165,  163,
-      166,    0,    0,    0,    0,    0,    0,    0,  163,    0,
-      163,  175,  175,  175,  150,    4,    4,  145,  145,  145,
-      145,  145,  145,   18,    0,    0,    0,    0,    0,  170,
-        0,    0,    4,    4,    0,  142,    0,  145,  145,  145,
-      145,    0,    0,    0,  175,  175,    0,    0,  167,  167,
-        0,    0,   38,   27,    0,   35,   37,    0,  142,    0,
-      142,  145,  145,  145,  145,  145,   49,  145,  145,  145,
-
-      124,  145,  145,    0,  145,  145,  145,    0,  145,  145,
-        0,    0,    0,    0,    0,    0,    0,    0,   42,  145,
-       95,  145,  145,  145,  145,  145,  145,  145,  145,   76,
-       76,   76,   76,  145,    0,  107,  113,  145,  145,   88,
-      145,  145,   90,  145,  145,  145,  145,  145,  145,  145,
-      145,  145,  145,  145,  145,  145,  145,   52,  145,   77,
-      145,  145,  145,    0,  145,  145,  145,  145,  145,  102,
-      145,  145,   55,   81,  165,  163,  166,    0,    0,    0,
-        0,    0,    0,  163,    0,  163,  175,  175,  175,  150,
-        4,    3,    0,  104,  145,  145,   86,  145,  145,   70,
-
-       71,   70,    0,    0,    0,    0,    4,    3,    0,  142,
-        0,  142,  145,   49,  145,  124,    0,   23,    0,  175,
-       23,    0,   23,   23,  167,   23,    0,   23,   23,   23,
-       33,  145,  145,   23,   23,   23,  145,  145,   63,  145,
-      145,  145,  145,    0,  145,  145,  138,    0,    0,   93,
-      145,   42,    0,   95,    0,    0,    0,    0,    0,    0,
-      145,  145,  145,  145,  145,  145,  145,  145,    0,  110,
-      145,  145,  145,  145,  145,  145,  145,   66,  145,  145,
-      129,  100,  128,  130,   39,  145,  145,  145,  145,  145,
-      145,  145,   83,    0,  145,   11,   75,   19,  145,  145,
-
-       82,  165,  163,  166,    0,    0,    0,    0,  163,  175,
-      175,   23,    4,    3,    3,  145,  145,  145,  145,    0,
-        0,    0,   23,    4,    3,    3,  145,   23,   23,   23,
-       24,    0,  168,   24,   24,   24,   24,   24,   24,   24,
-       24,   24,   24,  145,  145,  145,   58,  145,  145,  145,
-        0,    0,  145,  145,   40,   93,    0,  145,    0,    0,
-        0,    0,    0,    0,    0,  145,  145,  145,  145,  145,
-       73,  145,  145,  145,    0,    0,  145,  145,   17,   50,
-       45,  145,   46,    0,  145,  145,    9,  145,  145,   67,
-       84,    7,    0,    0,  145,    0,  145,  145,    0,    0,
-
-        0,    0,  175,   24,    4,  145,  145,   64,  145,    0,
-        0,   24,    4,   24,   24,   24,  145,    8,  145,  145,
-       87,  145,  145,   40,    0,    0,  145,  145,    0,  145,
-        0,    0,    0,    0,    0,   73,    0,  145,  145,  145,
-      145,  145,   56,  145,   65,    0,    0,    0,    0,  134,
-       12,   20,  145,    0,  145,   80,   68,  145,    0,  145,
-        0,  145,  145,    0,    0,    0,  175,    4,  145,   59,
-      145,    0,    0,    4,  145,  131,   47,  145,   51,    0,
-        0,  145,  145,    0,   57,    0,    0,    0,    0,    0,
-       56,  145,   41,  145,  106,  145,  145,    0,    0,    0,
-
-        0,    0,  134,   91,    0,  145,   61,    0,   62,    0,
-      145,  145,    0,   59,    0,  175,    4,    4,  145,  143,
-        0,    0,    4,    4,  145,   10,    0,    0,  145,  145,
-       57,    0,   41,    0,  106,    0,  145,   14,  145,  145,
-        0,    0,    0,  145,    0,    0,  103,    6,    0,  143,
-      175,    4,    4,  145,    0,    0,    4,    4,   48,    0,
-        0,  145,  145,    0,   14,    0,   15,  145,   53,    0,
-        0,    0,  145,    0,  103,    0,  175,    4,    2,  105,
-        0,    0,    4,    2,    0,    0,  145,  145,   15,    0,
-      145,    0,    0,    0,  145,    0,  105,  175,    4,    0,
-
-        0,    4,    0,    0,  136,  145,    0,   13,    0,    0,
-        0,  145,    0,  175,    1,    0,    0,  144,    1,  136,
-        0,  145,   13,    0,    0,    0,    0,  145,    0,  175,
-        0,    0,  135,    0,    0,    0,   78,    5,  175,    0,
-      135,   78,  175,    0,  175,    0,  175,    0,  175,    0,
-      175,    0,  175,  171,    0,    0,    0,    0,    0,  172,
-        0
-    } ;
-
-static yyconst flex_int32_t yy_ec[256] =
-    {   0,
-        1,    1,    1,    1,    1,    1,    1,    1,    2,    3,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    4,    5,    6,    7,    8,    9,   10,   11,   12,
-       13,   14,   15,   16,   17,   18,   19,   20,   21,   22,
-       23,   24,   25,   26,   27,   28,   29,   30,   31,   32,
-       33,   34,    1,    1,   35,   36,   37,   38,   39,   40,
-       41,   42,   43,   44,   45,   46,   47,   48,   49,   50,
-       51,   52,   53,   54,   55,   56,   57,   58,   59,   60,
-       61,    1,   62,    1,   63,    1,   64,   65,   66,   67,
-
-       68,   69,   70,   71,   72,   44,   73,   74,   75,   76,
-       77,   78,   79,   80,   81,   82,   83,   84,   85,   86,
-       87,   88,   89,   89,   89,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1
-    } ;
-
-static yyconst flex_int32_t yy_meta[90] =
-    {   0,
-        1,    2,    3,    2,    1,    4,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    5,    1,    6,
-        6,    6,    6,    6,    6,    6,    6,    6,    6,    1,
-        1,    1,    1,    1,    7,    8,    8,    9,    9,    5,
-       10,   11,    8,    8,    8,   10,   10,   10,    7,    8,
-        9,   10,   10,    5,   10,    8,   12,    8,    8,    8,
-        1,    1,    8,    7,    8,    8,    9,    9,    5,   10,
-       11,    8,    8,   10,   10,   10,    7,    8,    9,   10,
-       10,    5,   10,    8,   12,    8,    8,    8,    4
-    } ;
-
-static yyconst flex_int16_t yy_base[1215] =
-    {   0,
-        0,   88,    0,    0,    0,    0, 1215,   93, 1196,   91,
-        0,    0, 1179,   64,   97,  117,  132,   87,  124,   98,
-       99,  142,  173,  154,  108,  135,  134,  254,  172,  179,
-      175,  178,  219,  180,  323,  388,  384,  318,  386,  319,
-      186,  128,  250,  256,  392,  404,  438,  428,  204,  455,
-      432,  465,  544,  120,  537,  548,  627,  624,  622,  544,
-      644,  658,  251, 9159, 1175, 9159,  267,   99,  162,  569,
-      572,  620,  745,  164,  107,  262,  307,  335,  376,  522,
-        0,  167,  157, 1162, 9159,  278,  321, 1160, 1118,  372,
-      304,  532,  593,  567, 9159,  633,  832, 9159, 9159,  911,
-
-      798,  318,  319,  450,  799,  552,  320,  354, 9159,  978,
-      834, 9159,  865,  860,  862,  866,  914,  863,  973,  980,
-      974, 1013, 1024, 1045,  869, 1049, 1075, 1095, 1098, 1101,
-     1182, 1177, 1161, 1181, 1214, 1212, 1237, 1239, 1235, 1270,
-     1290, 1316, 1325, 1293, 1346, 1323, 1366, 1368, 1391, 1399,
-     1403, 1429, 1430, 1455, 1452, 1478, 1498, 1482, 1523, 1521,
-     1554, 1548, 1579, 1586, 1606, 1629, 1649, 1675, 1681, 1698,
-     1707, 1729,  871, 1114, 1109,  140, 1023,  187,  372,  403,
-      553,  401, 1095,  565, 1792, 1818, 1083, 9159,  643,  669,
-      589, 1844, 1870, 1580, 1865, 1867, 1868, 1905, 1926, 1922,
-
-     1925, 1078, 9159,  837,  437,  677,  249,  660, 1072,  712,
-     9159, 1062,  844,  625, 1874, 1993, 2022, 1042,  864,  473,
-      904,  621,  506,  651,  721,  798,  791,  890,  912,  936,
-      907,  725, 1029, 1143,  729, 9159, 1114, 1179, 2097, 2112,
-     2127,  229,  937, 1033, 1012, 1006,  994,  943,  883,  974,
-      891, 9159, 1476, 2142, 2157, 2172, 2182, 2202, 2178, 2180,
-     2200, 2203, 2223, 2243, 2246, 2244, 2276, 2269, 2299, 2307,
-     2301, 2324, 2344, 2351, 2377,  901, 1018, 2374, 2394, 2397,
-     2414, 2495, 2434, 2440, 2465, 2472, 2518, 2521, 2515, 2548,
-     2556, 1138, 2564,  968, 9159, 2581, 2597, 2604, 2627, 2649,
-
-     2650, 2690, 2693, 2686, 2726, 2738, 2746, 2747, 2763, 2783,
-     2799, 2800, 2803, 2820, 2840, 2843, 2870, 2891, 2895, 2903,
-     2926, 2928, 2935, 2961, 2981, 2958, 2984, 2978, 3004, 3011,
-     3027, 3052, 3048, 3059, 3085, 3068, 3105, 3111,  196,  203,
-      976,  383,  974,  988, 1018, 1014, 1025, 1029, 1042,  253,
-     3174, 3200, 3226, 1067, 1182, 1172, 3252,    0,  418,  288,
-     1096, 3228, 3229, 3231, 3251, 3267, 3287, 3290, 1188, 1566,
-      973,  740, 9159,  938,  866, 9159, 1268, 1178,  931, 1170,
-     1241, 1299, 3354, 3381,    0,  903, 3408, 1148, 1116, 1177,
-     1322, 1145,  410, 1415, 1235,  460, 1292, 1218, 1323, 1022,
-
-      963, 1520, 1662, 3418, 3430, 3440, 3450, 3460, 3470,  889,
-     9159,  865, 9159, 9159, 9159, 9159, 9159, 1239,  853, 9159,
-      846, 2472, 3480, 3490, 3500, 3510, 3520, 3530, 3545, 3555,
-     3575, 9159, 3289, 3553, 3573, 3551, 3574, 3590, 3596, 3612,
-     3628, 3634, 3635, 3655, 3671, 3651, 3687, 3688, 3696,  459,
-     3728, 3736, 3740, 3784, 3868, 9159, 3780, 3776, 3807, 3811,
-     3850, 3912, 3872, 3920, 3921, 1351, 9159, 3828, 4005, 4060,
-     4095, 3904, 4063, 4069, 1258, 4096, 4104, 4126, 4134, 4156,
-     4165, 4196, 4205, 1409, 9159, 4208, 4197, 1476, 9159, 4235,
-     4241, 4257, 4261, 4273, 4284, 4293, 4305, 4309, 4332, 4336,
-
-     4353, 4316, 4359, 4362, 4384, 4407, 4385, 4416, 4423, 4448,
-     4455, 4456, 4486, 4494, 4488, 4511, 4527, 4519, 4531, 4554,
-     1498, 9159, 4552, 4575, 4584, 4587, 4607, 4610,  493,  529,
-      551,  476, 1287,  816,  953, 1119, 1293,  841, 4678, 4704,
-     4730, 1607, 1346, 1458, 4756, 1362, 1397, 4733, 4732, 4759,
-     4627, 4768, 4817,  733, 1619, 1594, 1406,  728, 1537, 9159,
-     1571, 1651, 1625, 1613, 4839, 4867, 4894, 1627, 1658, 1686,
-     1714, 1394,    0, 1756, 1574,    0, 1668,  724, 1709,  724,
-     1763, 1775, 9159, 9159,  708, 9159, 9159, 4904, 4916, 4926,
-     4936, 4771, 4931, 5013, 4934, 5068, 5069, 5071, 5075, 5072,
-
-     5120, 5121, 5123, 1725, 5127, 5153, 5176, 1832, 5175, 5179,
-     1458, 1493, 1739, 1516, 1519, 1873, 1592, 1739, 5201, 5224,
-     5202, 5241, 5240, 5257, 5278, 5280, 5301, 5284, 5352, 9159,
-     5351, 5346, 5349, 5353, 1802, 9159, 5355, 5385, 5401, 9159,
-     5405, 5408, 5412, 5428, 5449, 5451, 5458, 5460, 5495, 5501,
-     5531, 5527, 5539, 5571, 5564, 5575, 5591, 5602, 5623, 5614,
-     5634, 5635, 5660,  693, 5666, 5667, 5692, 5703, 5715, 9159,
-     5723, 5719, 5740, 5746,  846, 1103, 1234, 1788, 1768, 1386,
-     1788, 1615, 1847, 1854,  236,  590, 1781, 1913,  715, 5809,
-     1790, 1645, 2264, 9159, 5785, 5805, 1690, 5806, 5807, 2344,
-
-     9159, 1951, 1858, 1924, 2256,  679, 1930, 1879, 5870, 5880,
-     5907, 5917, 1811,  658, 5946,  624,    0, 9159, 6034,    0,
-        0,  613,  609, 9159,  604,  586, 2245, 2364, 2389, 9159,
-     9159, 6063, 6118, 6139, 6138, 6134, 6135, 6141, 6161, 6173,
-     6184, 6209, 6217, 1654, 6260, 6248, 6216, 1844, 1864, 6239,
-     6280, 9159, 1689, 9159, 1930, 1750, 1763, 1934, 1933, 2077,
-     6300, 6292, 6317, 6337, 6338, 6344, 6369, 6376, 2212, 9159,
-     6360, 6413, 6392, 6412, 6424, 6433, 6456, 6435, 6465, 6476,
-     6488, 6497, 6508, 6509, 6552, 6529, 6540, 6549, 6560, 6585,
-     6593, 6605, 6628, 2392, 6636, 6637, 6648, 6659, 6694, 6685,
-
-     6686, 6775, 2286,  518, 2092, 2103, 1938, 2148, 2420, 2303,
-      472,  442, 2196,    0, 1803, 6692, 6717, 6768, 6756, 2424,
-     2334,  426,  422, 2432,  378, 1883, 6858, 6945, 6974,  337,
-     9159, 1922, 9159,    0,  328, 9159,  314, 2481, 2510, 9159,
-     6929, 6757, 7029, 7031, 7037, 7040, 7033, 7077, 7070, 7086,
-     2264, 2842, 7093, 7097, 7118, 9159, 2372, 7129, 2384, 2060,
-     2411, 2418, 2078, 2421, 2139, 7138, 7149, 7170, 7179, 7195,
-     7201, 7227, 7234, 7236, 2483, 3160, 7259, 7257, 7279, 7280,
-     7282, 7302, 7318, 2564, 7325, 7319, 7345, 7356, 7377, 7357,
-     7368, 7388, 2513, 2467, 7400, 2603, 7389, 7425, 2468, 2371,
-
-     2235, 2479,  361,  296,  182, 7409, 7432, 2249, 7455,  622,
-     2529,  227, 1008, 7505,    0,  207, 7482, 7503, 7505, 7514,
-     7535, 7536, 7544, 9159, 2413, 2526, 7567, 7571, 2546, 7593,
-     2547, 2562, 2567, 2526, 2575, 9159, 2526, 7587, 7625, 7594,
-     7631, 7632, 7648, 7657, 7668, 3179, 3203, 2672, 3229, 3335,
-     7684, 7688, 7709, 2597, 7705, 7725, 7732, 7736,  178, 7758,
-     2596, 7775, 7769, 2619, 2617, 2641, 2696, 2668, 7795, 7801,
-     7807, 2677, 2720, 3150, 7827, 7818, 7834, 7867, 7850, 2625,
-     2685, 7870, 7890, 2688, 7859, 2699, 2731, 2741, 2661, 2665,
-     9159, 7911, 7907, 7910, 7927, 7933, 7963, 2822, 3360, 3384,
-
-     3411, 4103, 4220, 7959, 2702, 7970, 7966, 2741, 7986, 2738,
-     8003, 8019, 2758, 9159, 2765, 2781, 2809, 2818, 8030, 8026,
-     2900, 2883, 2903, 2951, 8042, 8051, 2820, 2829, 8063, 8086,
-     9159, 2838, 9159, 2846, 9159, 2846, 8088, 8090, 8113, 8134,
-     3067, 4430, 2880, 8136,  175, 2911, 8125, 8156, 2877, 9159,
-     1190, 2938, 2908, 8157, 3034, 3081, 3049, 3028, 8173, 2959,
-     2985, 8189, 8182, 3029, 9159, 3039, 8205, 8212, 8214, 3241,
-     4684, 3056, 8235, 3049, 9159, 3056, 3212, 3072,    0, 8237,
-     1210, 3169, 3157,  144, 3103, 3103, 8257, 8260, 9159, 3110,
-     8283, 3255, 4708, 3110, 8290,  123, 9159, 3235, 3207, 3329,
-
-     3387, 3558, 3232, 3256, 8306, 8313, 3278, 8315, 8396, 4870,
-     3259, 8391, 3280, 3664,    0, 3349, 3414, 9159,  103, 9159,
-     3346, 8392, 9159, 3745, 4900, 8473, 3347, 8450,   90, 1237,
-     1328, 3570, 8470, 4973, 4977, 3380, 8471, 9159, 3676, 3645,
-     9159, 9159, 3693, 3608, 3764, 3684, 3616, 1433, 3705, 3782,
-     3810, 3774, 3875, 9159, 3852, 3697, 3910, 3892, 3896, 9159,
-     9159, 8553, 8565, 8577, 8589, 8601, 8613, 8621, 8623, 8635,
-     8647, 8659, 8671, 8678, 8687, 8699, 8711, 8723, 8735, 8747,
-     8754, 8762, 8774, 8786, 8798, 8810, 8822, 8834, 8846, 8858,
-     8870, 8882, 8894, 8906, 8918, 8930, 8942, 8954, 8966, 8978,
-
-     8990, 9002, 9014, 9026, 9038, 9050, 9062, 9074, 9086, 9098,
-     9110, 9122, 9134, 9146
-    } ;
-
-static yyconst flex_int16_t yy_def[1215] =
-    {   0,
-     1161,    1, 1162, 1162,    1,    2, 1163, 1163,    1,    2,
-        1,    2, 1161, 1161, 1161, 1161, 1161, 1164, 1165, 1161,
-     1161, 1166, 1167, 1161, 1161, 1161, 1161, 1161, 1161, 1168,
-     1161, 1161, 1161, 1161, 1169, 1169,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36, 1161, 1161,   53, 1170, 1161,   36,   36,   36,
-       36,   36,   36, 1161, 1171, 1161, 1171, 1171, 1171, 1161,
-     1161, 1172, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1164, 1164, 1164, 1165, 1161, 1165, 1165, 1166, 1161, 1166,
-     1166, 1167, 1173, 1167, 1161, 1167, 1167, 1161, 1161, 1161,
-
-     1174, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1175,
-     1161, 1161, 1161,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-     1169,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   53,  173, 1176, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161,  173, 1161,  173, 1161, 1170, 1161, 1170, 1170,
-     1170, 1161, 1161, 1177,   36,   36,   36,   36,   36,   36,
-
-       36, 1171, 1161, 1171, 1171, 1171, 1171, 1178, 1179, 1179,
-     1161, 1179, 1179, 1179, 1180, 1179, 1161,  217,  217,  217,
-      217,  217, 1161, 1161, 1161, 1164, 1164, 1165, 1165, 1166,
-     1166, 1173, 1173, 1173, 1173, 1161, 1167, 1167, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1181, 1161, 1161, 1161, 1161, 1161,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36, 1182,  131,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36, 1161,   36, 1161, 1161,   36,   36,   36,   36,   36,
-
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,  173,  173,
-     1161,  173, 1176, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-      185, 1161, 1161, 1170, 1170, 1170, 1161, 1177, 1177, 1177,
-     1177,   36,   36,   36,   36,   36,   36,   36, 1171, 1171,
-     1183, 1183, 1161, 1179, 1179, 1161, 1179, 1179, 1180, 1180,
-     1180, 1180, 1179, 1179,  217,  217, 1179,  217,  217,  217,
-      217, 1161, 1161, 1161, 1164, 1164, 1165, 1165, 1166, 1166,
-
-     1173, 1167, 1167, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1181, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36, 1161,
-       36,   36,   36,   36, 1161, 1161,   36,   36,   36,   36,
-       36,   36,   36,   36,   36, 1161, 1161,   36, 1161,   36,
-       36,   36,   36,   36, 1161,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161, 1161,   36,   36, 1161, 1161,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-     1161, 1161,   36,   36,   36,   36,   36,   36,  173,  173,
-      173, 1161, 1161, 1161, 1161, 1161, 1161, 1161,  185, 1161,
-     1161, 1170, 1170, 1170, 1161, 1177, 1177,   36,   36,   36,
-       36,   36,   36, 1161, 1171, 1171, 1171, 1183, 1183, 1161,
-     1179, 1179, 1180, 1180, 1179, 1179, 1179,  217,  217,  217,
-      217, 1161, 1184, 1161, 1164, 1185, 1165, 1186, 1187, 1188,
-     1189, 1190, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
-
-       36,   36,   36, 1161,   36,   36,   36, 1161,   36,   36,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36, 1161,
-     1161,   36,   36,   36, 1161, 1161,   36,   36,   36, 1161,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36,   36,   36, 1161,
-       36,   36,   36,   36,  173,  173,  173, 1161, 1161, 1161,
-     1161, 1161, 1161,  173, 1161, 1161, 1170, 1170, 1191, 1161,
-     1177, 1192, 1161, 1161,   36,   36, 1161,   36,   36, 1161,
-
-     1161, 1161, 1171, 1171, 1179, 1193, 1180, 1194, 1179, 1179,
-     1179, 1179,  217,  217, 1161,  217, 1195, 1161, 1161, 1196,
-     1197, 1198, 1199, 1161, 1200, 1201, 1202, 1203, 1203, 1161,
-     1161, 1161,   36, 1161,   36,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36, 1161, 1161,   36,
-       36, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-       36,   36,   36,   36,   36,   36,   36,   36, 1161, 1161,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
-
-       36, 1161,  802,  802, 1161, 1161, 1161, 1161,  802, 1204,
-     1205, 1204, 1206, 1207, 1207,   36,   36,   36,   36, 1208,
-     1208, 1209, 1210, 1211, 1212, 1212, 1161, 1210, 1161,  829,
-     1161, 1161, 1161, 1197, 1199, 1161, 1201, 1203, 1203, 1161,
-     1161,   36,   36,   36,   36,   36,   36,   36,   36,   36,
-     1161, 1161,   36,   36,   36, 1161, 1161,   36, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161,   36,   36,   36,   36,   36,
-       36,   36,   36,   36, 1161, 1213,   36,   36,   36,   36,
-       36,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
-       36,   36, 1161, 1161,   36, 1161,   36,   36, 1161, 1161,
-
-     1161, 1161, 1204, 1204, 1206,   36,   36, 1161,   36, 1208,
-     1208, 1210, 1211, 1210,  829,  829,   36,   36,   36,   36,
-       36,   36,   36, 1161, 1161, 1161,   36,   36, 1161,   36,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161,   36,   36,   36,
-       36,   36,   36,   36,   36, 1213, 1213, 1161, 1214, 1213,
-       36,   36,   36, 1161,   36,   36,   36,   36, 1161,   36,
-     1161,   36,   36, 1161, 1161, 1161, 1204, 1206,   36,   36,
-       36, 1208, 1208, 1211,   36,   36,   36,   36,   36, 1161,
-     1161,   36,   36, 1161,   36, 1161, 1161, 1161, 1161, 1161,
-     1161,   36,   36,   36,   36,   36,   36, 1161, 1214, 1214,
-
-     1213, 1214, 1214,   36, 1161,   36,   36, 1161,   36, 1161,
-       36,   36, 1161, 1161, 1161, 1204, 1206, 1206,   36,   36,
-     1208, 1208, 1211, 1211,   36,   36, 1161, 1161,   36,   36,
-     1161, 1161, 1161, 1161, 1161, 1161,   36,   36,   36,   36,
-     1161, 1213, 1161,   36, 1161, 1161,   36,   36, 1161, 1161,
-     1204, 1206, 1206,   36, 1208, 1208, 1211, 1211,   36, 1161,
-     1161,   36,   36, 1161, 1161, 1161,   36,   36,   36, 1161,
-     1213, 1161,   36, 1161, 1161, 1161, 1204, 1206, 1206,   36,
-     1208, 1208, 1211, 1211, 1161, 1161,   36,   36, 1161, 1161,
-       36, 1161, 1213, 1161,   36, 1161, 1161, 1204, 1206, 1208,
-
-     1208, 1211, 1161, 1161,   36,   36, 1161,   36, 1161, 1213,
-     1161,   36, 1161, 1204, 1206, 1208, 1208, 1161, 1211, 1161,
-     1161,   36, 1161, 1161, 1213, 1213, 1161,   36, 1161, 1204,
-     1208, 1161,   36, 1213, 1214, 1161,   36, 1161, 1204, 1208,
-     1161, 1161, 1204, 1208, 1204, 1208, 1204, 1208, 1204, 1208,
-     1204, 1208, 1204, 1161, 1208, 1208, 1208, 1208, 1208, 1161,
-        0, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161
-    } ;
-
-static yyconst flex_int16_t yy_nxt[9249] =
-    {   0,
-       14,   15,   16,   17,   18,   19,   14,   20,   21,   22,
-       23,   24,   25,   26,   25,   27,   25,   28,   29,   30,
-       30,   30,   30,   30,   30,   30,   30,   30,   30,   25,
-       31,   32,   33,   34,   35,   36,   37,   38,   39,   40,
-       41,   42,   43,   42,   42,   44,   45,   46,   47,   48,
-       42,   49,   50,   51,   42,   42,   52,   42,   42,   42,
-       25,   25,   42,   35,   36,   37,   38,   39,   40,   41,
-       42,   43,   42,   44,   45,   46,   47,   48,   42,   49,
-       50,   51,   42,   42,   52,   42,   42,   42,   14,   53,
-       54,   55,   56,   71,   67,   66,   67,   68,   76,   77,
-
-       78,  203, 1138,   74,   72,  211,  206,   57,   57,   57,
-       57,   57,   57,   57,   57,   57,   57,   75,   79,   77,
-       79,   79,   77,   79,   58,   59,   82,   73,   60,   85,
-       61,   69,   74,   78,   77,   80,   74,   74,   74, 1113,
-       83,   62,   63,  176,   89,   75,  211,   74,   99,  176,
-       75,   75,   75,   58,   59,   82,   73,   60,  224,   61,
-       69,   75,  115,   86,  203,   74,   74,   74,   83,   62,
-       63,   74,   98,   74,   74,   93,   74,   87,   75,   75,
-       75,   90,   94,   95,  109,   75,  224,   75,   75,   75,
-     1074,  115,   86,   74, 1008,   91,  110,  529,  223,  530,
-
-       74,  226,   74,   74,  531,   87,  530,   75,  227,  207,
-       90,   74,   96,   75,   74,   75,   75,   74,   74,   74,
-      115,  346,   74,   91,  387,   75,   97,  223,   75,  211,
-      226,   75,   75,   75,  142,   75,  227,  207,  115,  176,
-       74,   96,  161,   74,  968,  176,   74,   74,   74,  115,
-      346,  203,  112,   75,   97,  100,   75,  100,   74,   75,
-       75,   75,  142,   76,   77,   78,  410,  115,  204,  203,
-      204,  161,   75,  101,  101,  101,  101,  101,  101,  101,
-      101,  101,  101,   85,  115,  115,  370,   74,  102,  143,
-      115,  538,  103,   74,  104,  410,  144,  145,  188,  105,
-
-       75,  106,  107,  201,  146,  205,   89,   75,   79,   77,
-       79,  108,  228,  115,  115,  370,   89,  102,  143,  115,
-      538,  103,   74,  104,  144,  145,   85,  105,  546,  106,
-      107,  201,  146,   85,  205,   75,   78,   77,   78,  108,
-      113,  228,  114,  114,  114,  114,  114,  114,  114,  114,
-      114,  114,  115,  115,  387,  231,  129,  546,  116,  117,
-      130,  138,  118,  188,  139,  242,  131,  140,  119,  243,
-      132,  250,  229,  141,   89,  120,  121,  225,   77,  225,
-      211,  115,  115,  231,  531,  129,  530,  116,  117,  130,
-      138,  118,  139,  242,  131,  140,  119,  243,  132,  250,
-
-      229,  141,  251,  120,  121,  113,  230,  114,  114,  114,
-      114,  114,  114,  114,  114,  114,  114,  347,  124,  359,
-      115,  359,  122,  967,  211,  125,  147,  118,  211,  126,
-      251,  133,  127,  134,  148,  230,  135,  136,  150,  203,
-      149,  123,  128,  137,  188,  347,  151,  124,  573,  115,
-      348,  122,  152,  350,  125,  147,  118,  126,  153,  133,
-      127,  134,  157,  148,  135,  136,  168,  150,  149,  123,
-      128,  137,  115,  169,  188,  151,  158,  573,  348,  159,
-      152,  350,  160,  170,  207,  154,  153,  155,  244,  162,
-      387,  157,  156,  163,  675,  168,  676,  164,  576,  115,
-
-      604,  115,  169,  245,  158,  165,  171,  159,  166,  167,
-      160,  170,  207,  154,  678,  155,  172,  244,  162,  804,
-      156,  389,  163,   78,   77,   80,  164,  576,  115,  604,
-      677,  245,  676,  165,   93,  171,  166,  167,  183,  184,
-      185,   94,   95,  678,  172,  173,   77,  174,  175,  389,
-      188,  392,  677,  176,  676,  189,  186,  186,  186,  186,
-      186,  186,  186,  186,  186,  186,   79,   77,   79,   93,
-       79,   77,   79,   79,   77,   79,   94,   95,  115,  392,
-      177,  178,  208,   74,  179,  208,  180,  190,   89,  198,
-      248,  188,  142,  176,  233,  234,  233,  181,  182,  176,
-
-      249,  191,  235,  236,  224,  208,   89,  115,  208,  177,
-      178,  349,   74,  179,   85,  180,  190,  198,  836,  248,
-      142,  210,  211,  210,  203,  181,  182,  211,  249,  191,
-      192,  194,  224,  212,  208,   93,  176,  208,  387,  349,
-      356,  387,   94,   95,  110,  188,  193,  193,  193,  193,
-      193,  193,  193,  193,  193,  193,  197,  391,  195,  213,
-      129,  372,  373,  372,  130,  125,   74,  237,  356,  126,
-      131,  188,  196,  214,  132,  387,  378,  354,  115,  203,
-       75,  211,  128,  143,  972,  197,  391,  195,  213,  129,
-      144,  199,  168,  130,  125,   74,  237,  126,  131,  169,
-
-      196,  214,  132,  355,  378,  393,  354,  115,   75,  170,
-      128,  369,  143,  375,  376,  375,  200,  188,  144,  199,
-      794,  168,  394,   77,  394,  731,   89,  234,  169,  724,
-      373,  234,  355,  393,  401,  236,  554,  170,  401,  236,
-      369,  559,  560,  559,  200,  209,  210,  211,  210,  209,
-      209,  209,  215,  209,  209,  209,  209,  209,  209,  209,
-      209,  209,  216,  209,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  209,  209,  209,  209,  209,  195,
-      218,  218,  218,  218,  219,  218,  125,  218,  218,  218,
-      220,  218,  218,  196,  218,  218,  218,  218,  221,  218,
-
-      218,  218,  218,  222,  218,  209,  209,  218,  195,  218,
-      218,  218,  218,  219,  218,  125,  218,  218,  220,  218,
-      218,  196,  218,  218,  218,  218,  221,  218,  218,  218,
-      218,  222,  218,  209,   93,  239,  240,  246,  204,  203,
-      204,   94,   95,  395,  554,  396,  211,  802,  241,  803,
-      680,  110,  247,  111,  111,  111,  111,  111,  111,  111,
-      111,  111,  111,  587,  239,  240,  246,  375,  376,  375,
-      586,  395,  339,  396,  340,  205,  241,  258,  377,  680,
-      247,  387,  584,  238,  257,  257,  257,  257,  257,  257,
-      257,  257,  257,  257,  115,   85,  115,  261,  388,  115,
-
-      115,  115,  115,  268,  205,  115,  583,  377,  115,   89,
-     1161,  238,  100,  115,  100,  115,  115,   85,  259,  115,
-      387,  387,  115,  115,  341,  115,  261,  388,  115,  115,
-      115,  115,  268,  211,  115,  397,  419,  115,   89, 1161,
-      211,  115,  421,  115,  115,  102,  259,  115,  115,  103,
-      115,  104,  341,  115,  411,  390,  105,  450,  106,  107,
-      417,  400,  260,  397,  419,  234,  398,  115,  108,  294,
-      421,  294,  401,  236,  102,  373,  188,  115,  103,  295,
-      104,  399,  115,  390,  105,  450,  106,  107,  681,  400,
-      260,  420,  412,  418,  398,  115,  108,  253,  253,  253,
-
-      253,  253,  253,  253,  253,  253,  253,  115,  264,  399,
-      211,  416,  115,  115,  115,  254,  255,  681,  262,  115,
-      412,  418,  263,  415,   89,  265,  115,  115,  256,  414,
-      233,  234,  233,  115,  349,  258,  115,  264,  235,  236,
-      532,  115,  115,  115,  254,  255,  262,  115,  115,  266,
-      413,  263,  115,  265,  115,  115,  256,  344,  115,  387,
-      580,  115,  349,  115,  211,  533,  115,  534,  532,  188,
-      974,  345,  115,  535,  211,  265,  115,  115,  266,  115,
-      203,  115,  536,  115,  115,  188,  344,  115,  115,  580,
-      267,  537,  115,  533,  115,  534,  342,  269,  115,  345,
-
-      115,  535,  115,  265,  804,  115,  803,  542,  115,  115,
-      536,  188,  115,  115,  115,  342,   93,  115,  267,  537,
-       89,  270,  271,   94,   95,  269,  115,  272,  115,  115,
-      115,  273,  274,  387,  115,  115,  542,  115,  115,  292,
-      115,  292,  547,  115,  233,  234,  233,  275,  115,  270,
-      271,  115,  235,  236,  115,  272,  115,  682,  115,  402,
-      273,  274,   89,  115,  115,  387,  115,   85,  569,  115,
-      547,  380,  211,  380,  188,  275,  115,  203, 1161,  115,
-      211,   93,  115,  276,  188,  276,  682,  402,   94,   95,
-      203,  475,  188,  568,  387,  115,  569,  572,   70,  113,
-
-      115,  277,  277,  277,  277,  277,  277,  277,  277,  277,
-      277,  115,  203,  281,  115,  115,  115,   66,  282,  475,
-      115,  568,  280,   85,  115,  572,  544,  543,  555,  115,
-      115,  570,  562,  403,  115,  804,  278,  803,  279,  188,
-      115,  281,  115,  211,  115,  115,  115,  282,  115,  115,
-      280,  115, 1077,  115,  544,  543,  578,  555,  115,  570,
-      562,  403,  115,  284,  278,  115,  279,  115,  283,  115,
-      211,  115, 1100,  115,  115,  115,  115,  115,  115,  285,
-      115,  563,  115,  289,  288,  578,  286,  575,  115, 1161,
-      287,  284,  115,  115,  585,  115,  283,   85,  115, 1139,
-
-      115,  211,  115,  115,  115,  115,  640,  115,  285,  115,
-      563,  289,  288,  561,  286,  575,  115,  292,  287,  292,
-      115,  290,  585,  115,  115,   89,  294,  115,  294,  115,
-      203,  683,  115,  115,  640, 1161,  295,  291,  115,  387,
-      679,  561,  296,  115,  577,  564,  115, 1161,  188,  290,
-      115,  115,  466,  115,  466,  115,  115,  115,  115,  261,
-      683,  115,  115,  301,  115,  291, 1161,  571,  679,  293,
-      296,  115,  577,  564,  115,  579,  115, 1161,  115,  115,
-      115, 1161,  297,  467,  115,  115,  115,  697,  261,  697,
-     1140,  115,  301,  115,  298,  571,  299,  293,  688,  300,
-
-      115, 1161,  115,  579,  115,  115,  115,  115,  203,  115,
-      484,  297,  484,  691,  115,  303,  574,   77,  574,  115,
-      485,  115,  298,  302,  299,  115,  688,  300,  304,  115,
-      115,  115,  717,  115,  115,  203,  115,  115,  115, 1161,
-     1161,  691,  115,  303,  115,  305,  692,  115, 1161,  115,
-      306,  302,  115,  704,  115, 1161,  115,  304, 1161,  115,
-      188,  717,  115,  115,  115, 1161,  115,  115,  115,  115,
-     1161,  115,  115,  305,  692,  308,  307,  488,  306,  488,
-      115,  704,  115,  115,  115, 1161,  115,  489, 1161,  115,
-      310,  115,  115,  115,  115, 1150,  689,  115,  115,  521,
-
-      309,  521, 1161,  308,  307,  311,  752, 1161,  115,  522,
-      115,  115,  115,  239,  240,  115,  115,  115,  115,  310,
-      115,  115,   93,  115,  315,  689,  241, 1161,  309,   94,
-       95,  312,  115,  311,  752,  115,  115,  115,  559,  560,
-      559,  115,  239,  240, 1161,  115,  115,  753, 1161,  313,
-      115,  115,  314,  315,  241,  115,  318,  115, 1161,  312,
-      115,  115,  115,  115,  755,  316,  115,  556,  203,  556,
-      756,  317,  581,  211,  115,  753,  115,  313, 1161,  115,
-      314,  359,  115,  359,  115,  318,  115,  115,  319,  115,
-      320,  115,  755,  115,  316,  556,  203,  556,  756,  317,
-
-      581,  115,  115,  324,  115, 1161,  321,  322,  557,  188,
-      323,  115,  720,  115,  360,  211,  115,  319,  115,  320,
-      115,  203,  115,  705,  325,  115,  326,  211,  361,  115,
-     1161,  324,  115,  327,  321,  322,  557,  557,  323,  115,
-      115,  720,  115,  360,  387,  115,  815,  115,  815,  115,
-      759,  705,  325,  211,  115,  326,  361,  328,  687,  115,
-      115,  327,  708,  329,   93,  557,  808,  115,  115,  115,
-      703,   94,   95,   85,  115,  387,  707,  330,  759,  713,
-      265, 1161,  115,  115,  331,  328,  687,  115,  115,  706,
-      708,  697,  329,  697,  808,  332,  714,  115,  703,  851,
-
-      582, 1161,  115,  387,  707,  330,  722,  713,  265,  115,
-      115,   89,  115,  331,  115,  115, 1161,  115,  706,  335,
-      115, 1161,  333,  332,  715,  714,  334,  851,  115,  582,
-      115,  387,  115, 1161,  115,  722,  859,  115,  115, 1161,
-      336,  115, 1161,  115,  115,  337,  115,  725,  335,  115,
-      333,  115,  716,  715,  334, 1161,  115,  719,   77,  719,
-      115,  115,  115,  115,  859,   93,  115,  744,  115,  336,
-      115,  338,   94,   95,  337,  115,  725,   93,  754,  115,
-      760,  716,  115,  188,  729,  730, 1161, 1161,  115,  693,
-     1161,  693,  115,  342,  184,  351,  744,  115,  861,  694,
-
-      338,  727,  806,  635,  815,  635,  815,  754,  862,  760,
-      115,  352,  352,  352,  352,  352,  352,  352,  352,  352,
-      352,  353,  807,  810, 1161,  805,  861,  176,  387, 1161,
-      727,  806,  813,  608,  636,  608,  862,  352,  352,  352,
-      352,  352,  352,  352,  352,  352,  352,  353,  700,  827,
-      700,  807,  810,  176,  805,  804,  184,  809,  701, 1161,
-      203,  813,  702,  352,  352,  352,  352,  352,  352,  352,
-      352,  352,  352,  353,  748,  380,  211,  380,  827,  176,
-      826,  211,  826,  856,  826,  211,  826,  110,  749,  357,
-      357,  357,  357,  357,  357,  357,  357,  357,  357,  115,
-
-      820,  115,  115,  748,  115,  857,  115,  115,  381, 1161,
-      267,  757,  856,  270,  363,  188,  749,  362,  115,  272,
-      115,  364,  382,  832,   77,  832,  203,  758,  115,  820,
-      115,  115,  211,  115,  857,  115,  115,  381,  267,  115,
-      757,  270,  363, 1161,  115,  362,  115,  272,  115,  364,
-      382,  811,  702,  365,  702,  758,  115, 1161,  115,  115,
-      115,  115,  297,  368,  115,  115,  702,  860,  115,  863,
-     1161,  367,  824,  115,  298,  115,  299,  821,  115,  366,
-      811,  365,  864,  901, 1161,  115,  115, 1161,  115,  115,
-      115,  297,  368,  115,  115,  211,  860, 1161,  863,  367,
-
-     1161,  824,  298,  115,  299,  821,  115,  366, 1161, 1161,
-      864,  901,  383,  383,  383,  383,  383,  383,  383,  383,
-      383,  383,  374,  374,  211,  374,  374,  374,  374,  374,
-      374,  374,  374,  374,  374,  374,  374,  374,  374,  384,
-      374,  385,  385,  385,  385,  385,  385,  385,  385,  385,
-      385,  374,  374,  374,  374,  374,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  374,  374,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      374,  404, 1161,  404,  932,  865,  405,  405,  405,  405,
-      405,  405,  405,  405,  405,  405,  406, 1161,  406,  935,
-      899,  407,  407,  407,  407,  407,  407,  407,  407,  407,
-      407,  408,  932,  408,  865,  900,  409,  409,  409,  409,
-      409,  409,  409,  409,  409,  409,  423,  935,  423,  899,
-     1161,  424,  424,  424,  424,  424,  424,  424,  424,  424,
-      424,  425, 1161,  425,  900, 1161,  426,  426,  426,  426,
-      426,  426,  426,  426,  426,  426,  427,  902,  427,  432,
-      937,  428,  428,  428,  428,  428,  428,  428,  428,  428,
-
-      428,  257,  257,  257,  257,  257,  257,  257,  257,  257,
-      257, 1161,  115,  769,  115,  769,  902,  115,  937,  115,
-      429,  430,  430,  430,  430,  430,  430,  430,  430,  430,
-      430,  115,  433,  115,  115,  905,  908,  115,  908,  115,
-      431,  115,  115,  115,  770,  434,  115,   93,  115,  429,
-      908,  435,  908,  115,  839,  840,  115,  115,  211,  115,
-      433,  115,  115,  115,  905,  693,  115,  693,  115,  431,
-      436,  115, 1161,  434, 1161,  694,  115,  115,  115,  435,
-      115,  115,  115,  115,  115,  115,  115,  804,  439,  803,
-      437,  115, 1161, 1161,  822,  176,  115,  115,  436,  115,
-
-      438,  805,  924,  115,  115,  188,  115,  115,  115,  115,
-      115,  115,  115, 1161,  115,  115,  439, 1161,  437, 1161,
-      441,  440,  115,  822,  115,  115, 1161,  115,  438,  115,
-      805,  924,  115,  115, 1161,  115,  203,  115,  115,  115,
-      115,  115,  903, 1161,  115,  700,  115,  700,  441,  440,
-      115,  442,  115,  443,  445,  701,  444,  115,  115,  702,
-      115, 1161,  115,  115,  115,  446,   93,  115, 1161,  115,
-      115,  903,  911,   94,   95,  115, 1161,  115,  115,  442,
-      115,  443,  445,  115,  444,  115, 1161,  115,  115,  447,
-      115,   93,  115,  893,  446,  893,  448,  115,   94,   95,
-
-     1161,  911, 1161,  894,  115,  115, 1161,  115,  115,  451,
-      929,  115,  115,  115,  115,  449,  115,  447,  965,  115,
-      931,  804,  184,  809,  448,  115,  203,  115,  115,  176,
-      115,  453,  115,  115,  211,  452,  115,  115,  451,  929,
-      115,  466,  115,  466,  449,  115,  965,  115,  115,  931,
-      115,  933,  454,  115, 1161,  115,  934,  115,  115,  936,
-      453,  980,  115,  910,  452,  115, 1161,  115,  115, 1161,
-     1161,  913,  467,  115,  115,  115,  465,  115,  115,  115,
-      933,  454,  115,   93,  875,  934,  875,  115,  936,  980,
-       94,   95,  910,  115,  876,  115,  455,  115,  455,  115,
-
-      913,  959,  115,  115,  115,  465,  115,  964,  115,  239,
-      240,  115,   93,  966,  893,  115,  893,  468,  469,   94,
-       95,  115,  241, 1161,  894,  115, 1161,  456,  115,  115,
-      959,  203,  457,  115,  458,  115,  964,  459,  239,  240,
-      115,  460,  966, 1161,  461,  468,  469,  462,  463,  472,
-      241,  464,  115,  115,  115,  115,  470,  115,  115,  471,
-      115,  457,  989,  458,  991,  884,  459,  884,  115,  460,
-     1161,  115,  461, 1161,  115,  462,  463,  981,  472,  464,
-      973,  115,  115,  115,  115,  470,  115,  115,  471,  115,
-      115,  989,  474,  991,  473,  115,  115,  984,  115,  115,
-
-      986,  115,  115,  115,  896,  981,  896,  987,  973,  115,
-     1161,  115,  476,  954, 1161,  115,  115,  115,  988,  115,
-      115,  474,  473,  990,  115,  984,  477,  115,  986,  115,
-     1010,  115,  115, 1161,  115,  987,  115,  115,  115,  961,
-      476,  954,  478,  115,  115,  115,  988, 1161, 1005,  115,
-      115,  990, 1161, 1013,  477, 1161, 1161,  115,  479, 1010,
-      115,  115,  115, 1161, 1161,  115,  115,  115,  961, 1014,
-      478, 1027,  115,  998,  948,  998, 1005, 1015,  115,  203,
-      115,  480, 1013,  115,  115,  115,  479,  481,  115,  115,
-      115,  484,  483,  484,  488,  115,  488, 1014,  188, 1027,
-
-      482,  485,  115,  115,  489, 1017, 1015, 1018,  115,  480,
-     1161, 1161,  115,  115, 1035, 1021,  481,  115,  115, 1036,
-      115,  483,  203, 1028,  115,  115, 1031,  115,  482,  115,
-      115,  115,  115, 1016, 1017,  486, 1018, 1161,  490,  115,
-      492, 1032, 1035,  115, 1021,  487,  115, 1036,  491,  115,
-     1043, 1161, 1028,  115,  115, 1031,  115, 1161,  115, 1022,
-      115,  115, 1016,  486,  493,  115,  490,  115,  492, 1033,
-     1032,  115,  115,  487,  115, 1034,  491,  115, 1043,  115,
-      115,  115, 1045,  188,  495,  115,  115, 1161, 1022,  115,
-     1046,  494,  496,  493,  115, 1161, 1161,  115, 1033,  115,
-
-      115,  115,  115, 1050, 1034, 1161,  115,  115, 1161,  115,
-      115, 1045, 1049,  495,  115,  115,  115,  115, 1046,  494,
-      496,  497,  115, 1041,  948, 1041,  115,  115,  115, 1051,
-      498,  115, 1050,  115,  115, 1161,  115,  500,  115,  115,
-     1049,  499,  115,  852,  115,  852,  115, 1052, 1161,  497,
-     1161,  115,  115,  115,  115, 1161,  115, 1051,  498,  115,
-     1053, 1161,  115,  115,  115, 1061,  500,  115,  115, 1060,
-      499,  115,  501,  115,  115, 1161, 1052,  115,  925,  115,
-      115,  115,  115,  115,  115,  203, 1064,  502,  115, 1053,
-      503,  926, 1065,  115, 1061, 1161,  115, 1060,  504, 1066,
-
-      501,  115,  203,  115,  115,  211,  115,  925,  115,  115,
-      505,  115, 1161, 1161, 1064,  502, 1072, 1056,  503,  926,
-     1065,  115, 1076,  115,  115,  115,  504, 1066, 1161,  115,
-      115, 1161,  507,  115,  115, 1161,  506,  115,  115,  505,
-      508, 1057,  115, 1161,  115, 1072, 1056, 1055,  115, 1075,
-     1076,  115, 1161,  211,  115, 1079,  115,  509,  115,  115,
-      115,  507,  115,  115,  506,  115,  115,  115,  508,  115,
-     1057,  115,  115, 1078,  115, 1055,  115,  512, 1075,  115,
-      510,  115,  511, 1079,  115,  509, 1161, 1161,  115,  115,
-     1161,  115,  115, 1058,  115,  115,  115,  115,  115,  513,
-
-      115, 1161, 1078,  115, 1085,  515,  512,  115,  510,  115,
-      511,  115,  115, 1161,  115,  115,  115,  115,  115,  514,
-      115,  115, 1058,  115,  115,  516,  115, 1086,  513,  115,
-      211,  517, 1085,  515,  115, 1161,  203,  115,  115,  115,
-     1161,  115,  115,  115,  115,  115,  115,  115,  514,  115,
-      115,  211,  115,  521,  516,  521, 1086,  518, 1161,  517,
-      519,  115,  115,  522,  115,  115,  115,  115, 1070,  948,
-     1070, 1081,  115, 1161,  115, 1084, 1089, 1161,  520,  115,
-      115, 1090,  115,  203, 1083,  518,  115,  115,  519,  523,
-      115,  115,  115,  115, 1094,  115, 1161, 1096,  115,  524,
-
-     1081,  115,  115, 1084, 1089,  115,  520,  115,  115, 1097,
-     1090,  115,  115, 1083,  526,  115,  115, 1082,  523,  115,
-      115,  115,  115, 1094,  115, 1096, 1099,  115,  524,  115,
-     1161,  115,  525,  115, 1161, 1161,  115, 1097,  115,  115,
-      115, 1103,  526, 1161,  115,  115, 1082, 1111,  115,  115,
-      115, 1161,  211,  115, 1099, 1104,  527, 1107,  115,  211,
-      525,  947,  948,  947,  528, 1161,  115, 1161,  115,  949,
-     1103,  203,  950,  115,  115,  531, 1111,  539, 1161,  115,
-      947,  948,  947, 1104,  527, 1107,  115, 1023,  949, 1024,
-     1161,  950,  528,  540,  540,  540,  540,  540,  540,  540,
-
-      540,  540,  540,  541,  947,  948,  947, 1101, 1161,  176,
-     1161, 1102,  949, 1161,  188,  950, 1023, 1161, 1024,  540,
-      540,  540,  540,  540,  540,  540,  540,  540,  540,  541,
-     1000, 1001, 1000, 1161, 1161,  176, 1101,  188, 1002, 1102,
-     1161, 1003, 1092,  948, 1092,  540,  540,  540,  540,  540,
-      540,  540,  540,  540,  540,  541, 1109,  948, 1109, 1098,
-     1115,  176,  115,  115, 1161,  550,  548,  115,  115,  110,
-      115,  545,  545,  545,  545,  545,  545,  545,  545,  545,
-      545,  115,  549, 1114,  115,  115,  551, 1098, 1115, 1120,
-      115,  115,  115,  554,  550,  548,  115,  115, 1121,  115,
-
-     1161,  115, 1161, 1161,  115,  552,  115, 1161, 1161,  115,
-      549, 1114,  115, 1127,  115,  551, 1123, 1120,  482,  115,
-      115,  115, 1161,  115,  115,  553,  115, 1121,  115,  115,
-      115,  203,  115, 1161,  552,  115,  947,  948,  947, 1129,
-      115, 1127,  115,  115,  949, 1123,  482,  950,  115, 1161,
-      115,  203,  115,  115,  553,  115,  211,  115,  115, 1161,
-     1161, 1000, 1001, 1000, 1161, 1161, 1116, 1129,  115, 1002,
-      115,  115, 1003,  383,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  211, 1161, 1000, 1001, 1000, 1117, 1118,
-     1117, 1161,  565, 1002, 1132, 1116, 1003, 1131, 1136, 1161,
-
-      566,  566,  566,  566,  566,  566,  566,  566,  566,  566,
-      211, 1161, 1042, 1001, 1042, 1117, 1118, 1117, 1142,  567,
-      949,  565, 1132,  950, 1161, 1131, 1136,  383,  383,  383,
-      383,  383,  383,  383,  383,  383,  383,  405,  405,  405,
-      405,  405,  405,  405,  405,  405,  405, 1142,  567,  405,
-      405,  405,  405,  405,  405,  405,  405,  405,  405,  407,
-      407,  407,  407,  407,  407,  407,  407,  407,  407,  407,
-      407,  407,  407,  407,  407,  407,  407,  407,  407,  409,
-      409,  409,  409,  409,  409,  409,  409,  409,  409,  409,
-      409,  409,  409,  409,  409,  409,  409,  409,  409,  424,
-
-      424,  424,  424,  424,  424,  424,  424,  424,  424,  424,
-      424,  424,  424,  424,  424,  424,  424,  424,  424,  426,
-      426,  426,  426,  426,  426,  426,  426,  426,  426,  426,
-      426,  426,  426,  426,  426,  426,  426,  426,  426,  428,
-      428,  428,  428,  428,  428,  428,  428,  428,  428,  428,
-      428,  428,  428,  428,  428,  428,  428,  428,  428,  588,
-      211,  588, 1161, 1161,  589,  589,  589,  589,  589,  589,
-      589,  589,  589,  589,  430,  430,  430,  430,  430,  430,
-      430,  430,  430,  430, 1161,  115, 1161,  115, 1161,  590,
-      115,  590,  115,  429,  591,  591,  591,  591,  591,  591,
-
-      591,  591,  591,  591,  115,  592,  115,  115,  115,  593,
-      203, 1119,  115,  115,  115, 1161,  115, 1141,  188,  115,
-     1161,  115,  429, 1161,  115, 1161,  115,  115,  594,  115,
-      115, 1161,  115,  592,  115,  115,  115,  115,  593, 1119,
-     1161,  115,  115,  115, 1161, 1141,  115,  203,  595,  115,
-     1149,  115, 1161,  115,  115,  115, 1146,  594,  115,  115,
-     1161, 1161,  596, 1161,  115,  115,  188,  115,  115,  115,
-     1161,  115,  597,  115,  115,  115,  595,  115,  188, 1149,
-      115,  115, 1161,  598, 1146,  115,  203,  115,  115,  115,
-      115,  596, 1144,  115,  115,  188,  115,  115,  115,  203,
-
-      599,  597,  115,  115,  115,  115, 1161,  188,  115,  115,
-      115,  598, 1161,  600,  115,  115,  115, 1130,  115,  115,
-     1144,  115,  115,  115,  115,  601,  115,  115,  599, 1143,
-      115, 1157,  115,  602,  115,  115,  115, 1148, 1161,  115,
-      115,  115,  600,  603, 1145, 1130, 1124,  948, 1124,  115,
-      115,  115,  115, 1161,  601,  115,  115, 1143, 1151,  115,
-     1157,  602,  115, 1161,  115, 1148,  188,  115,  115,  115,
-      115,  603, 1145,  605,  115,  115,  203,  115,  606,  115,
-     1161,  115, 1161, 1161,  203,  608, 1151,  608, 1161,  115,
-     1161,  115,  607,  115, 1161, 1161,  115, 1161, 1161,  115,
-
-     1161,  605, 1147,  115,  115, 1161, 1161,  606,  115,  115,
-      115, 1153, 1154, 1153,  115,  115, 1161,  115,  115,  115,
-      607,  115, 1161,  115, 1161, 1155,  609, 1161,  619,  115,
-      620, 1147, 1161,  115, 1161, 1152, 1161,  115, 1161,  115,
-      610,  115, 1161,  115,  115,  115,  621,  115,  115, 1161,
-      115, 1161,  115, 1155,  203,  609,  619,  115,  620,  622,
-      115,  115,  115, 1152,  115,  115, 1161,  115,  610,  455,
-      115,  455, 1161, 1161,  115,  621, 1153, 1154, 1153,  115,
-     1161,  629, 1161, 1161,  115, 1161, 1161,  622,  115,  115,
-     1156,  115,  115, 1159, 1160, 1159,  115, 1159, 1160, 1159,
-
-      456,  623, 1161,  115, 1161,  611,  115,  612, 1161,  629,
-      613,  115,  203,  115,  614, 1161, 1161,  615,  115, 1156,
-      616,  617, 1161, 1161,  618,  115, 1161, 1161, 1161,  623,
-      626,  115, 1161, 1161,  611,  115,  612, 1161,  115,  613,
-      115, 1161,  614,  115, 1161,  615,  115, 1161,  616,  617,
-      624,  115,  618,  115,  115,  115, 1161,  637,  626,  115,
-      115,  627, 1161, 1158, 1161,  115,  625,  115, 1161, 1161,
-     1161, 1161,  115,  115,  115,  115,  628, 1161, 1161,  624,
-      115, 1161, 1161,  115,  115,  637, 1161, 1161,  115,  115,
-      627, 1158, 1161,  115,  625, 1161, 1161, 1161, 1161, 1161,
-
-     1161,  115,  115, 1161,  628,  630,  630,  630,  630,  630,
-      630,  630,  630,  630,  630,  630, 1161,  630,  630,  630,
-      630,  630,  631,  630,  632,  632,  632,  632,  632,  632,
-      632,  632,  632,  632,  630,  630,  630,  630,  630,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  633,  633,  630,  630,  633,  633,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
-      633,  633,  633,  630,  115, 1161,  635,  638,  635,  115,
-
-     1161, 1161,  115,  115, 1000, 1001, 1000, 1161,  115, 1161,
-     1161,  634, 1002,  115, 1161, 1003,  115, 1161, 1161, 1161,
-     1161, 1161,  639,  115, 1161, 1161,  638,  636,  115,  115,
-      115,  115,  115, 1161,  115,  115, 1161,  115,  115,  634,
-     1161,  115, 1161,  115,  115, 1161,  641, 1161,  115,  115,
-      639, 1161, 1161, 1161, 1161, 1161, 1161,  115,  115,  115,
-      115, 1161, 1161,  115,  115,  115, 1161,  115,  115, 1161,
-     1161, 1161,  115,  115, 1161,  641,  115,  115, 1161,  115,
-      642, 1161, 1161, 1161, 1161,  115, 1161,  643, 1161,  115,
-      115, 1161, 1161, 1161,  115,  115, 1161,  115,  644,  115,
-
-     1161, 1161,  115, 1161,  115,  645, 1161,  115,  642,  115,
-     1161, 1161,  646, 1161, 1161,  643, 1161, 1161,  115,  115,
-     1161, 1000, 1001, 1000,  115, 1161, 1161,  644,  115, 1002,
-      115,  650, 1003,  115,  645,  115,  115,  115,  647,  115,
-      646,  648,  115, 1161,  115, 1161,  115,  115, 1161,  115,
-      115, 1161, 1161, 1161, 1161, 1161,  649, 1161,  115,  115,
-      650,  115, 1161, 1161,  115,  115, 1161,  647,  115,  115,
-      648,  115, 1161,  115,  115,  652,  115,  115,  115, 1161,
-      115, 1161, 1161,  651,  649, 1161,  115, 1161,  115,  115,
-     1161,  115, 1161, 1161,  115,  115,  115, 1161,  115, 1161,
-
-      115, 1161,  653,  115,  652, 1161,  654,  115, 1161,  115,
-      115,  651,  115, 1161,  115, 1161,  115, 1161,  115, 1161,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1161,  115,
-      653, 1161,  115, 1161,  654,  655,  115,  115,  115,  115,
-     1161,  115,  115,  115,  115, 1161,  115,  115,  115, 1161,
-      115, 1161,  115, 1161,  115,  115,  115, 1161,  115, 1161,
-     1161,  115,  115, 1161,  655,  115,  115, 1161,  115,  659,
-      115,  115,  115,  115,  115,  115, 1161,  115, 1161,  115,
-      656, 1161,  657, 1161,  115,  115,  115,  115, 1161,  115,
-      115,  658,  115,  115, 1161,  115,  661,  659,  115,  115,
-
-      115,  115, 1161, 1161,  115, 1161,  115, 1161,  656, 1161,
-      657, 1161,  660,  115, 1161,  115,  115,  115,  115,  115,
-      658,  115,  115,  115,  115,  661, 1161,  115, 1161,  664,
-      115, 1071,  948, 1071,  115,  662, 1161,  115,  115,  949,
-      660,  115,  950,  115, 1161, 1161,  115,  115,  115,  663,
-      115, 1161,  115,  115, 1161,  115, 1161,  115, 1161, 1161,
-      115, 1161,  115,  662, 1161,  115,  115, 1161, 1161,  115,
-      115, 1161, 1161, 1161,  665,  115,  115, 1161,  663,  115,
-     1161, 1161,  115, 1161,  115, 1161,  115,  115,  115,  115,
-      115,  115, 1161,  666,  115,  115, 1161,  115, 1161, 1161,
-
-     1161,  115,  665,  668,  115, 1161,  667, 1161,  115,  115,
-     1161,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,
-      115,  666,  115,  115,  115,  115, 1161,  115,  115,  115,
-      669,  668, 1161,  115,  667, 1161,  115,  115,  670,  115,
-     1161,  115, 1161, 1161, 1161,  115, 1161,  115, 1161,  115,
-      115,  115, 1161,  115,  115, 1161,  115,  115,  115,  669,
-     1161,  115,  115, 1161,  115,  115,  115,  115, 1161,  115,
-      115, 1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115,
-      115, 1161,  115, 1161,  115, 1161,  115,  115,  115, 1161,
-      115,  115,  115,  115,  115,  115, 1161, 1161, 1161,  115,
-
-      115, 1161,  671, 1161, 1161,  115, 1161,  115,  115,  115,
-     1161, 1161,  115,  672,  115,  115, 1161,  115,  115, 1161,
-      115,  115,  115,  115, 1161, 1161,  115, 1161,  115, 1161,
-      671, 1161, 1161,  115, 1161,  115, 1161,  115,  115, 1161,
-      115,  115,  672,  115,  115,  673,  115,  115,  674,  115,
-      115, 1161,  115, 1161, 1161,  115,  115, 1161, 1161, 1161,
-      115,  698, 1161,  115, 1161,  115,  115, 1161,  115, 1161,
-      115, 1161, 1161,  115,  673,  115, 1161,  674,  115,  677,
-      115,  684, 1161, 1161, 1161, 1093,  948, 1093,  115, 1161,
-      698,  115, 1161,  949, 1161,  115,  950,  685,  685,  685,
-
-      685,  685,  685,  685,  685,  685,  685,  686,  115, 1110,
-      948, 1110, 1161,  176, 1161, 1161, 1161,  949, 1161, 1161,
-      950, 1161, 1161,  685,  685,  685,  685,  685,  685,  685,
-      685,  685,  685,  686,  693, 1161,  693, 1161, 1161,  176,
-     1161, 1161, 1161, 1161,  694, 1161, 1161, 1161, 1161,  685,
-      685,  685,  685,  685,  685,  685,  685,  685,  685,  686,
-      697, 1161,  697, 1161, 1161,  176,  696,  115, 1161, 1161,
-      695,  115,  115,  110,  600,  690,  690,  690,  690,  690,
-      690,  690,  690,  690,  690,  115,  115, 1161, 1161, 1161,
-     1161, 1161, 1161,  115, 1161,  696,  115, 1161,  115,  695,
-
-      115,  115,  115,  600, 1161,  115, 1161,  115,  645,  732,
-      115, 1161,  115,  115,  115,  646, 1161, 1161,  700,  699,
-      700,  115,  115, 1161,  115, 1161, 1161,  115,  701, 1161,
-     1161,  115,  702, 1161,  115, 1161,  115,  645,  732,  115,
-      115,  211, 1161,  646, 1161, 1161, 1161,  699, 1161,  115,
-     1161,  115,  115,  709, 1161,  709,  115, 1161,  710,  710,
-      710,  710,  710,  710,  710,  710,  710,  710, 1161,  211,
-      115, 1126,  948, 1126, 1161, 1161, 1161, 1161, 1161,  949,
-      115, 1161,  950, 1161, 1161,  115,  566,  566,  566,  566,
-      566,  566,  566,  566,  566,  566,  211, 1161,  115, 1161,
-
-     1161,  947,  948,  947, 1161,  565, 1161, 1161,  711,  949,
-      711, 1161,  950,  712,  712,  712,  712,  712,  712,  712,
-      712,  712,  712,  589,  589,  589,  589,  589,  589,  589,
-      589,  589,  589, 1161,  565,  589,  589,  589,  589,  589,
-      589,  589,  589,  589,  589,  591,  591,  591,  591,  591,
-      591,  591,  591,  591,  591,  591,  591,  591,  591,  591,
-      591,  591,  591,  591,  591,  733, 1161, 1161,  115, 1161,
-      115, 1161, 1161,  115,  947,  948,  947, 1161, 1000, 1001,
-     1000, 1161,  949,  737,  115,  950, 1002,  115, 1161, 1003,
-     1161, 1161, 1161, 1161,  733, 1161, 1161,  115, 1161,  115,
-
-     1161, 1161,  115, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161,  737,  115,  718,  718,  115,  718,  718,  718,  718,
-      718,  718,  718,  718,  718,  718,  718,  718,  718,  718,
-      734,  718,  735,  735,  735,  735,  735,  735,  735,  735,
-      735,  735,  718,  718,  718,  718,  718,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-      736,  736,  736,  718,  718,  736,  736,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
-
-      736,  718,  115,  115,  738,  115,  115,  115,  115,  115,
-      115,  115, 1161,  740,  115, 1161, 1161, 1161,  739,  741,
-     1161,  115,  115, 1161,  115,  115, 1161, 1161,  115, 1161,
-     1161,  115,  115,  738,  115,  115,  115,  115,  115,  115,
-      115, 1161,  740,  115, 1161, 1161,  739,  741, 1161,  115,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1161,  115,
-      115,  115,  115, 1161, 1161,  745,  115, 1161, 1161,  742,
-     1161, 1161, 1161,  115,  115,  743,  115, 1161, 1161, 1161,
-      115, 1161, 1161,  115,  115, 1161,  115,  115,  115,  115,
-      115,  115,  115, 1161,  745,  115, 1161,  742,  746, 1161,
-
-     1161,  115,  115,  743,  115, 1161,  115, 1161,  115,  115,
-      115, 1161, 1161,  115,  750,  115,  115,  747,  115, 1161,
-      751,  115, 1161, 1161, 1161, 1161,  746, 1161,  115,  115,
-     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
-      115,  115,  115,  750,  115, 1161,  747,  115, 1161,  751,
-     1161, 1161, 1161, 1161,  115,  115,  115,  115,  115, 1161,
-      115, 1161, 1161,  115,  115,  115, 1161, 1161, 1161,  115,
-      115,  761, 1161, 1161,  115,  115, 1161,  115,  762,  115,
-      115, 1161,  115,  115, 1161, 1161, 1161,  115,  763, 1161,
-     1161,  115,  115,  115,  115, 1161,  115, 1161, 1161,  761,
-
-     1161, 1161,  764,  115,  115,  115, 1161,  762,  115,  115,
-      115, 1161,  115,  765,  115, 1161,  763,  115,  768,  115,
-      115,  115,  115,  115, 1161,  115, 1161, 1161, 1161,  766,
-      764,  115, 1161,  115, 1161,  115, 1161,  115,  115,  767,
-      115,  115,  765,  115, 1161, 1161,  115,  768,  115, 1161,
-     1161, 1161,  115,  769,  115,  769, 1161,  766, 1161,  115,
-     1161,  115, 1161,  258,  115,  115, 1161, 1161,  767,  115,
-      257,  257,  257,  257,  257,  257,  257,  257,  257,  257,
-      115, 1161,  115,  115,  770,  115,  115,  115,  115,  115,
-     1161,  115,  115, 1161,  115, 1161, 1161, 1161, 1161,  115,
-
-      771, 1161,  115, 1161, 1161,  115,  115, 1161,  115,  115,
-     1161, 1161,  115, 1161,  115,  115,  115,  115,  115,  115,
-      115,  115, 1161,  115,  115, 1161, 1161,  115,  771, 1161,
-      115, 1161, 1161,  115,  115,  115,  115, 1161,  772,  115,
-      115,  774,  115,  773,  115,  775,  115,  115,  115, 1161,
-     1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115, 1161,
-     1161,  115,  115, 1161,  115,  115,  772,  115,  115,  115,
-      774,  115,  773,  115,  775,  115,  115, 1161, 1161,  776,
-      115,  115,  115,  115, 1161,  115,  115,  777,  115,  115,
-      115,  115,  115,  115,  780, 1161,  115,  115, 1161,  115,
-
-     1161, 1161,  115, 1161,  778,  779, 1161,  776, 1161,  115,
-     1161,  115,  115,  115,  115, 1161,  777,  115, 1161,  115,
-     1161,  115, 1161,  780, 1161, 1161,  115, 1161,  115,  115,
-      115,  781,  778,  779,  115,  115, 1161, 1161, 1161,  115,
-      115,  115, 1161, 1161, 1161, 1161,  782, 1161,  115, 1161,
-     1161, 1161, 1161, 1161,  115, 1161, 1161, 1161,  115, 1161,
-      781,  115, 1161,  115,  115,  115,  115,  783, 1161,  115,
-      115, 1161,  784,  115,  782, 1161,  115,  785,  115, 1161,
-      115, 1161,  115, 1161,  115, 1161, 1161, 1161, 1161, 1161,
-      115, 1161,  115, 1161,  115,  115,  783, 1161,  115,  115,
-
-      784, 1161,  115,  787, 1161,  115,  785,  115,  115,  115,
-      115, 1161,  115,  786,  115, 1161, 1161,  115, 1161, 1161,
-      115, 1161,  788, 1161,  115,  115, 1161,  115,  115,  789,
-      115, 1161,  787, 1161,  115, 1161,  115, 1161,  115,  115,
-     1161,  115,  786,  115,  115,  115, 1161, 1161,  115, 1161,
-      788, 1161,  115,  115,  115,  115,  115,  115,  789,  115,
-     1161,  790,  115, 1161, 1161,  115, 1161,  115,  115,  792,
-      115, 1161,  115,  115,  115, 1161,  115,  115, 1161, 1161,
-     1161, 1161,  115,  115, 1161, 1161,  115,  791,  115, 1161,
-      790,  115, 1161, 1161,  115,  115,  793,  115,  792,  115,
-
-      115,  115,  115,  115,  115,  115,  115, 1161, 1161, 1161,
-     1161, 1161, 1161,  115, 1161,  791,  115, 1161,  795,  115,
-      796, 1161, 1161,  115, 1161,  793,  115, 1161,  115,  115,
-      115,  115, 1161, 1161,  115,  115, 1161,  115, 1161,  797,
-      798,  115,  115, 1161, 1161,  115,  795,  115,  796,  115,
-     1161, 1161, 1161,  115,  115,  115,  115,  115,  115, 1161,
-      115, 1161,  115, 1161, 1161, 1161,  115,  797,  799,  798,
-     1161,  115,  801,  115,  115, 1161,  115,  800,  115,  115,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1161, 1161,
-     1161,  115, 1161,  115, 1161, 1161,  799, 1161, 1161,  115,
-
-      801, 1161, 1161,  115,  115,  800, 1161, 1161,  115,  115,
-     1161, 1161,  176, 1161,  115, 1161, 1161, 1161,  176,  115,
-     1161,  115, 1161,  816,  115, 1161,  110,  115,  111,  111,
-      111,  111,  111,  111,  111,  111,  111,  111,  115,  115,
-      115,  115, 1161, 1161,  115,  115,  819,  817,  115, 1161,
-     1161,  818,  816,  115, 1161, 1161, 1161, 1161,  115,  115,
-      115, 1161, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,
-      115, 1161,  211,  115,  115,  819,  817, 1161, 1161,  818,
-     1161, 1161,  211, 1161, 1161, 1161,  115,  115,  115,  710,
-      710,  710,  710,  710,  710,  710,  710,  710,  710,  710,
-
-      710,  710,  710,  710,  710,  710,  710,  710,  710,  211,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,  211,
-     1161, 1161, 1161, 1161, 1161, 1161,  712,  712,  712,  712,
-      712,  712,  712,  712,  712,  712,  712,  712,  712,  712,
-      712,  712,  712,  712,  712,  712,  823,  823,  211,  823,
-      823,  823,  823,  823,  823,  823,  823,  823,  823,  823,
-      823,  823,  823,  828,  823,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  823,  823,  823,  823,  823,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-
-      830,  830,  830,  830,  830,  830,  823,  823,  830,  830,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
-      830,  830,  830,  830,  823,  832,   77,  832, 1161, 1161,
-      833,  833, 1161,  833, 1161, 1161, 1161,  833,  833, 1161,
-     1161,  833, 1161, 1161,  833,  833,  833,  833,  833,  833,
-      833,  833,  833,  831,  831, 1161,  831,  831,  831,  831,
-      831,  831,  831,  831,  831,  831,  831,  831,  831,  831,
-      841,  831,  842,  842,  842,  842,  842,  842,  842,  842,
-      842,  842,  831,  831,  831,  831,  831,  843,  843,  843,
-
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  843,  843,  831,  831,  843,  843,  843,  843,  843,
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
-      843,  831,  115, 1161, 1161,  258, 1161,  115,  257,  257,
-      257,  257,  257,  257,  257,  257,  257,  257,  115,  845,
-     1161,  844,  115,  115,  115,  115, 1161,  115, 1161, 1161,
-      115,  115, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
-     1161,  115, 1161, 1161,  846,  115, 1161,  115,  845,  844,
-
-      115,  115,  115,  115,  115, 1161,  115,  115, 1161,  115,
-     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
-     1161, 1161,  846,  115,  115, 1161,  115, 1161, 1161,  115,
-      847, 1161, 1161, 1161, 1161, 1161,  115,  115,  848, 1161,
-     1161,  115,  115,  115, 1161,  849, 1161,  115,  115, 1161,
-      115,  115,  115, 1161,  115,  115,  115, 1161,  847,  850,
-     1161,  852,  115,  852, 1161,  115,  848, 1161, 1161,  115,
-      115, 1161,  115,  115,  849, 1161, 1161,  115,  115,  115,
-      115, 1161,  115, 1161,  115,  115,  855,  115,  850, 1161,
-      115, 1161,  115, 1161,  115, 1161,  853,  115,  115,  115,
-
-     1161,  115,  115, 1161, 1161, 1161, 1161,  115, 1161,  854,
-     1161,  115, 1161,  115,  115,  855,  115, 1161,  858,  115,
-      115, 1161, 1161,  115, 1161,  853,  115, 1161,  115,  115,
-     1161,  115, 1161,  115,  115, 1161,  866,  854, 1161,  115,
-     1161,  115, 1161,  115, 1161,  115,  867,  858,  115, 1161,
-     1161,  115, 1161,  115, 1161,  115,  115,  868, 1161, 1161,
-      115,  115, 1161,  115, 1161,  866, 1161, 1161,  115, 1161,
-      115,  115,  115,  115,  867,  869,  115,  115,  115, 1161,
-      115,  115,  871,  115, 1161,  115,  868, 1161, 1161,  870,
-      115,  115, 1161, 1161,  874, 1161, 1161,  115,  115,  115,
-
-      115,  115, 1161,  115,  869,  115,  115,  115,  115, 1161,
-      115,  871,  115,  115,  875,  115,  875,  870,  115,  115,
-      872,  873,  115,  874,  876,  115,  115, 1161,  115,  115,
-     1161,  115,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
-      877,  115, 1161, 1161,  115,  115,  115,  115,  872,  873,
-      115,  115,  115, 1161,  878,  115, 1161,  115,  115, 1161,
-      115, 1161,  879,  115, 1161,  115,  115,  115,  877,  115,
-     1161,  880,  115,  115,  115,  115,  115,  115, 1161, 1161,
-      115,  115, 1161,  878, 1161, 1161,  115,  115,  115, 1161,
-      115,  879,  115,  115,  115,  115,  115, 1161,  115,  115,
-
-      880,  115, 1161,  115,  115,  115, 1161,  881, 1161,  115,
-      115, 1161, 1161, 1161,  115,  115,  115,  882,  115,  115,
-     1161,  883,  115, 1161,  115, 1161, 1161,  115,  115,  115,
-     1161,  115, 1161,  115, 1161,  881,  115,  115, 1161,  115,
-     1161,  115,  115,  115,  115,  882,  115,  115,  115,  883,
-      115,  115, 1161,  884, 1161,  884,  115,  115, 1161, 1161,
-      115,  115,  115,  115, 1161,  115, 1161, 1161,  115,  115,
-     1161,  115,  115, 1161,  115, 1161,  115,  115,  115,  115,
-     1161,  886,  115,  888, 1161, 1161,  115, 1161,  115,  115,
-      115,  115,  115,  115,  115, 1161, 1161,  115,  887,  115,
-
-     1161,  885,  115,  115, 1161,  115, 1161, 1161,  115,  886,
-      115, 1161,  888,  889, 1161,  115, 1161,  115, 1161,  115,
-      115,  115, 1161,  115,  115, 1161,  887,  115,  115,  885,
-      115,  891,  115,  115, 1161, 1161,  890, 1161,  115,  115,
-     1161,  889, 1161, 1161,  115, 1161,  115, 1161,  115, 1161,
-     1161,  892, 1161,  115, 1161, 1161,  115, 1161,  115, 1161,
-      891,  115,  115, 1161,  890, 1161,  115,  115,  115, 1161,
-      115,  115, 1161,  115,  115,  115,  115, 1161,  895,  892,
-     1161,  115,  115, 1161, 1161, 1161,  115,  115, 1161,  115,
-      115,  115, 1161,  115, 1161,  896,  115,  896,  115,  115,
-
-      115,  115, 1161, 1161,  115,  115, 1161,  895, 1161,  115,
-     1161,  115,  115, 1161, 1161, 1161,  115,  115,  115,  115,
-      115, 1161,  115, 1161,  115,  115,  115,  115,  115,  115,
-      897,  906, 1161,  115, 1161, 1161, 1161, 1161,  898,  115,
-      115, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,  115,
-     1161,  115, 1161,  115,  115,  115,  115,  115, 1161,  897,
-      906, 1161,  115, 1161,  907, 1161,  898,  115, 1161,  908,
-      115,  908, 1161,  115,  258,  115,  802,   77,  804,  175,
-      115, 1161, 1161, 1161, 1161,  115, 1161, 1161, 1161, 1161,
-      909,  115,  907, 1161, 1161,  115,  115, 1161,  115, 1161,
-
-     1161, 1161,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
-      115,  177,  178, 1161, 1161,  179, 1161,  180, 1161,  909,
-      115,  115, 1161, 1161,  115,  115, 1161, 1161,  341,  182,
-     1161,  115, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
-      177,  178, 1161, 1161,  179, 1161,  180, 1161, 1161,  115,
-     1161, 1161, 1161, 1161, 1161, 1161,  341,  182,  912,  912,
-      211,  912,  912,  912,  912,  912,  912,  912,  912,  912,
-      912,  912,  912,  912,  912,  914,  912,  915,  915,  915,
-      915,  915,  915,  915,  915,  915,  915,  912,  912,  912,
-      912,  912,  916,  916,  916,  916,  916,  916,  916,  916,
-
-      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
-      916,  916,  916,  916,  916,  916,  916,  916,  912,  912,
-      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
-      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
-      916,  916,  916,  916,  916,  916,  912,  211,  257,  257,
-      257,  257,  257,  257,  257,  257,  257,  257, 1161, 1161,
-     1161, 1161, 1161, 1161,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  383,  374,  374,  211,  374,  374,  374,
-      374,  374,  374,  374,  374,  374,  374,  374,  374,  374,
-      374,  384,  374,  385,  385,  385,  385,  385,  385,  385,
-
-      385,  385,  385,  374,  374,  374,  374,  374,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  374,  374,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
-      386,  386,  374,  115, 1161,  917, 1161,  115,  115,  918,
-      115,  115,  115,  919,  115, 1161,  115, 1161,  920,  115,
-     1161, 1161,  115, 1161,  115, 1161,  115, 1161, 1161, 1161,
-      115, 1161,  115,  115,  917, 1161,  115,  115,  918,  115,
-
-      115,  115,  919,  115,  922,  115, 1161,  920,  115,  115,
-      115,  115,  115, 1161,  115,  921,  115, 1161,  115, 1161,
-      115,  115, 1161,  115, 1161,  115, 1161,  115, 1161, 1161,
-      115,  115,  115,  922,  923, 1161,  115, 1161,  115,  115,
-      115,  927, 1161, 1161,  921,  115,  115, 1161,  928,  115,
-      115,  115,  115, 1161,  115, 1161,  115,  115,  115, 1161,
-      115,  115,  923,  115, 1161,  115, 1161,  115,  115,  927,
-     1161,  115,  115, 1161,  115, 1161,  928,  115,  115, 1161,
-      930,  115,  115,  115, 1161, 1161,  115, 1161,  115, 1161,
-     1161,  938,  115, 1161,  939, 1161, 1161,  115, 1161,  115,
-
-     1161,  115,  115, 1161,  115, 1161,  115, 1161,  930,  115,
-      115, 1161,  115,  115, 1161,  941, 1161,  115,  115,  938,
-     1161,  940,  939,  115, 1161, 1161, 1161, 1161, 1161,  115,
-      115, 1161,  115,  115,  115,  115, 1161, 1161,  115, 1161,
-      115, 1161,  115,  942,  941, 1161, 1161,  115,  115,  940,
-     1161,  115, 1161, 1161,  115, 1161, 1161, 1161,  115, 1161,
-      115,  115, 1161,  115,  115,  943,  115, 1161,  115,  115,
-      115,  942,  944,  115, 1161,  115,  115, 1161, 1161, 1161,
-      115,  945,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
-      115,  115, 1161,  115,  943,  115,  115,  115,  115,  115,
-
-     1161,  944,  115, 1161,  115, 1161,  951, 1161,  115,  945,
-      952, 1161,  115,  115,  115,  115,  115,  115,  115,  115,
-      115,  115,  115, 1161, 1161,  115, 1161,  115, 1161, 1161,
-     1161, 1161,  115,  115,  951,  115,  115, 1161,  952, 1161,
-      115,  115,  115,  115,  953,  115, 1161,  115,  115, 1161,
-      115, 1161,  115,  115, 1161,  115, 1161,  115,  115,  115,
-      115,  115, 1161,  115,  115,  115, 1161, 1161, 1161, 1161,
-      115,  115,  956,  953, 1161, 1161,  955, 1161,  115,  115,
-     1161,  115,  115,  115,  115, 1161,  115,  115,  115, 1161,
-      115,  115, 1161,  115, 1161,  115,  115, 1161,  115,  115,
-
-      956,  957,  115, 1161,  955, 1161,  115,  115,  115,  115,
-      115,  115, 1161,  115, 1161,  958,  115, 1161, 1161,  115,
-      115,  115,  115,  962,  115,  115,  115,  115,  115,  957,
-      115,  115, 1161, 1161,  115, 1161,  115,  115,  115,  115,
-      115,  115,  115,  969,  958,  115, 1161, 1161,  115,  115,
-     1161,  115,  962,  115, 1161,  960,  115,  115,  115,  115,
-     1161, 1161,  115,  115,  115, 1161,  115,  963,  115,  115,
-      115,  115,  969, 1161, 1161, 1161, 1161,  115,  115, 1161,
-     1161,  115, 1161,  960,  970,  115, 1161, 1161,  115,  115,
-      115,  971, 1161,  115,  115,  115,  963, 1161, 1161, 1161,
-
-      115, 1161, 1161, 1161, 1161, 1161,  115,  211,  115, 1161,
-     1161, 1161,  970,  115, 1161, 1161,  115,  975,  115, 1161,
-      971,  115, 1161,  115,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  383, 1161,  115,  115,  115, 1161,  115,
-     1161, 1161,  115,  976,  115,  115,  975, 1161,  115, 1161,
-      115, 1161, 1161,  115, 1161, 1161,  115, 1161,  115, 1161,
-     1161, 1161, 1161,  115, 1161,  977,  115,  115,  115,  115,
-      115,  115,  976,  115,  115,  115, 1161,  115,  115, 1161,
-     1161, 1161,  115,  115,  115, 1161,  115, 1161,  115,  978,
-     1161,  979, 1161,  977, 1161,  115, 1161,  115,  115,  115,
-
-     1161,  115, 1161,  115,  115,  115,  115,  115, 1161,  983,
-      115, 1161,  115,  982, 1161, 1161,  115,  978, 1161,  979,
-      115,  115, 1161, 1161,  115,  115,  115,  115,  994,  992,
-      115,  985,  115,  115,  115,  115, 1161, 1161,  983,  115,
-      115,  982, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
-      115, 1161,  115, 1161, 1161,  115,  115,  994,  992,  115,
-      985,  115,  115,  993,  115,  115,  115, 1161,  115, 1161,
-      115,  115, 1161, 1161,  115,  115, 1161, 1161,  115, 1161,
-     1161, 1161,  115, 1161,  995,  115,  996,  115,  115, 1161,
-     1161,  115,  993,  115,  115,  115,  115, 1161, 1161,  115,
-
-      115,  115,  115, 1161,  997, 1161,  115,  115, 1161, 1161,
-      115,  115,  995,  115,  996, 1161,  115, 1161,  115, 1161,
-      115,  115,  115,  115, 1161,  115, 1161,  115, 1161,  115,
-     1161,  115,  997, 1161, 1161, 1161,  115,  115,  115,  115,
-     1161,  115, 1161,  115,  115, 1004, 1161,  115,  115,  115,
-     1161,  115,  115, 1006, 1161, 1161,  115, 1161,  115,  115,
-     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
-      115,  115,  115,  115, 1004,  115, 1161,  115,  115, 1161,
-     1161, 1006, 1161, 1161, 1161,  115,  115, 1007,  115,  115,
-      115, 1161,  115,  115, 1161,  115, 1009,  115, 1161,  115,
-
-      115, 1161, 1161,  115,  115, 1161,  115, 1161,  115,  115,
-     1161,  115, 1161,  115,  115, 1007, 1012,  115, 1161, 1161,
-     1161,  115,  115, 1161, 1161, 1009,  115, 1011,  115,  115,
-     1161, 1161,  115, 1161,  115,  115, 1161,  115,  115,  115,
-      115,  115, 1161,  115, 1012, 1020,  115, 1161,  115, 1019,
-      115, 1161,  115, 1161,  115, 1011,  115,  115,  115, 1161,
-      115,  115, 1161,  115,  115, 1161,  115, 1161,  115,  115,
-      115,  115, 1025,  115, 1020,  115,  115, 1019, 1161, 1161,
-      115,  115,  115, 1161,  115, 1161,  115,  115,  115,  115,
-      115, 1161, 1161,  115, 1161,  115, 1161,  115,  115,  115,
-
-     1025,  115,  115,  115,  115, 1026,  115, 1161,  115,  115,
-     1161, 1161,  115,  115, 1161,  115, 1161, 1161,  115, 1029,
-      115, 1161,  115,  115,  115, 1161, 1030,  115, 1161,  115,
-      115,  115, 1161,  115, 1026,  115, 1161, 1161,  115, 1161,
-      115,  115, 1161,  115,  115,  115,  115, 1029,  115,  115,
-      115,  115, 1161,  115, 1161, 1030, 1038, 1161,  115, 1037,
-      115,  115, 1161,  115,  115, 1161,  115,  115, 1161, 1161,
-      115,  115,  115,  115,  115,  115, 1161, 1161,  115,  115,
-      115, 1161, 1161, 1161, 1038, 1161, 1039, 1037,  115, 1161,
-      115,  115,  115,  115, 1161,  115,  115,  115,  115, 1040,
-
-      115,  115,  115, 1161,  115,  115, 1044, 1161,  115,  115,
-     1161, 1161,  115, 1161, 1039, 1161,  115, 1161, 1161,  115,
-      115, 1161,  115,  115, 1161,  115,  115,  115, 1040,  115,
-     1161,  115, 1161,  115,  115, 1044, 1161,  115,  115,  115,
-      115, 1047,  115, 1161,  115, 1161, 1161,  115, 1161,  115,
-     1161,  115, 1161,  115,  115, 1161,  115, 1048,  115, 1161,
-      115, 1161, 1161, 1161,  115,  115,  115,  115, 1161,  115,
-     1047,  115,  115, 1161, 1161, 1054,  115, 1161, 1161,  115,
-     1059,  115,  115,  115,  115,  115, 1048,  115, 1161,  115,
-      115, 1161, 1161,  115,  115,  115, 1161,  115,  115, 1161,
-
-      115, 1161,  115, 1054,  115,  115, 1161,  115, 1062, 1059,
-      115,  115, 1161, 1161,  115, 1161,  115, 1161, 1161,  115,
-      115, 1161,  115,  115,  115,  115,  115,  115, 1063,  115,
-     1161,  115,  115, 1161, 1161, 1067, 1062, 1161, 1161,  115,
-     1161,  115, 1161,  115,  115, 1161, 1161,  115, 1161,  115,
-     1161,  115,  115,  115,  115, 1068,  115, 1063,  115,  115,
-     1161, 1161, 1161, 1067,  115, 1161,  115,  115,  115,  115,
-      115,  115, 1069,  115, 1073,  115,  115, 1161,  115, 1161,
-     1161,  115, 1161, 1161, 1068, 1161, 1161,  115,  115,  115,
-      115,  115, 1161,  115,  115,  115,  115,  115, 1161,  115,
-
-     1161, 1069,  115, 1073,  115, 1161,  115,  115, 1161,  115,
-     1080, 1161,  115, 1161, 1161,  115,  115,  115, 1161,  115,
-      115,  115, 1161,  115,  115,  115,  115, 1087,  115, 1161,
-     1161, 1161, 1161, 1161, 1088,  115,  115,  115, 1080,  115,
-     1161,  115,  115, 1161,  115,  115,  115, 1161,  115, 1161,
-      115,  115,  115,  115,  115, 1161, 1087,  115,  115, 1091,
-     1161, 1161, 1088,  115, 1161,  115, 1161,  115,  115,  115,
-      115,  115, 1095,  115,  115,  115,  115,  115, 1161, 1161,
-      115, 1161,  115, 1161, 1161, 1161,  115, 1091,  115, 1161,
-      115,  115, 1161,  115,  115,  115,  115, 1161,  115,  115,
-
-      115, 1095, 1106,  115, 1161,  115, 1161, 1161, 1161, 1161,
-      115, 1161, 1161,  115, 1105, 1161,  115,  115,  115, 1161,
-      115, 1108,  115,  115,  115,  115, 1161, 1161,  115,  115,
-     1161, 1106, 1161, 1161, 1161, 1161,  115, 1161,  115, 1161,
-      115,  115, 1105,  115, 1112,  115,  115,  115, 1161,  115,
-     1108,  115,  115,  115,  115, 1161, 1161, 1161,  115,  115,
-     1161, 1122, 1161, 1161,  115, 1161,  115, 1161,  115,  115,
-     1161,  115, 1112, 1161,  115, 1161,  115, 1161,  115, 1161,
-     1161,  115, 1161,  115, 1161, 1161, 1161,  115, 1161, 1122,
-     1161, 1161, 1161, 1161,  115, 1161,  115, 1124,  948, 1124,
-
-     1161, 1161, 1125, 1125, 1161, 1125, 1161, 1161, 1161, 1125,
-     1125, 1161, 1161, 1125, 1161, 1161, 1125, 1125, 1125, 1125,
-     1125, 1125, 1125, 1125, 1125,  115,  115, 1161, 1161, 1161,
-      115,  115, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1133,
-     1161, 1161, 1128, 1161,  115,  115, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161,  115,  115, 1161, 1161, 1161,  115,
-      115, 1161, 1161, 1161, 1161, 1161, 1161, 1133, 1161, 1161,
-     1128, 1161,  115,  115,  947,  948,  947, 1161, 1161, 1134,
-     1134, 1161, 1135, 1161,  115,  950, 1134, 1134, 1137,  115,
-     1134, 1161, 1161, 1134, 1134, 1134, 1134, 1134, 1134, 1134,
-
-     1134, 1134, 1161,  115,  115,  115, 1161, 1161, 1161,  115,
-      115, 1161, 1161,  115, 1161, 1161, 1161, 1137,  115, 1161,
-     1161, 1161, 1161,  115,  115, 1161, 1161, 1161, 1161, 1161,
-     1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115,  115,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161,  115,  115,   64,   64,   64,   64,   64,   64,   64,
-       64,   64,   64,   64,   64,   65,   65,   65,   65,   65,
-       65,   65,   65,   65,   65,   65,   65,   81,   81, 1161,
-       81,   81,   81,   81,   81,   81,   81,   81,   81,   84,
-       84, 1161,   84,   84,   84,   84,   84,   84,   84,   84,
-
-       84,   88,   88,   88,   88,   88,   88,   88,   88,   88,
-       88,   88,   88,   92,   92,   92,   92,   92,   92,   92,
-       92,   92,   92,   92,   92,  111,  111,  115,  115,  115,
-      115,  115,  115,  115,  115,  187,  187,  187,  187,  187,
-      187,  187,  187,  187,  187,  187,  187,  202,  202,  202,
-      202,  202,  202,  202,  202,  202,  202,  202,  202,  209,
-      209,  209,  209,  209,  209, 1161,  209,  209,  209, 1161,
-      209,  232,  232,  232,  232,  232,  232,  232,  232,  232,
-      232,  232,  232,  101, 1161, 1161,  101,  252,  252,  252,
-     1161, 1161,  252, 1161,  252,  252, 1161,  252,  252,  343,
-
-      343,  343,  343,  343,  343,  343,  343,  343,  343,  343,
-      343,  358,  358, 1161,  358,  358,  358,  358,  358,  358,
-      358,  358,  358,  371,  371,  371,  371,  371,  371, 1161,
-      371,  371,  371, 1161,  371,  374,  374,  374,  374,  374,
-      374,  374,  374,  374,  374,  374,  374,  379,  379,  379,
-      379,  379,  379,  379,  379,  379,  379,  379,  379,  422,
-     1161, 1161,  422,  276, 1161, 1161, 1161,  276, 1161, 1161,
-     1161, 1161, 1161,  276,  558,  558,  558,  558,  558,  558,
-      558,  558,  558,  558,  558,  558,  718,  718, 1161,  718,
-      718,  718,  718,  718,  718,  718,  718,  718,  721,  721,
-
-     1161,  721,  721,  721,  721,  721,  721,  721,  721,  721,
-      723,  723, 1161,  723,  723,  723,  723,  723,  723,  723,
-      723,  723,   88,   88,   88,   88,   88,   88,   88,   88,
-       88,   88,   88,   88,  726,  726,  726,  726,  726,  726,
-      726,  726,  726,  726,  726,  726,   92,   92,   92,   92,
-       92,   92,   92,   92,   92,   92,   92,   92,  728,  728,
-      728,  728,  728,  728,  728,  728,  728,  728,  728,  728,
-      812,  812,  812,  812,  812,  812,  812,  812,  812,  812,
-      812,  812,  814,  814, 1161,  814,  814,  814,  814,  814,
-      814,  814,  814,  814,  823,  823,  823,  823,  823,  823,
-
-      823,  823,  823,  823,  823,  823,  825,  825,  825,  825,
-      825,  825,  825,  825,  825,  825,  825,  825,  831,  831,
-     1161,  831,  831,  831,  831,  831,  831,  831,  831,  831,
-      834,  834, 1161,  834,  834,  834,  834,  834,  834,  834,
-      834,  834,   81,   81, 1161,   81,   81,   81,   81,   81,
-       81,   81,   81,   81,  835,  835, 1161,  835,  835,  835,
-      835,  835,  835,  835,  835,  835,   84,   84, 1161,   84,
-       84,   84,   84,   84,   84,   84,   84,   84,  837,  837,
-      837,  837,  837,  837,  837,  837,  837,  837,  837,  837,
-       88,   88,   88,   88,   88,   88,   88,   88,   88,   88,
-
-       88,   88,  838,  838,  838,  838,  838,  838,  838,  838,
-      838,  838,  838,  838,   92,   92,   92,   92,   92,   92,
-       92,   92,   92,   92,   92,   92,  187,  187,  187,  187,
-      187,  187,  187,  187,  187,  187,  187,  187,  904,  904,
-      904,  904,  904,  904,  904,  904,  904,  904,  904,  904,
-      358,  358, 1161,  358,  358,  358,  358,  358,  358,  358,
-      358,  358,  814,  814, 1161,  814,  814,  814,  814,  814,
-      814,  814,  814,  814,  202,  202,  202,  202,  202,  202,
-      202,  202,  202,  202,  202,  202,  912,  912,  912,  912,
-      912,  912,  912,  912,  912,  912,  912,  912,  374,  374,
-
-      374,  374,  374,  374,  374,  374,  374,  374,  374,  374,
-      379,  379,  379,  379,  379,  379,  379,  379,  379,  379,
-      379,  379,  825,  825,  825,  825,  825,  825,  825,  825,
-      825,  825,  825,  825,  946,  946,  946,  946,  946,  946,
-      946,  946,  946,  946,  946,  946,  999,  999,  999,  999,
-      999,  999,  999,  999,  999,  999,  999,  999,   13, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161
-    } ;
-
-static yyconst flex_int16_t yy_chk[9249] =
-    {   0,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,    1,    1,    1,    1,    1,    1,    1,    2,
-        2,    2,    2,   10,    8,    8,    8,    8,   15,   15,
-
-       15,   68, 1129,   14,   10, 1119,   68,    2,    2,    2,
-        2,    2,    2,    2,    2,    2,    2,   14,   16,   16,
-       16,   54,   54,   54,    2,    2,   18,   10,    2,   19,
-        2,    8,   14,   17,   17,   17,   15,   20,   21, 1096,
-       18,    2,    2,  176,   22,   14, 1084,   25,   26,  176,
-       15,   20,   21,    2,    2,   18,   10,    2,   75,    2,
-        8,   25,   42,   19,   69,   15,   20,   21,   18,    2,
-        2,   17,   24,   27,   26,   23,   25,   19,   15,   20,
-       21,   22,   23,   23,   29,   17,   75,   27,   26,   25,
-     1045,   42,   19,   24,  959,   22,   30,  339,   74,  339,
-
-       17,   82,   27,   26,  340,   19,  340,   24,   83,   69,
-       22,   29,   23,   17,   31,   27,   26,   32,   30,   34,
-       41,  178,   24,   22,  916,   29,   23,   74,   31,  912,
-       82,   32,   30,   34,   41,   24,   83,   69,   49,  685,
-       29,   23,   49,   31,  905,  685,   32,   30,   34,   41,
-      178,  207,   33,   29,   23,   28,   31,   28,   33,   32,
-       30,   34,   41,   76,   76,   76,  242,   49,   67,   67,
-       67,   49,   33,   28,   28,   28,   28,   28,   28,   28,
-       28,   28,   28,   86,   43,   63,  207,   33,   28,   43,
-       44,  350,   28,   28,   28,  242,   43,   43,  904,   28,
-
-       33,   28,   28,   63,   44,   67,   91,   28,   77,   77,
-       77,   28,   86,   43,   63,  207,  837,   28,   43,   44,
-      350,   28,   28,   28,   43,   43,   87,   28,  360,   28,
-       28,   63,   44,  835,   67,   28,   78,   78,   78,   28,
-       35,   86,   35,   35,   35,   35,   35,   35,   35,   35,
-       35,   35,   38,   40,  830,   91,   38,  360,   35,   35,
-       38,   40,   35,  903,   40,  102,   38,   40,   35,  103,
-       38,  107,   87,   40,   90,   35,   35,   79,   79,   79,
-      825,   38,   40,   91,  342,   38,  342,   35,   35,   38,
-       40,   35,   40,  102,   38,   40,   35,  103,   38,  107,
-
-       87,   40,  108,   35,   35,   36,   90,   36,   36,   36,
-       36,   36,   36,   36,   36,   36,   36,  179,   37,  359,
-       39,  359,   36,  903,  823,   37,   45,   36,  822,   37,
-      108,   39,   37,   39,   45,   90,   39,   39,   46,  205,
-       45,   36,   37,   39,  812,  179,   46,   37,  393,   39,
-      180,   36,   46,  182,   37,   45,   36,   37,   46,   39,
-       37,   39,   48,   45,   39,   39,   51,   46,   45,   36,
-       37,   39,   47,   51,  811,   46,   48,  393,  180,   48,
-       46,  182,   48,   51,  205,   47,   46,   47,  104,   50,
-      220,   48,   47,   50,  529,   51,  529,   50,  396,   52,
-
-      450,   47,   51,  104,   48,   50,   52,   48,   50,   50,
-       48,   51,  205,   47,  532,   47,   52,  104,   50,  804,
-       47,  220,   50,   80,   80,   80,   50,  396,   52,  450,
-      530,  104,  530,   50,   92,   52,   50,   50,   55,   55,
-       55,   92,   92,  532,   52,   53,   53,   53,   53,  220,
-       56,  223,  531,   53,  531,   56,   55,   55,   55,   55,
-       55,   55,   55,   55,   55,   55,  184,  184,  184,   94,
-       70,   70,   70,   71,   71,   71,   94,   94,   60,  223,
-       53,   53,   70,   53,   53,   71,   53,   56,  726,   60,
-      106,  191,   60,  686,   93,   93,   93,   53,   53,  686,
-
-      106,   56,   93,   93,  181,   70,  725,   60,   71,   53,
-       53,  181,   53,   53,  723,   53,   56,   60,  722,  106,
-       60,   72,   72,   72,  910,   53,   53,  214,  106,   56,
-       57,   58,  181,   72,   70,   96,   57,   71,  222,  181,
-      191,  716,   96,   96,   57,  189,   57,   57,   57,   57,
-       57,   57,   57,   57,   57,   57,   59,  222,   58,   72,
-       59,  208,  208,  208,   59,   58,   57,   96,  191,   58,
-       59,  190,   58,   72,   59,  714,  214,  189,   61,  206,
-       57,  706,   58,   61,  910,   59,  222,   58,   72,   59,
-       61,   61,   62,   59,   58,   57,   96,   58,   59,   62,
-
-       58,   72,   59,  190,  214,  224,  189,   61,   57,   62,
-       58,  206,   61,  210,  210,  210,   62,  689,   61,   61,
-      664,   62,  225,  225,  225,  585,  580,  232,   62,  578,
-      558,  235,  190,  224,  232,  232,  554,   62,  235,  235,
-      206,  372,  372,  372,   62,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
-       73,   73,   73,   73,   97,  101,  101,  105,  204,  204,
-      204,   97,   97,  226,  538,  227,  213,  675,  101,  675,
-      534,  111,  105,  111,  111,  111,  111,  111,  111,  111,
-      111,  111,  111,  421,  101,  101,  105,  375,  375,  375,
-      419,  226,  173,  227,  173,  204,  101,  114,  213,  534,
-      105,  219,  412,   97,  113,  113,  113,  113,  113,  113,
-      113,  113,  113,  113,  114,  228,  115,  118,  219,  114,
-
-      116,  115,  118,  125,  204,  116,  410,  213,  125,  231,
-      173,   97,  100,  114,  100,  115,  118,  229,  116,  116,
-      386,  221,  125,  114,  173,  115,  118,  219,  114,  116,
-      115,  118,  125,  379,  116,  228,  249,  125,  230,  173,
-      374,  114,  251,  115,  118,  100,  116,  116,  117,  100,
-      125,  100,  173,  117,  243,  221,  100,  276,  100,  100,
-      248,  231,  117,  228,  249,  401,  229,  117,  100,  294,
-      251,  294,  401,  401,  100,  371,  343,  117,  100,  294,
-      100,  230,  117,  221,  100,  276,  100,  100,  535,  231,
-      117,  250,  243,  248,  229,  117,  100,  110,  110,  110,
-
-      110,  110,  110,  110,  110,  110,  110,  119,  121,  230,
-      913,  247,  119,  121,  120,  110,  110,  535,  119,  120,
-      243,  248,  120,  246,  400,  121,  119,  121,  110,  245,
-      233,  233,  233,  120,  341,  277,  119,  121,  233,  233,
-      344,  119,  121,  120,  110,  110,  119,  122,  120,  122,
-      244,  120,  122,  121,  119,  121,  110,  177,  123,  218,
-      400,  120,  341,  123,  212,  345,  122,  346,  344,  354,
-      913,  177,  277,  347,  209,  123,  122,  123,  122,  124,
-      202,  122,  348,  126,  124,  187,  177,  123,  126,  400,
-      124,  349,  123,  345,  122,  346,  183,  126,  124,  177,
-
-      277,  347,  126,  123,  676,  123,  676,  354,  124,  127,
-      348,  175,  126,  124,  127,  174,  237,  126,  124,  349,
-       89,  127,  127,  237,  237,  126,  124,  127,  127,  128,
-      126,  128,  129,  389,  128,  130,  354,  129,  127,  292,
-      130,  292,  361,  127,  234,  234,  234,  130,  128,  127,
-      127,  129,  234,  234,  130,  127,  127,  536,  128,  237,
-      128,  129,   88,  128,  130,  388,  129,   84,  389,  130,
-      361,  380,  380,  380,  356,  130,  128,   65,   13,  129,
-      378,  238,  130,  131,  355,  131,  536,  237,  238,  238,
-      369,  292, 1051,  388,  390,  133,  389,  392,    9,  131,
-
-      133,  131,  131,  131,  131,  131,  131,  131,  131,  131,
-      131,  132, 1081,  133,  133,  134,  132,    7,  134,  292,
-      134,  388,  132,  398,  133,  392,  356,  355,  369,  133,
-      132,  390,  378,  238,  134,  677,  131,  677,  131, 1130,
-      132,  133,  133,  381,  134,  132,  136,  134,  135,  134,
-      132,  136, 1051,  135,  356,  355,  398,  369,  132,  390,
-      378,  238,  134,  136,  131,  136,  131,  135,  135,  139,
-      377,  137, 1081,  138,  139,  136,  137,  135,  138,  137,
-      136,  381,  135,  139,  138,  398,  137,  395,  139,    0,
-      137,  136,  138,  136,  418,  135,  135,  397,  139, 1130,
-
-      137,  382,  138,  139,  140,  137,  475,  138,  137,  140,
-      381,  139,  138,  377,  137,  395,  139,  142,  137,  142,
-      138,  140,  418,  140,  141,  399,  143,  144,  143,  141,
-     1131,  537,  144,  140,  475,    0,  143,  141,  140,  391,
-      533,  377,  144,  141,  397,  382,  144,    0,  543,  140,
-      142,  140,  466,  141,  466,  142,  144,  146,  141,  143,
-      537,  144,  146,  146,  143,  141,    0,  391,  533,  142,
-      144,  141,  397,  382,  144,  399,  146,    0,  143,  142,
-      145,    0,  145,  466,  142,  145,  146,  680,  143,  680,
-     1131,  146,  146,  143,  145,  391,  145,  142,  543,  145,
-
-      147,    0,  148,  399,  146,  147,  143,  148,  557,  145,
-      484,  145,  484,  546,  145,  148,  394,  394,  394,  147,
-      484,  148,  145,  147,  145,  149,  543,  145,  149,  147,
-      149,  148,  572,  150,  147, 1148,  148,  151,  150,    0,
-        0,  546,  151,  148,  149,  150,  547,  147,    0,  148,
-      151,  147,  150,  557,  149,    0,  151,  149,    0,  149,
-      544,  572,  150,  152,  153,    0,  151,  150,  152,  153,
-        0,  151,  149,  150,  547,  153,  152,  488,  151,  488,
-      150,  557,  152,  153,  151,    0,  155,  488,    0,  154,
-      155,  155,  152,  153,  154, 1148,  544,  152,  153,  521,
-
-      154,  521,    0,  153,  152,  155,  611,    0,  154,  521,
-      152,  153,  156,  253,  253,  155,  158,  156,  154,  155,
-      155,  158,  402,  154,  158,  544,  253,    0,  154,  402,
-      402,  156,  157,  155,  611,  158,  154,  157,  559,  559,
-      559,  156,  253,  253,    0,  158,  156,  612,    0,  157,
-      158,  157,  157,  158,  253,  160,  160,  159,    0,  156,
-      160,  157,  159,  158,  614,  159,  157,  370,  370,  370,
-      615,  159,  402,  561,  160,  612,  159,  157,    0,  157,
-      157,  194,  162,  194,  160,  160,  159,  162,  161,  160,
-      161,  159,  614,  161,  159,  556,  556,  556,  615,  159,
-
-      402,  162,  160,  162,  159,    0,  161,  161,  370,  542,
-      161,  162,  575,  163,  194,  564,  162,  161,  163,  161,
-      164,  555,  161,  561,  163,  164,  164,  563,  194,  162,
-        0,  162,  163,  164,  161,  161,  556,  370,  161,  164,
-      165,  575,  163,  194,  568,  165,  692,  163,  692,  164,
-      617,  561,  163,  562,  164,  164,  194,  165,  542,  165,
-      163,  164,  564,  166,  403,  556,  682,  164,  166,  165,
-      555,  403,  403,  577,  165,  569,  563,  166,  617,  568,
-      166,    0,  166,  167,  167,  165,  542,  165,  167,  562,
-      564,  697,  166,  697,  682,  167,  569,  166,  555,  744,
-
-      403,    0,  167,  570,  563,  166,  577,  568,  166,  168,
-      166,  579,  167,  167,  168,  169,    0,  167,  562,  169,
-      169,    0,  168,  167,  570,  569,  168,  744,  168,  403,
-      167,  571,  170,    0,  169,  577,  753,  170,  168,    0,
-      170,  171,    0,  168,  169,  171,  171,  579,  169,  169,
-      168,  170,  571,  570,  168,    0,  168,  574,  574,  574,
-      171,  170,  169,  172,  753,  581,  170,  604,  172,  170,
-      171,  172,  581,  581,  171,  171,  579,  582,  613,  170,
-      618,  571,  172,  687,  582,  582,    0,    0,  171,  678,
-        0,  678,  172,  185,  185,  185,  604,  172,  756,  678,
-
-      172,  581,  679,  635,  815,  635,  815,  613,  757,  618,
-      172,  185,  185,  185,  185,  185,  185,  185,  185,  185,
-      185,  186,  681,  687,    0,  678,  756,  186,  713,    0,
-      581,  679,  691,  608,  635,  608,  757,  186,  186,  186,
-      186,  186,  186,  186,  186,  186,  186,  192,  683,  713,
-      683,  681,  687,  192,  678,  684,  684,  684,  683,    0,
-      703,  691,  683,  192,  192,  192,  192,  192,  192,  192,
-      192,  192,  192,  193,  608,  215,  215,  215,  713,  193,
-      708,  708,  708,  748,  826,  826,  826,  193,  608,  193,
-      193,  193,  193,  193,  193,  193,  193,  193,  193,  195,
-
-      703,  196,  197,  608,  195,  749,  196,  197,  215,    0,
-      195,  616,  748,  196,  196,  688,  608,  195,  195,  196,
-      196,  197,  215,  832,  832,  832,  704,  616,  195,  703,
-      196,  197,  707,  195,  749,  196,  197,  215,  195,  198,
-      616,  196,  196,    0,  198,  195,  195,  196,  196,  197,
-      215,  688,  702,  198,  702,  616,  200,    0,  198,  201,
-      199,  200,  199,  201,  201,  199,  702,  755,  198,  758,
-        0,  200,  707,  198,  199,  200,  199,  704,  201,  199,
-      688,  198,  759,  807,    0,  200,  198,    0,  201,  199,
-      200,  199,  201,  201,  199,  216,  755,    0,  758,  200,
-
-        0,  707,  199,  200,  199,  704,  201,  199,    0,    0,
-      759,  807,  216,  216,  216,  216,  216,  216,  216,  216,
-      216,  216,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-
-      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
-      217,  239,    0,  239,  860,  760,  239,  239,  239,  239,
-      239,  239,  239,  239,  239,  239,  240,    0,  240,  863,
-      805,  240,  240,  240,  240,  240,  240,  240,  240,  240,
-      240,  241,  860,  241,  760,  806,  241,  241,  241,  241,
-      241,  241,  241,  241,  241,  241,  254,  863,  254,  805,
-        0,  254,  254,  254,  254,  254,  254,  254,  254,  254,
-      254,  255,    0,  255,  806,    0,  255,  255,  255,  255,
-      255,  255,  255,  255,  255,  255,  256,  808,  256,  259,
-      865,  256,  256,  256,  256,  256,  256,  256,  256,  256,
-
-      256,  257,  257,  257,  257,  257,  257,  257,  257,  257,
-      257,    0,  259,  769,  260,  769,  808,  259,  865,  260,
-      257,  258,  258,  258,  258,  258,  258,  258,  258,  258,
-      258,  259,  260,  260,  261,  813,  901,  262,  901,  261,
-      258,  259,  262,  260,  769,  261,  259,  727,  260,  257,
-      908,  262,  908,  261,  727,  727,  262,  263,  705,  259,
-      260,  260,  263,  261,  813,  693,  262,  693,  261,  258,
-      263,  262,    0,  261,    0,  693,  263,  264,  266,  262,
-      265,  261,  264,  266,  262,  265,  263,  803,  266,  803,
-      264,  263,    0,    0,  705,  803,  264,  266,  263,  265,
-
-      265,  693,  851,  268,  263,  810,  264,  266,  268,  265,
-      267,  264,  266,    0,  265,  267,  266,    0,  264,    0,
-      268,  267,  268,  705,  264,  266,    0,  265,  265,  267,
-      693,  851,  268,  269,    0,  271,  821,  268,  269,  267,
-      271,  270,  810,    0,  267,  700,  270,  700,  268,  267,
-      268,  269,  269,  270,  271,  700,  270,  267,  272,  700,
-      270,    0,  269,  272,  271,  272,  728,  269,    0,  271,
-      270,  810,  821,  728,  728,  270,    0,  272,  273,  269,
-      269,  270,  271,  273,  270,  274,    0,  272,  270,  273,
-      274,  729,  272,  794,  272,  794,  274,  273,  729,  729,
-
-        0,  821,    0,  794,  274,  272,    0,  273,  278,  278,
-      857,  275,  273,  278,  274,  275,  275,  273,  900,  274,
-      859,  809,  809,  809,  274,  273,  820,  278,  279,  809,
-      275,  280,  274,  279,  824,  279,  280,  278,  278,  857,
-      275,  284,  278,  284,  275,  275,  900,  279,  281,  859,
-      280,  861,  281,  281,    0,  278,  862,  279,  275,  864,
-      280,  925,  279,  820,  279,  280,    0,  281,  283,    0,
-        0,  824,  284,  283,  284,  279,  283,  281,  280,  284,
-      861,  281,  281,  838,  875,  862,  875,  283,  864,  925,
-      838,  838,  820,  284,  875,  281,  282,  283,  282,  285,
-
-      824,  894,  283,  284,  285,  283,  286,  899,  284,  422,
-      422,  286,  839,  902,  893,  283,  893,  285,  285,  839,
-      839,  284,  422,    0,  893,  286,    0,  282,  285,  282,
-      894,  911,  282,  285,  282,  286,  899,  282,  422,  422,
-      286,  282,  902,    0,  282,  285,  285,  282,  282,  289,
-      422,  282,  287,  286,  289,  288,  287,  287,  282,  288,
-      288,  282,  934,  282,  937,  884,  282,  884,  289,  282,
-        0,  287,  282,    0,  288,  282,  282,  926,  289,  282,
-      911,  287,  290,  289,  288,  287,  287,  290,  288,  288,
-      291,  934,  291,  937,  290,  291,  289,  929,  293,  287,
-
-      931,  290,  288,  293,  896,  926,  896,  932,  911,  291,
-        0,  290,  293,  884,    0,  296,  290,  293,  933,  291,
-      296,  291,  290,  935,  291,  929,  296,  293,  931,  290,
-      961,  297,  293,    0,  296,  932,  297,  291,  298,  896,
-      293,  884,  297,  298,  296,  293,  933,    0,  954,  296,
-      297,  935,    0,  964,  296,    0,    0,  298,  298,  961,
-      297,  299,  296,    0,    0,  297,  299,  298,  896,  965,
-      297,  980,  298,  948,  948,  948,  954,  966,  297,  972,
-      299,  299,  964,  300,  301,  298,  298,  300,  300,  301,
-      299,  302,  301,  302,  303,  299,  303,  965,  967,  980,
-
-      300,  302,  300,  301,  303,  968,  966,  968,  299,  299,
-        0,    0,  300,  301,  989,  972,  300,  300,  301,  990,
-      304,  301,  973,  981,  302,  304,  984,  303,  300,  302,
-      300,  301,  303,  967,  968,  302,  968,    0,  303,  304,
-      304,  986,  989,  302,  972,  302,  303,  990,  303,  304,
-     1005,    0,  981,  302,  304,  984,  303,    0,  302,  973,
-      305,  303,  967,  302,  305,  305,  303,  304,  304,  987,
-      986,  302,  306,  302,  303,  988,  303,  306, 1005,  305,
-      307,  308, 1008, 1016,  307,  307,  308,    0,  973,  305,
-     1010,  306,  308,  305,  305,    0,    0,  309,  987,  307,
-
-      308,  306,  309, 1015,  988,    0,  306,  305,    0,  307,
-      308, 1008, 1013,  307,  307,  308,  309,  310, 1010,  306,
-      308,  309,  310,  998,  998,  998,  309,  307,  308, 1016,
-      310,  309, 1015,  311,  312,    0,  310,  313,  311,  312,
-     1013,  311,  313,  852,  309,  852,  310, 1017,    0,  309,
-        0,  310,  311,  312,  314,    0,  313, 1016,  310,  314,
-     1018,    0,  311,  312,  310, 1028,  313,  311,  312, 1027,
-      311,  313,  314,  314,  315,    0, 1017,  316,  852,  315,
-      311,  312,  316,  314,  313, 1022, 1032,  315,  314, 1018,
-      316,  852, 1034,  315, 1028,    0,  316, 1027,  316, 1036,
-
-      314,  314, 1021,  315,  317, 1023,  316,  852,  315,  317,
-      317,  316,    0,    0, 1032,  315, 1043, 1022,  316,  852,
-     1034,  315, 1049,  317,  316,  318,  316, 1036,    0,  319,
-      318,    0,  319,  317,  319,    0,  318,  320,  317,  317,
-      319, 1023,  320,    0,  318, 1043, 1022, 1021,  319, 1046,
-     1049,  317,    0, 1024,  318, 1053,  320,  320,  319,  318,
-      321,  319,  322,  319,  318,  321,  320,  322,  319,  323,
-     1023,  320,  318, 1052,  323, 1021,  319,  323, 1046,  321,
-      321,  322,  322, 1053,  320,  320,    0,    0,  323,  321,
-        0,  322,  326, 1024,  321,  324,  322,  326,  323,  324,
-
-      324,    0, 1052,  323, 1060,  326,  323,  321,  321,  322,
-      322,  326,  328,    0,  324,  325,  323,  328,  327,  325,
-      325,  326, 1024,  327,  324,  327,  326, 1061,  324,  324,
-     1058,  328, 1060,  326,  325,    0, 1055,  327,  329,  326,
-        0,  328,  324,  329,  325,  330,  328,  327,  325,  325,
-      330, 1057,  327,  332,  327,  332, 1061,  329,    0,  328,
-      330,  331,  325,  332,  330,  327,  331,  329, 1041, 1041,
-     1041, 1055,  329,    0,  330, 1058, 1064,    0,  331,  330,
-      331, 1066,  333, 1056, 1057,  329,  332,  333,  330,  333,
-      331,  332,  330,  334, 1072,  331,    0, 1074,  334,  334,
-
-     1055,  333,  336, 1058, 1064,  332,  331,  336,  331, 1076,
-     1066,  333,  334, 1057,  336,  332,  333, 1056,  333,  335,
-      332,  336,  334, 1072,  335, 1074, 1078,  334,  334,  333,
-        0,  336,  335,  332,    0,    0,  336, 1076,  335,  337,
-      334, 1085,  336,    0,  337,  338, 1056, 1094,  335,  336,
-      338,    0,  974,  335, 1078, 1086,  337, 1090,  337, 1083,
-      335,  876,  876,  876,  338,    0,  335,    0,  337,  876,
-     1085, 1082,  876,  337,  338,  351, 1094,  351,    0,  338,
-      946,  946,  946, 1086,  337, 1090,  337,  974,  946,  974,
-        0,  946,  338,  351,  351,  351,  351,  351,  351,  351,
-
-      351,  351,  351,  352,  947,  947,  947, 1082,    0,  352,
-        0, 1083,  947,    0, 1077,  947,  974,    0,  974,  352,
-      352,  352,  352,  352,  352,  352,  352,  352,  352,  353,
-      949,  949,  949,    0,    0,  353, 1082, 1098,  949, 1083,
-        0,  949, 1070, 1070, 1070,  353,  353,  353,  353,  353,
-      353,  353,  353,  353,  353,  357, 1092, 1092, 1092, 1077,
-     1099,  357,  362,  363,    0,  364,  362,  362,  363,  357,
-      364,  357,  357,  357,  357,  357,  357,  357,  357,  357,
-      357,  362,  363, 1098,  364,  365,  365, 1077, 1099, 1103,
-      365,  362,  363,  368,  364,  362,  362,  363, 1104,  364,
-
-        0,  366,    0,    0,  365,  366,  366,    0,    0,  362,
-      363, 1098,  364, 1111,  365,  365, 1107, 1103,  366,  365,
-      366,  367,    0,  433,  368,  367,  367, 1104,  433,  368,
-      366, 1100,  365,    0,  366,  366,  950,  950,  950, 1113,
-      367, 1111,  433,  368,  950, 1107,  366,  950,  366,    0,
-      367, 1116,  433,  368,  367,  367,  383,  433,  368,    0,
-        0,  999,  999,  999,    0,    0, 1100, 1113,  367,  999,
-      433,  368,  999,  383,  383,  383,  383,  383,  383,  383,
-      383,  383,  383,  384,    0, 1000, 1000, 1000, 1101, 1101,
-     1101,    0,  383, 1000, 1121, 1100, 1000, 1116, 1127,    0,
-
-      384,  384,  384,  384,  384,  384,  384,  384,  384,  384,
-      387,    0, 1001, 1001, 1001, 1117, 1117, 1117, 1136,  384,
-     1001,  383, 1121, 1001,    0, 1116, 1127,  387,  387,  387,
-      387,  387,  387,  387,  387,  387,  387,  404,  404,  404,
-      404,  404,  404,  404,  404,  404,  404, 1136,  384,  405,
-      405,  405,  405,  405,  405,  405,  405,  405,  405,  406,
-      406,  406,  406,  406,  406,  406,  406,  406,  406,  407,
-      407,  407,  407,  407,  407,  407,  407,  407,  407,  408,
-      408,  408,  408,  408,  408,  408,  408,  408,  408,  409,
-      409,  409,  409,  409,  409,  409,  409,  409,  409,  423,
-
-      423,  423,  423,  423,  423,  423,  423,  423,  423,  424,
-      424,  424,  424,  424,  424,  424,  424,  424,  424,  425,
-      425,  425,  425,  425,  425,  425,  425,  425,  425,  426,
-      426,  426,  426,  426,  426,  426,  426,  426,  426,  427,
-      427,  427,  427,  427,  427,  427,  427,  427,  427,  428,
-      428,  428,  428,  428,  428,  428,  428,  428,  428,  429,
-     1102,  429,    0,    0,  429,  429,  429,  429,  429,  429,
-      429,  429,  429,  429,  430,  430,  430,  430,  430,  430,
-      430,  430,  430,  430,    0,  436,    0,  434,    0,  431,
-      436,  431,  434,  430,  431,  431,  431,  431,  431,  431,
-
-      431,  431,  431,  431,  436,  434,  434,  435,  437,  435,
-     1144, 1102,  435,  437,  436,    0,  434, 1132, 1147,  436,
-        0,  434,  430,    0,  438,    0,  435,  437,  438,  438,
-      439,    0,  436,  434,  434,  439,  435,  437,  435, 1102,
-        0,  435,  437,  438,    0, 1132,  440, 1140,  439,  439,
-     1147,  440,    0,  438,  435,  437, 1144,  438,  438,  439,
-        0,    0,  441,    0,  439,  440, 1114,  441,  442,  443,
-        0,  438,  442,  442,  443,  440,  439,  439, 1139, 1147,
-      440,  441,    0,  443, 1144,  446, 1146,  442,  443,  444,
-      446,  441, 1140,  440,  444, 1143,  441,  442,  443, 1156,
-
-      444,  442,  442,  443,  446,  445,    0, 1149,  444,  441,
-      445,  443,    0,  445,  446,  442,  443, 1114,  444,  446,
-     1140,  447,  448,  444,  445,  447,  447,  448,  444, 1139,
-      449, 1156,  446,  448,  445,  449,  444, 1146,    0,  445,
-      447,  448,  445,  449, 1143, 1114, 1124, 1124, 1124,  449,
-      447,  448,  445,    0,  447,  447,  448, 1139, 1149,  449,
-     1156,  448,  451,    0,  449, 1146, 1145,  451,  447,  448,
-      452,  449, 1143,  451,  453,  452, 1152,  449,  452,  453,
-        0,  451,    0,    0, 1150,  454, 1149,  454,    0,  452,
-        0,  451,  453,  453,    0,    0,  451,    0,    0,  452,
-
-        0,  451, 1145,  453,  452,    0,    0,  452,  453,  451,
-      458, 1151, 1151, 1151,  457,  458,    0,  452,  454,  457,
-      453,  453,    0,  454,    0, 1152,  454,    0,  457,  458,
-      458, 1145,    0,  457,    0, 1150,    0,  454,    0,  458,
-      454,  459,    0,  457,  458,  460,  459,  454,  457,    0,
-      460,    0,  454, 1152, 1155,  454,  457,  458,  458,  460,
-      459,  457,  468, 1150,  460,  454,    0,  468,  454,  455,
-      459,  455,    0,    0,  460,  459, 1153, 1153, 1153,  460,
-        0,  468,    0,    0,  461,    0,    0,  460,  459,  461,
-     1155,  468,  460, 1158, 1158, 1158,  468, 1159, 1159, 1159,
-
-      455,  461,    0,  461,    0,  455,  463,  455,    0,  468,
-      455,  463, 1157,  461,  455,    0,    0,  455,  461, 1155,
-      455,  455,    0,    0,  455,  463,    0,    0,    0,  461,
-      463,  461,    0,    0,  455,  463,  455,    0,  472,  455,
-      463,    0,  455,  472,    0,  455,  462,    0,  455,  455,
-      462,  462,  455,  463,  464,  465,    0,  472,  463,  464,
-      465,  464,    0, 1157,    0,  462,  462,  472,    0,    0,
-        0,    0,  472,  464,  465,  462,  465,    0,    0,  462,
-      462,    0,    0,  464,  465,  472,    0,    0,  464,  465,
-      464, 1157,    0,  462,  462,    0,    0,    0,    0,    0,
-
-        0,  464,  465,    0,  465,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,    0,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
-      469,  469,  469,  469,  470,    0,  471,  473,  471,  470,
-
-        0,    0,  473,  474, 1002, 1002, 1002,    0,  474,    0,
-        0,  470, 1002,  470,    0, 1002,  473,    0,    0,    0,
-        0,    0,  474,  470,    0,    0,  473,  471,  470,  471,
-      476,  473,  474,    0,  471,  476,    0,  474,  477,  470,
-        0,  470,    0,  477,  473,    0,  477,    0,  471,  476,
-      474,    0,    0,    0,    0,    0,    0,  477,  471,  476,
-      478,    0,    0,  471,  476,  478,    0,  477,  479,    0,
-        0,    0,  477,  479,    0,  477,  471,  476,    0,  478,
-      478,    0,    0,    0,    0,  477,    0,  479,    0,  478,
-      480,    0,    0,    0,  478,  480,    0,  479,  480,  481,
-
-        0,    0,  479,    0,  481,  481,    0,  478,  478,  480,
-        0,    0,  481,    0,    0,  479,    0,    0,  481,  480,
-        0, 1003, 1003, 1003,  480,    0,    0,  480,  481, 1003,
-      482,  487, 1003,  481,  481,  482,  487,  480,  482,  483,
-      481,  483,  486,    0,  483,    0,  481,  486,    0,  482,
-      487,    0,    0,    0,    0,    0,  486,    0,  483,  482,
-      487,  486,    0,    0,  482,  487,    0,  482,  483,  490,
-      483,  486,    0,  483,  490,  491,  486,  482,  487,    0,
-      491,    0,    0,  490,  486,    0,  483,    0,  490,  486,
-        0,  492,    0,    0,  491,  493,  492,    0,  490,    0,
-
-      493,    0,  492,  490,  491,    0,  493,  494,    0,  491,
-      492,  490,  494,    0,  493,    0,  490,    0,  495,    0,
-      492,    0,  491,  495,  493,  492,  494,  496,    0,  493,
-      492,    0,  496,    0,  493,  496,  494,  495,  492,  497,
-        0,  494,  493,  498,  497,    0,  496,  495,  498,    0,
-      502,    0,  495,    0,  494,  502,  496,    0,  497,    0,
-        0,  496,  498,    0,  496,  495,  499,    0,  497,  502,
-      500,  499,  498,  497,  496,  500,    0,  498,    0,  502,
-      499,    0,  500,    0,  502,  499,  497,  501,    0,  500,
-      498,  501,  501,  503,    0,  499,  504,  502,  503,  500,
-
-      499,  504,    0,    0,  500,    0,  501,    0,  499,    0,
-      500,    0,  503,  499,    0,  504,  501,  500,  505,  507,
-      501,  501,  503,  505,  507,  504,    0,  503,    0,  508,
-      504, 1042, 1042, 1042,  501,  505,    0,  505,  507, 1042,
-      503,  506, 1042,  504,    0,    0,  506,  505,  507,  506,
-      508,    0,  505,  507,    0,  508,    0,  509,    0,    0,
-      506,    0,  509,  505,    0,  505,  507,    0,    0,  508,
-      506,    0,    0,    0,  509,  506,  509,    0,  506,  508,
-        0,    0,  510,    0,  508,    0,  509,  510,  506,  511,
-      512,  509,    0,  510,  511,  512,    0,  508,    0,    0,
-
-        0,  510,  509,  512,  509,    0,  511,    0,  511,  512,
-        0,  510,    0,    0,    0,    0,  510,    0,  511,  512,
-      513,  510,  515,  511,  512,  513,    0,  515,  514,  510,
-      514,  512,    0,  514,  511,    0,  511,  512,  517,  513,
-        0,  515,    0,    0,    0,  516,    0,  514,    0,  513,
-      516,  515,    0,  518,  513,    0,  515,  514,  518,  514,
-        0,  517,  514,    0,  516,  519,  517,  513,    0,  515,
-      519,    0,  518,    0,  516,  514,    0,    0,    0,  516,
-      517,    0,  518,    0,  519,    0,  523,  518,  520,    0,
-      517,  523,  516,  520,  519,  517,    0,    0,    0,  519,
-
-      518,    0,  520,    0,    0,  523,    0,  520,  517,  524,
-        0,    0,  519,  524,  524,  523,    0,  520,  525,    0,
-      523,  526,  520,  525,    0,    0,  526,    0,  524,    0,
-      520,    0,    0,  523,    0,  520,    0,  525,  524,    0,
-      526,  527,  524,  524,  528,  527,  527,  525,  528,  528,
-      526,    0,  525,    0,    0,  526,  524,    0,    0,    0,
-      527,  551,    0,  528,    0,  525,  551,    0,  526,    0,
-      527,    0,    0,  528,  527,  527,    0,  528,  528,  539,
-      551,  539,    0,    0,    0, 1071, 1071, 1071,  527,    0,
-      551,  528,    0, 1071,    0,  551, 1071,  539,  539,  539,
-
-      539,  539,  539,  539,  539,  539,  539,  540,  551, 1093,
-     1093, 1093,    0,  540,    0,    0,    0, 1093,    0,    0,
-     1093,    0,    0,  540,  540,  540,  540,  540,  540,  540,
-      540,  540,  540,  541,  548,    0,  548,    0,    0,  541,
-        0,    0,    0,    0,  548,    0,    0,    0,    0,  541,
-      541,  541,  541,  541,  541,  541,  541,  541,  541,  545,
-      550,    0,  550,    0,    0,  545,  549,  548,    0,    0,
-      548,  549,  548,  545,  549,  545,  545,  545,  545,  545,
-      545,  545,  545,  545,  545,  549,  548,    0,    0,    0,
-        0,    0,    0,  550,    0,  549,  548,    0,  550,  548,
-
-      549,  548,  552,  549,    0,  592,    0,  552,  552,  592,
-      592,    0,  550,  549,  548,  552,    0,    0,  553,  552,
-      553,  552,  550,    0,  592,    0,    0,  550,  553,    0,
-        0,  552,  553,    0,  592,    0,  552,  552,  592,  592,
-      550,  565,    0,  552,    0,    0,    0,  552,    0,  552,
-        0,  553,  592,  565,    0,  565,  553,    0,  565,  565,
-      565,  565,  565,  565,  565,  565,  565,  565,    0,  566,
-      553, 1110, 1110, 1110,    0,    0,    0,    0,    0, 1110,
-      553,    0, 1110,    0,    0,  553,  566,  566,  566,  566,
-      566,  566,  566,  566,  566,  566,  567,    0,  553,    0,
-
-        0, 1125, 1125, 1125,    0,  566,    0,    0,  567, 1125,
-      567,    0, 1125,  567,  567,  567,  567,  567,  567,  567,
-      567,  567,  567,  588,  588,  588,  588,  588,  588,  588,
-      588,  588,  588,    0,  566,  589,  589,  589,  589,  589,
-      589,  589,  589,  589,  589,  590,  590,  590,  590,  590,
-      590,  590,  590,  590,  590,  591,  591,  591,  591,  591,
-      591,  591,  591,  591,  591,  593,    0,    0,  595,    0,
-      593,    0,    0,  595, 1134, 1134, 1134,    0, 1135, 1135,
-     1135,    0, 1134,  595,  593, 1134, 1135,  595,    0, 1135,
-        0,    0,    0,    0,  593,    0,    0,  595,    0,  593,
-
-        0,    0,  595,    0,    0,    0,    0,    0,    0,    0,
-        0,  595,  593,  594,  594,  595,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
-
-      594,  594,  596,  597,  596,  598,  600,  596,  597,  599,
-      598,  600,    0,  599,  599,    0,    0,    0,  598,  600,
-        0,  596,  597,    0,  598,  600,    0,    0,  599,    0,
-        0,  596,  597,  596,  598,  600,  596,  597,  599,  598,
-      600,    0,  599,  599,    0,    0,  598,  600,    0,  596,
-      597,    0,  598,  600,  601,  602,  599,  603,    0,  601,
-      602,  605,  603,    0,    0,  605,  605,    0,    0,  602,
-        0,    0,    0,  601,  602,  603,  603,    0,    0,    0,
-      605,    0,    0,  601,  602,    0,  603,  606,  601,  602,
-      605,  603,  606,    0,  605,  605,    0,  602,  606,    0,
-
-        0,  601,  602,  603,  603,    0,  606,    0,  605,  609,
-      607,    0,    0,  610,  609,  607,  606,  607,  610,    0,
-      610,  606,    0,    0,    0,    0,  606,    0,  609,  607,
-        0,    0,  610,    0,  606,  619,  621,    0,  609,  607,
-      619,  621,  610,  609,  607,    0,  607,  610,    0,  610,
-        0,    0,    0,    0,  619,  621,  609,  607,  620,    0,
-      610,    0,    0,  620,  619,  621,    0,    0,    0,  619,
-      621,  620,    0,    0,  623,  622,    0,  620,  622,  623,
-      622,    0,  619,  621,    0,    0,    0,  620,  623,    0,
-        0,  624,  620,  623,  622,    0,  624,    0,    0,  620,
-
-        0,    0,  624,  623,  622,  620,    0,  622,  623,  622,
-      624,    0,  625,  625,  626,    0,  623,  625,  628,  626,
-      624,  623,  622,  628,    0,  624,    0,    0,    0,  626,
-      624,  625,    0,  626,    0,  627,    0,  628,  624,  627,
-      627,  625,  625,  626,    0,    0,  625,  628,  626,    0,
-        0,    0,  628,  629,  627,  629,    0,  626,    0,  625,
-        0,  626,    0,  632,  627,  628,    0,    0,  627,  627,
-      631,  631,  631,  631,  631,  631,  631,  631,  631,  631,
-      632,    0,  627,  633,  629,  632,  629,  634,  633,  637,
-        0,  629,  634,    0,  637,    0,    0,    0,    0,  632,
-
-      634,    0,  633,    0,    0,  629,  634,    0,  637,  632,
-        0,    0,  633,    0,  632,  629,  634,  633,  637,  638,
-      629,  634,    0,  637,  638,    0,    0,  632,  634,    0,
-      633,    0,    0,  629,  634,  639,  637,    0,  638,  641,
-      639,  641,  642,  639,  641,  642,  643,  642,  638,    0,
-        0,  643,    0,  638,  639,    0,    0,    0,  641,    0,
-        0,  642,  644,    0,  639,  643,  638,  644,  641,  639,
-      641,  642,  639,  641,  642,  643,  642,    0,    0,  644,
-      643,  644,  639,  645,    0,  646,  641,  645,  645,  642,
-      646,  644,  647,  643,  648,    0,  644,  647,    0,  648,
-
-        0,    0,  645,    0,  646,  647,    0,  644,    0,  644,
-        0,  647,  645,  648,  646,    0,  645,  645,    0,  646,
-        0,  647,    0,  648,    0,    0,  647,    0,  648,  649,
-      645,  649,  646,  647,  649,  650,    0,    0,    0,  647,
-      650,  648,    0,    0,    0,    0,  650,    0,  649,    0,
-        0,    0,    0,    0,  650,    0,    0,    0,  649,    0,
-      649,  652,    0,  649,  650,  651,  652,  651,    0,  650,
-      651,    0,  652,  653,  650,    0,  649,  653,  653,    0,
-      652,    0,  650,    0,  651,    0,    0,    0,    0,    0,
-      652,    0,  653,    0,  651,  652,  651,    0,  655,  651,
-
-      652,    0,  653,  655,    0,  654,  653,  653,  652,  656,
-      654,    0,  651,  654,  656,    0,    0,  655,    0,    0,
-      653,    0,  656,    0,  654,  657,    0,  655,  656,  657,
-      657,    0,  655,    0,  654,    0,  658,    0,  656,  654,
-        0,  658,  654,  656,  657,  655,    0,    0,  660,    0,
-      656,    0,  654,  660,  657,  658,  656,  659,  657,  657,
-        0,  659,  659,    0,    0,  658,    0,  660,  661,  662,
-      658,    0,  657,  661,  662,    0,  659,  660,    0,    0,
-        0,    0,  660,  658,    0,    0,  659,  661,  662,    0,
-      659,  659,    0,    0,  663,  660,  663,  661,  662,  663,
-
-      665,  666,  661,  662,  659,  665,  666,    0,    0,    0,
-        0,    0,    0,  663,    0,  661,  662,    0,  665,  665,
-      666,    0,    0,  663,    0,  663,  667,    0,  663,  665,
-      666,  667,    0,    0,  665,  666,    0,  668,    0,  667,
-      668,  663,  668,    0,    0,  667,  665,  665,  666,  669,
-        0,    0,    0,  672,  669,  667,  668,  671,  672,    0,
-      667,    0,  671,    0,    0,    0,  668,  667,  669,  668,
-        0,  668,  672,  667,  673,    0,  671,  671,  669,  673,
-      674,    0,  672,  669,  668,  674,  671,  672,    0,    0,
-        0,  671,    0,  673,    0,    0,  669,    0,    0,  674,
-
-      672,    0,    0,  673,  671,  671,    0,    0,  673,  674,
-        0,    0,  690,    0,  674,    0,    0,    0,  690,  695,
-        0,  673,    0,  695,  695,    0,  690,  674,  690,  690,
-      690,  690,  690,  690,  690,  690,  690,  690,  695,  696,
-      698,  699,    0,    0,  696,  698,  699,  696,  695,    0,
-        0,  698,  695,  695,    0,    0,    0,    0,  696,  698,
-      699,    0,    0,    0,    0,    0,  695,    0,  696,  698,
-      699,    0,  709,  696,  698,  699,  696,    0,    0,  698,
-        0,    0,  710,    0,    0,    0,  696,  698,  699,  709,
-      709,  709,  709,  709,  709,  709,  709,  709,  709,  710,
-
-      710,  710,  710,  710,  710,  710,  710,  710,  710,  711,
-        0,    0,    0,    0,    0,    0,    0,    0,    0,  712,
-        0,    0,    0,    0,    0,    0,  711,  711,  711,  711,
-      711,  711,  711,  711,  711,  711,  712,  712,  712,  712,
-      712,  712,  712,  712,  712,  712,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
-      715,  715,  715,  715,  715,  719,  719,  719,    0,    0,
-      719,  719,    0,  719,    0,    0,    0,  719,  719,    0,
-        0,  719,    0,    0,  719,  719,  719,  719,  719,  719,
-      719,  719,  719,  732,  732,    0,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
-      732,  732,  733,    0,    0,  735,    0,  733,  734,  734,
-      734,  734,  734,  734,  734,  734,  734,  734,  736,  737,
-        0,  733,  735,  736,  737,  738,    0,  735,    0,    0,
-      738,  733,    0,    0,    0,    0,  733,  736,  737,    0,
-        0,  735,    0,    0,  738,  739,    0,  736,  737,  733,
-
-      739,  735,  736,  737,  738,    0,  735,  740,    0,  738,
-        0,    0,  740,    0,  739,  736,  737,    0,  741,  735,
-        0,    0,  738,  741,  739,    0,  740,    0,    0,  739,
-      740,    0,    0,    0,    0,    0,  740,  741,  741,    0,
-        0,  740,  739,  742,    0,  742,    0,  741,  742,    0,
-      747,  743,  741,    0,  740,  747,  743,    0,  740,  743,
-        0,  745,  742,  745,    0,  741,  741,    0,    0,  747,
-      743,    0,  742,  750,  742,    0,    0,  742,  750,  747,
-      743,    0,  746,    0,  747,  743,  746,  746,  743,    0,
-      742,    0,  750,    0,  745,    0,  745,  747,  743,  745,
-
-        0,  746,  750,    0,    0,    0,    0,  750,    0,  745,
-        0,  746,    0,  745,  751,  746,  746,    0,  751,  751,
-      750,    0,    0,  745,    0,  745,  762,    0,  745,  746,
-        0,  762,    0,  751,  761,    0,  761,  745,    0,  761,
-        0,  745,    0,  751,    0,  762,  762,  751,  751,    0,
-        0,  763,    0,  761,    0,  762,  763,  763,    0,    0,
-      762,  751,    0,  761,    0,  761,    0,    0,  761,    0,
-      763,  764,  765,  762,  762,  764,  764,  765,  766,    0,
-      763,  761,  766,  766,    0,  763,  763,    0,    0,  765,
-      764,  765,    0,    0,  771,    0,    0,  766,  763,  771,
-
-      764,  765,    0,  767,  764,  764,  765,  766,  767,    0,
-      768,  766,  766,  771,  772,  768,  772,  765,  764,  765,
-      767,  768,  767,  771,  772,  766,  773,    0,  771,  768,
-        0,  773,  767,    0,    0,    0,    0,  767,    0,  768,
-      773,  771,    0,    0,  768,  773,  774,  772,  767,  768,
-      767,  774,  772,    0,  774,  773,    0,  768,  775,    0,
-      773,    0,  775,  775,    0,  774,  772,  776,  773,  778,
-        0,  776,  776,  773,  778,  774,  772,  775,    0,    0,
-      774,  772,    0,  774,    0,    0,  776,  775,  778,    0,
-      777,  775,  775,  774,  772,  777,  776,    0,  778,  779,
-
-      776,  776,    0,  778,  779,  775,    0,  777,    0,  777,
-      780,    0,    0,    0,  776,  780,  778,  779,  779,  777,
-        0,  780,  781,    0,  777,    0,    0,  781,  779,  780,
-        0,  782,    0,  779,    0,  777,  782,  777,    0,  780,
-        0,  781,  783,  784,  780,  779,  779,  783,  784,  780,
-      782,  781,    0,  785,    0,  785,  781,  780,    0,    0,
-      782,  783,  784,  786,    0,  782,    0,    0,  786,  781,
-        0,  783,  784,    0,  787,    0,  783,  784,  782,  787,
-        0,  786,  786,  788,    0,    0,  785,    0,  788,  783,
-      784,  785,  786,  787,  789,    0,    0,  786,  787,  789,
-
-        0,  785,  788,  787,    0,  785,    0,    0,  787,  786,
-      786,    0,  788,  789,    0,  785,    0,  788,    0,  790,
-      785,  787,    0,  789,  790,    0,  787,  791,  789,  785,
-      788,  791,  791,  785,    0,    0,  790,    0,  790,  792,
-        0,  789,    0,    0,  792,    0,  791,    0,  790,    0,
-        0,  792,    0,  790,    0,    0,  791,    0,  792,    0,
-      791,  791,  793,    0,  790,    0,  790,  793,  792,    0,
-      795,  796,    0,  792,  791,  795,  796,    0,  795,  792,
-        0,  793,  797,    0,    0,    0,  792,  797,    0,  795,
-      796,  793,    0,  798,    0,  799,  793,  799,  798,  795,
-
-      796,  797,    0,    0,  795,  796,    0,  795,    0,  793,
-        0,  797,  798,    0,    0,    0,  797,  795,  796,  800,
-      801,    0,  798,    0,  800,  801,  816,  798,  799,  797,
-      799,  816,    0,  799,    0,    0,    0,    0,  800,  801,
-      798,    0,    0,    0,    0,  816,    0,  799,  800,  801,
-        0,  817,    0,  800,  801,  816,  817,  799,    0,  799,
-      816,    0,  799,    0,  817,    0,  800,  801,    0,  818,
-      817,  818,    0,  816,  842,  799,  802,  802,  802,  802,
-      817,    0,    0,    0,    0,  817,    0,    0,    0,    0,
-      819,  842,  817,    0,    0,  819,  842,    0,  817,    0,
-
-        0,    0,  818,    0,    0,    0,    0,  818,    0,  819,
-      842,  802,  802,    0,    0,  802,    0,  802,    0,  819,
-      842,  818,    0,    0,  819,  842,    0,    0,  802,  802,
-        0,  818,    0,    0,    0,    0,  818,  819,  842,    0,
-      802,  802,    0,    0,  802,    0,  802,    0,    0,  818,
-        0,    0,    0,    0,    0,    0,  802,  802,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
-      827,  827,  827,  827,  827,  827,  827,  828,  841,  841,
-      841,  841,  841,  841,  841,  841,  841,  841,    0,    0,
-        0,    0,    0,    0,  828,  828,  828,  828,  828,  828,
-      828,  828,  828,  828,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
-      829,  829,  829,  843,    0,  844,    0,  847,  843,  844,
-      844,  845,  847,  845,  846,    0,  845,    0,  846,  846,
-        0,    0,  843,    0,  844,    0,  847,    0,    0,    0,
-      845,    0,  843,  846,  844,    0,  847,  843,  844,  844,
-
-      845,  847,  845,  846,  849,  845,    0,  846,  846,  849,
-      843,  848,  844,    0,  847,  848,  848,    0,  845,    0,
-      850,  846,    0,  849,    0,  850,    0,  853,    0,    0,
-      848,  854,  853,  849,  850,    0,  854,    0,  849,  850,
-      848,  853,    0,    0,  848,  848,  853,    0,  854,  850,
-      854,  849,  855,    0,  850,    0,  853,  855,  848,    0,
-      854,  853,  850,  858,    0,  854,    0,  850,  858,  853,
-        0,  855,  866,    0,  853,    0,  854,  866,  854,    0,
-      858,  855,  858,  867,    0,    0,  855,    0,  867,    0,
-        0,  866,  858,    0,  867,    0,    0,  858,    0,  855,
-
-        0,  866,  867,    0,  868,    0,  866,    0,  858,  868,
-      858,    0,  867,  869,    0,  869,    0,  867,  869,  866,
-        0,  868,  867,  868,    0,    0,    0,    0,    0,  870,
-      867,    0,  869,  868,  870,  871,    0,    0,  868,    0,
-      871,    0,  869,  870,  869,    0,    0,  869,  870,  868,
-        0,  868,    0,    0,  871,    0,    0,    0,  870,    0,
-      869,  872,    0,  870,  871,  872,  872,    0,  873,  871,
-      874,  870,  873,  873,    0,  874,  870,    0,    0,    0,
-      872,  874,  871,    0,    0,    0,    0,  873,    0,  874,
-      872,  878,    0,  877,  872,  872,  878,  873,  877,  874,
-
-        0,  873,  873,    0,  874,    0,  877,    0,  872,  874,
-      878,    0,  877,  879,  880,  873,  881,  874,  879,  880,
-      878,  881,  877,    0,    0,  878,    0,  877,    0,    0,
-        0,    0,  879,  880,  877,  881,  882,    0,  878,    0,
-      877,  882,  879,  880,  882,  881,    0,  879,  880,    0,
-      881,    0,  883,  886,    0,  882,    0,  883,  886,  885,
-      879,  880,    0,  881,  885,  882,    0,    0,    0,    0,
-      882,  883,  886,  882,    0,    0,  885,    0,  885,  887,
-        0,  883,  886,  882,  887,    0,  883,  886,  885,    0,
-      888,  890,    0,  885,    0,  888,  890,    0,  887,  883,
-
-      886,  888,  891,    0,  885,    0,  885,  891,  887,  888,
-      890,  889,    0,  887,    0,  889,  889,    0,    0,  888,
-      890,  891,  892,  897,  888,  890,  887,  892,  897,  888,
-      889,  891,    0,    0,  895,    0,  891,  888,  890,  895,
-      889,  892,  897,  906,  889,  889,    0,    0,  906,  891,
-        0,  892,  897,  895,    0,  895,  892,  897,  889,  898,
-        0,    0,  906,  895,  898,    0,  907,  898,  895,  892,
-      897,  907,  906,    0,    0,    0,    0,  906,  898,    0,
-        0,  895,    0,  895,  907,  907,    0,    0,  898,  909,
-      906,  909,    0,  898,  909,  907,  898,    0,    0,    0,
-
-      907,    0,    0,    0,    0,    0,  898,  914,  909,    0,
-        0,    0,  907,  907,    0,    0,  917,  917,  909,    0,
-      909,  917,    0,  909,  914,  914,  914,  914,  914,  914,
-      914,  914,  914,  914,    0,  917,  909,  918,    0,  919,
-        0,    0,  918,  919,  919,  917,  917,    0,  920,    0,
-      917,    0,    0,  920,    0,    0,  918,    0,  919,    0,
-        0,    0,    0,  917,    0,  920,  918,  920,  919,  921,
-      922,  918,  919,  919,  921,  922,    0,  920,  923,    0,
-        0,    0,  920,  923,  918,    0,  919,    0,  921,  922,
-        0,  923,    0,  920,    0,  920,    0,  923,  921,  922,
-
-        0,  927,    0,  921,  922,  928,  927,  923,    0,  928,
-      928,    0,  923,  927,    0,    0,  921,  922,    0,  923,
-      927,  938,    0,    0,  928,  923,  938,  930,  940,  938,
-      927,  930,  930,  940,  928,  927,    0,    0,  928,  928,
-      938,  927,    0,    0,    0,    0,  930,  940,  927,    0,
-      938,    0,  928,    0,    0,  938,  930,  940,  938,  939,
-      930,  930,  940,  939,  939,  941,  942,    0,  938,    0,
-      941,  942,    0,    0,  930,  940,    0,    0,  939,    0,
-        0,    0,  943,    0,  941,  942,  942,  943,  939,    0,
-        0,  944,  939,  939,  941,  942,  944,    0,    0,  941,
-
-      942,  943,  945,    0,  944,    0,  939,  945,    0,    0,
-      944,  943,  941,  942,  942,    0,  943,    0,  951,    0,
-      944,  945,  952,  951,    0,  944,    0,  952,    0,  943,
-        0,  945,  944,    0,    0,    0,  945,  951,  944,  955,
-        0,  952,    0,  953,  955,  953,    0,  951,  953,  945,
-        0,  952,  951,  955,    0,    0,  952,    0,  955,  956,
-        0,    0,  953,    0,  956,  951,  957,    0,  955,  952,
-      958,  957,  953,  955,  953,  958,    0,  953,  956,    0,
-        0,  955,    0,    0,    0,  957,  955,  958,  956,  958,
-      953,    0,  960,  956,    0,  957,  960,  960,    0,  958,
-
-      957,    0,    0,  963,  958,    0,  956,    0,  963,  962,
-        0,  960,    0,  957,  962,  958,  963,  958,    0,    0,
-        0,  960,  963,    0,    0,  960,  960,  962,  962,  969,
-        0,    0,  963,    0,  969,  970,    0,  963,  962,  960,
-      970,  971,    0,  962,  963,  971,  971,    0,  969,  969,
-      963,    0,  976,    0,  970,  962,  962,  976,  969,    0,
-      971,  975,    0,  969,  970,    0,  975,    0,  977,  970,
-      971,  976,  975,  977,  971,  971,  969,  969,    0,    0,
-      975,  976,  970,    0,  979,    0,  976,  977,  971,  979,
-      975,    0,    0,  985,    0,  975,    0,  977,  985,  976,
-
-      975,  978,  977,  979,  982,  978,  978,    0,  975,  982,
-        0,    0,  985,  979,    0,  977,    0,    0,  979,  982,
-      978,    0,  985,  982,  983,    0,  983,  985,    0,  983,
-      978,  979,    0,  982,  978,  978,    0,    0,  982,    0,
-      985,  993,    0,  983,  994,  992,  993,  982,  978,  994,
-      992,  982,    0,  983,    0,  983,  994,    0,  983,  992,
-      993,  995,    0,  994,  992,    0,  995,  996,    0,    0,
-      993,  983,  996,  994,  992,  993,    0,    0,  994,  992,
-      995,    0,    0,    0,  994,    0,  996,  992,  993,    0,
-      995,  994,  992, 1004,    0,  995,  996,  997, 1004,  997,
-
-     1007,  996,  997,    0, 1006, 1007, 1006,    0,  995, 1006,
-        0,    0, 1004,    0,  996,    0,  997,    0,    0, 1007,
-     1009,    0, 1004, 1006,    0, 1009,  997, 1004,  997, 1007,
-        0,  997,    0, 1006, 1007, 1006,    0, 1011, 1006, 1009,
-     1004, 1011, 1011,    0,  997,    0,    0, 1007,    0, 1009,
-        0, 1006,    0, 1012, 1009,    0, 1011, 1012, 1012,    0,
-     1020,    0,    0,    0, 1019, 1020, 1011, 1009,    0, 1019,
-     1011, 1011, 1012,    0,    0, 1019, 1025,    0,    0, 1020,
-     1025, 1025, 1012, 1019, 1011, 1026, 1012, 1012,    0, 1020,
-     1026,    0,    0, 1019, 1020, 1025,    0, 1029, 1019,    0,
-
-     1012,    0, 1029, 1019, 1026, 1025,    0, 1020, 1029, 1025,
-     1025, 1019,    0,    0, 1026,    0, 1029,    0,    0, 1026,
-     1030,    0, 1037, 1025, 1038, 1030, 1029, 1037, 1030, 1038,
-        0, 1029, 1026,    0,    0, 1037, 1029,    0,    0, 1030,
-        0, 1037,    0, 1038, 1029,    0,    0, 1039,    0, 1030,
-        0, 1037, 1039, 1038, 1030, 1039, 1037, 1030, 1038, 1047,
-        0,    0,    0, 1037, 1047,    0, 1039, 1030, 1040, 1037,
-     1044, 1038, 1040, 1040, 1044, 1044, 1039,    0, 1047,    0,
-        0, 1039,    0,    0, 1039,    0,    0, 1040, 1047, 1044,
-     1048, 1054,    0, 1047, 1039, 1048, 1054, 1040,    0, 1044,
-
-        0, 1040, 1040, 1044, 1044,    0, 1047, 1059,    0, 1048,
-     1054,    0, 1059,    0,    0, 1040, 1063, 1044,    0, 1048,
-     1054, 1063,    0, 1062, 1048, 1054, 1059, 1062, 1062,    0,
-        0,    0,    0,    0, 1063, 1063, 1059, 1048, 1054, 1067,
-        0, 1059, 1062,    0, 1067, 1063, 1068,    0, 1069,    0,
-     1063, 1068, 1062, 1069, 1059,    0, 1062, 1062, 1067, 1068,
-        0,    0, 1063, 1063,    0, 1068,    0, 1069, 1067, 1073,
-     1062, 1080, 1073, 1067, 1073, 1068, 1080, 1069,    0,    0,
-     1068,    0, 1069,    0,    0,    0, 1067, 1068, 1073,    0,
-     1080, 1087,    0, 1068, 1088, 1069, 1087,    0, 1073, 1088,
-
-     1080, 1073, 1088, 1073,    0, 1080,    0,    0,    0,    0,
-     1087,    0,    0, 1088, 1087,    0, 1073, 1091, 1080,    0,
-     1087, 1091, 1091, 1088, 1095, 1087,    0,    0, 1088, 1095,
-        0, 1088,    0,    0,    0,    0, 1091,    0, 1087,    0,
-     1105, 1088, 1087, 1095, 1095, 1105, 1091, 1106,    0, 1108,
-     1091, 1091, 1106, 1095, 1108,    0,    0,    0, 1095, 1105,
-        0, 1106,    0,    0, 1091,    0, 1106,    0, 1108, 1105,
-        0, 1095, 1095,    0, 1105,    0, 1106,    0, 1108,    0,
-        0, 1106,    0, 1108,    0,    0,    0, 1105,    0, 1106,
-        0,    0,    0,    0, 1106,    0, 1108, 1109, 1109, 1109,
-
-        0,    0, 1109, 1109,    0, 1109,    0,    0,    0, 1109,
-     1109,    0,    0, 1109,    0,    0, 1109, 1109, 1109, 1109,
-     1109, 1109, 1109, 1109, 1109, 1112, 1122,    0,    0,    0,
-     1112, 1122,    0,    0,    0,    0,    0,    0,    0, 1122,
-        0,    0, 1112,    0, 1112, 1122,    0,    0,    0,    0,
-        0,    0,    0,    0, 1112, 1122,    0,    0,    0, 1112,
-     1122,    0,    0,    0,    0,    0,    0, 1122,    0,    0,
-     1112,    0, 1112, 1122, 1126, 1126, 1126,    0,    0, 1126,
-     1126,    0, 1126,    0, 1128, 1126, 1126, 1126, 1128, 1128,
-     1126,    0,    0, 1126, 1126, 1126, 1126, 1126, 1126, 1126,
-
-     1126, 1126,    0, 1128, 1133, 1137,    0,    0,    0, 1133,
-     1137,    0,    0, 1128,    0,    0,    0, 1128, 1128,    0,
-        0,    0,    0, 1133, 1137,    0,    0,    0,    0,    0,
-        0, 1128,    0, 1133, 1137,    0,    0,    0, 1133, 1137,
-        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
-        0, 1133, 1137, 1162, 1162, 1162, 1162, 1162, 1162, 1162,
-     1162, 1162, 1162, 1162, 1162, 1163, 1163, 1163, 1163, 1163,
-     1163, 1163, 1163, 1163, 1163, 1163, 1163, 1164, 1164,    0,
-     1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1165,
-     1165,    0, 1165, 1165, 1165, 1165, 1165, 1165, 1165, 1165,
-
-     1165, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166,
-     1166, 1166, 1166, 1167, 1167, 1167, 1167, 1167, 1167, 1167,
-     1167, 1167, 1167, 1167, 1167, 1168, 1168, 1169, 1169, 1169,
-     1169, 1169, 1169, 1169, 1169, 1170, 1170, 1170, 1170, 1170,
-     1170, 1170, 1170, 1170, 1170, 1170, 1170, 1171, 1171, 1171,
-     1171, 1171, 1171, 1171, 1171, 1171, 1171, 1171, 1171, 1172,
-     1172, 1172, 1172, 1172, 1172,    0, 1172, 1172, 1172,    0,
-     1172, 1173, 1173, 1173, 1173, 1173, 1173, 1173, 1173, 1173,
-     1173, 1173, 1173, 1174,    0,    0, 1174, 1175, 1175, 1175,
-        0,    0, 1175,    0, 1175, 1175,    0, 1175, 1175, 1176,
-
-     1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176,
-     1176, 1177, 1177,    0, 1177, 1177, 1177, 1177, 1177, 1177,
-     1177, 1177, 1177, 1178, 1178, 1178, 1178, 1178, 1178,    0,
-     1178, 1178, 1178,    0, 1178, 1179, 1179, 1179, 1179, 1179,
-     1179, 1179, 1179, 1179, 1179, 1179, 1179, 1180, 1180, 1180,
-     1180, 1180, 1180, 1180, 1180, 1180, 1180, 1180, 1180, 1181,
-        0,    0, 1181, 1182,    0,    0,    0, 1182,    0,    0,
-        0,    0,    0, 1182, 1183, 1183, 1183, 1183, 1183, 1183,
-     1183, 1183, 1183, 1183, 1183, 1183, 1184, 1184,    0, 1184,
-     1184, 1184, 1184, 1184, 1184, 1184, 1184, 1184, 1185, 1185,
-
-        0, 1185, 1185, 1185, 1185, 1185, 1185, 1185, 1185, 1185,
-     1186, 1186,    0, 1186, 1186, 1186, 1186, 1186, 1186, 1186,
-     1186, 1186, 1187, 1187, 1187, 1187, 1187, 1187, 1187, 1187,
-     1187, 1187, 1187, 1187, 1188, 1188, 1188, 1188, 1188, 1188,
-     1188, 1188, 1188, 1188, 1188, 1188, 1189, 1189, 1189, 1189,
-     1189, 1189, 1189, 1189, 1189, 1189, 1189, 1189, 1190, 1190,
-     1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190,
-     1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191,
-     1191, 1191, 1192, 1192,    0, 1192, 1192, 1192, 1192, 1192,
-     1192, 1192, 1192, 1192, 1193, 1193, 1193, 1193, 1193, 1193,
-
-     1193, 1193, 1193, 1193, 1193, 1193, 1194, 1194, 1194, 1194,
-     1194, 1194, 1194, 1194, 1194, 1194, 1194, 1194, 1195, 1195,
-        0, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195,
-     1196, 1196,    0, 1196, 1196, 1196, 1196, 1196, 1196, 1196,
-     1196, 1196, 1197, 1197,    0, 1197, 1197, 1197, 1197, 1197,
-     1197, 1197, 1197, 1197, 1198, 1198,    0, 1198, 1198, 1198,
-     1198, 1198, 1198, 1198, 1198, 1198, 1199, 1199,    0, 1199,
-     1199, 1199, 1199, 1199, 1199, 1199, 1199, 1199, 1200, 1200,
-     1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200,
-     1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201,
-
-     1201, 1201, 1202, 1202, 1202, 1202, 1202, 1202, 1202, 1202,
-     1202, 1202, 1202, 1202, 1203, 1203, 1203, 1203, 1203, 1203,
-     1203, 1203, 1203, 1203, 1203, 1203, 1204, 1204, 1204, 1204,
-     1204, 1204, 1204, 1204, 1204, 1204, 1204, 1204, 1205, 1205,
-     1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205,
-     1206, 1206,    0, 1206, 1206, 1206, 1206, 1206, 1206, 1206,
-     1206, 1206, 1207, 1207,    0, 1207, 1207, 1207, 1207, 1207,
-     1207, 1207, 1207, 1207, 1208, 1208, 1208, 1208, 1208, 1208,
-     1208, 1208, 1208, 1208, 1208, 1208, 1209, 1209, 1209, 1209,
-     1209, 1209, 1209, 1209, 1209, 1209, 1209, 1209, 1210, 1210,
-
-     1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210,
-     1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211,
-     1211, 1211, 1212, 1212, 1212, 1212, 1212, 1212, 1212, 1212,
-     1212, 1212, 1212, 1212, 1213, 1213, 1213, 1213, 1213, 1213,
-     1213, 1213, 1213, 1213, 1213, 1213, 1214, 1214, 1214, 1214,
-     1214, 1214, 1214, 1214, 1214, 1214, 1214, 1214, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
-     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161
-    } ;
-
-static yy_state_type yy_last_accepting_state;
-static char *yy_last_accepting_cpos;
-
-extern int fortran_flex_debug;
-int fortran_flex_debug = 0;
-
-/* The intent behind this definition is that it'll catch
- * any uses of REJECT which flex missed.
- */
-#define REJECT reject_used_but_not_detected
-#define yymore() yymore_used_but_not_detected
-#define YY_MORE_ADJ 0
-#define YY_RESTORE_YY_MORE_OFFSET
-char *fortrantext;
-#line 1 "fortran.lex"
-/******************************************************************************/
-/*                                                                            */
-/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
-/*                                                                            */
-/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
-/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
-/* This software is governed by the CeCILL-C license under French law and     */
-/* abiding by the rules of distribution of free software.  You can  use,      */
-/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
-/* license as circulated by CEA, CNRS and INRIA at the following URL          */
-/* "http://www.cecill.info".                                                  */
-/*                                                                            */
-/* As a counterpart to the access to the source code and  rights to copy,     */
-/* modify and redistribute granted by the license, users are provided only    */
-/* with a limited warranty  and the software's author,  the holder of the     */
-/* economic rights,  and the successive licensors  have only  limited         */
-/* liability.                                                                 */
-/*                                                                            */
-/* In this respect, the user's attention is drawn to the risks associated     */
-/* with loading,  using,  modifying and/or developing or reproducing the      */
-/* software by the user in light of its specific status of free software,     */
-/* that may mean  that it is complicated to manipulate,  and  that  also      */
-/* therefore means  that it is reserved for developers  and  experienced      */
-/* professionals having in-depth computer knowledge. Users are therefore      */
-/* encouraged to load and test the software's suitability as regards their    */
-/* requirements in conditions enabling the security of their systems and/or   */
-/* data to be ensured and,  more generally, to use and operate it in the      */
-/* same conditions as regards security.                                       */
-/*                                                                            */
-/* The fact that you are presently reading this means that you have had       */
-/* knowledge of the CeCILL-C license and that you accept its terms.           */
-/******************************************************************************/
-/* version 1.7                                                                */
-/******************************************************************************/
-
-
-
-
-
-#line 41 "fortran.lex"
-#include <math.h>
-#include <stdlib.h>
-#include <string.h>
-extern FILE * fortranin;
-#define MAX_INCLUDE_DEPTH 30
-#define tabsize 6
-YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
-int line_num_fortran=1;
-int line_num_fortran_common=1;
-int newlinef90 = 0;
-char *tmp;
-char tmpc;
-/******************************************************************************/
-/**************PETITS PB NON PREVUS *******************************************/
-/******************************************************************************/
-/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
-/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
-/*            de la 7eme et le debut de la ligne de commande                  */
-/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
-/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
-/******************************************************************************/
-#define YY_USER_ACTION \
-        {\
-           if (firstpass == 0) \
-           {\
-              strcat(curbuf,fortrantext); \
-              Save_Length(curbuf,38); \
-              strcpy(motparse,fortrantext);\
-              Save_Length(motparse,32); \
-              colnum = colnum + strlen(motparse);\
-              ECHO; \
-           }\
-           strcpy(motparse1,fortrantext);\
-/*           printf("fortrantext = %s\n",fortrantext);*/\
-        /*if ( firstpass == 1 ) 
-                      printf("fortrantext = %s %d\n",fortrantext,strlen(fortrantext));*/\
-        }
-#line 2979 "fortran.yy.c"
-
-#define INITIAL 0
-#define parameter 1
-#define character 2
-#define donottreat 3
-#define fortran77style 4
-#define fortran90style 5
-
-#ifndef YY_NO_UNISTD_H
-/* Special case for "unistd.h", since it is non-ANSI. We include it way
- * down here because we want the user's section 1 to have been scanned first.
- * The user has a chance to override it with an option.
- */
-#include <unistd.h>
-#endif
-
-#ifndef YY_EXTRA_TYPE
-#define YY_EXTRA_TYPE void *
-#endif
-
-static int yy_init_globals (void );
-
-/* Accessor methods to globals.
-   These are made visible to non-reentrant scanners for convenience. */
-
-int fortranlex_destroy (void );
-
-int fortranget_debug (void );
-
-void fortranset_debug (int debug_flag  );
-
-YY_EXTRA_TYPE fortranget_extra (void );
-
-void fortranset_extra (YY_EXTRA_TYPE user_defined  );
-
-FILE *fortranget_in (void );
-
-void fortranset_in  (FILE * in_str  );
-
-FILE *fortranget_out (void );
-
-void fortranset_out  (FILE * out_str  );
-
-yy_size_t fortranget_leng (void );
-
-char *fortranget_text (void );
-
-int fortranget_lineno (void );
-
-void fortranset_lineno (int line_number  );
-
-/* Macros after this point can all be overridden by user definitions in
- * section 1.
- */
-
-#ifndef YY_SKIP_YYWRAP
-#ifdef __cplusplus
-extern "C" int fortranwrap (void );
-#else
-extern int fortranwrap (void );
-#endif
-#endif
-
-    static void yyunput (int c,char *buf_ptr  );
-    
-#ifndef yytext_ptr
-static void yy_flex_strncpy (char *,yyconst char *,int );
-#endif
-
-#ifdef YY_NEED_STRLEN
-static int yy_flex_strlen (yyconst char * );
-#endif
-
-#ifndef YY_NO_INPUT
-
-#ifdef __cplusplus
-static int yyinput (void );
-#else
-static int input (void );
-#endif
-
-#endif
-
-/* Amount of stuff to slurp up with each read. */
-#ifndef YY_READ_BUF_SIZE
-#define YY_READ_BUF_SIZE 8192
-#endif
-
-/* Copy whatever the last rule matched to the standard output. */
-#ifndef ECHO
-/* This used to be an fputs(), but since the string might contain NUL's,
- * we now use fwrite().
- */
-#define ECHO fwrite( fortrantext, fortranleng, 1, fortranout )
-#endif
-
-/* Gets input and stuffs it into "buf".  number of characters read, or YY_NULL,
- * is returned in "result".
- */
-#ifndef YY_INPUT
-#define YY_INPUT(buf,result,max_size) \
-	if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
-		{ \
-		int c = '*'; \
-		yy_size_t n; \
-		for ( n = 0; n < max_size && \
-			     (c = getc( fortranin )) != EOF && c != '\n'; ++n ) \
-			buf[n] = (char) c; \
-		if ( c == '\n' ) \
-			buf[n++] = (char) c; \
-		if ( c == EOF && ferror( fortranin ) ) \
-			YY_FATAL_ERROR( "input in flex scanner failed" ); \
-		result = n; \
-		} \
-	else \
-		{ \
-		errno=0; \
-		while ( (result = fread(buf, 1, max_size, fortranin))==0 && ferror(fortranin)) \
-			{ \
-			if( errno != EINTR) \
-				{ \
-				YY_FATAL_ERROR( "input in flex scanner failed" ); \
-				break; \
-				} \
-			errno=0; \
-			clearerr(fortranin); \
-			} \
-		}\
-\
-
-#endif
-
-/* No semi-colon after return; correct usage is to write "yyterminate();" -
- * we don't want an extra ';' after the "return" because that will cause
- * some compilers to complain about unreachable statements.
- */
-#ifndef yyterminate
-#define yyterminate() return YY_NULL
-#endif
-
-/* Number of entries by which start-condition stack grows. */
-#ifndef YY_START_STACK_INCR
-#define YY_START_STACK_INCR 25
-#endif
-
-/* Report a fatal error. */
-#ifndef YY_FATAL_ERROR
-#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
-#endif
-
-/* end tables serialization structures and prototypes */
-
-/* Default declaration of generated scanner - a define so the user can
- * easily add parameters.
- */
-#ifndef YY_DECL
-#define YY_DECL_IS_OURS 1
-
-extern int fortranlex (void);
-
-#define YY_DECL int fortranlex (void)
-#endif /* !YY_DECL */
-
-/* Code executed at the beginning of each rule, after fortrantext and fortranleng
- * have been set up.
- */
-#ifndef YY_USER_ACTION
-#define YY_USER_ACTION
-#endif
-
-/* Code executed at the end of each rule. */
-#ifndef YY_BREAK
-#define YY_BREAK break;
-#endif
-
-#define YY_RULE_SETUP \
-	if ( fortranleng > 0 ) \
-		YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \
-				(fortrantext[fortranleng - 1] == '\n'); \
-	YY_USER_ACTION
-
-/** The main scanner function which does all the work.
- */
-YY_DECL
-{
-	register yy_state_type yy_current_state;
-	register char *yy_cp, *yy_bp;
-	register int yy_act;
-    
-#line 107 "fortran.lex"
-
-  if (infixed) BEGIN(fortran77style) ;
-  if (infree) BEGIN(fortran90style)  ;
-
-#line 3174 "fortran.yy.c"
-
-	if ( !(yy_init) )
-		{
-		(yy_init) = 1;
-
-#ifdef YY_USER_INIT
-		YY_USER_INIT;
-#endif
-
-		if ( ! (yy_start) )
-			(yy_start) = 1;	/* first start state */
-
-		if ( ! fortranin )
-			fortranin = stdin;
-
-		if ( ! fortranout )
-			fortranout = stdout;
-
-		if ( ! YY_CURRENT_BUFFER ) {
-			fortranensure_buffer_stack ();
-			YY_CURRENT_BUFFER_LVALUE =
-				fortran_create_buffer(fortranin,YY_BUF_SIZE );
-		}
-
-		fortran_load_buffer_state( );
-		}
-
-	while ( 1 )		/* loops until end-of-file is reached */
-		{
-		yy_cp = (yy_c_buf_p);
-
-		/* Support of fortrantext. */
-		*yy_cp = (yy_hold_char);
-
-		/* yy_bp points to the position in yy_ch_buf of the start of
-		 * the current run.
-		 */
-		yy_bp = yy_cp;
-
-		yy_current_state = (yy_start);
-		yy_current_state += YY_AT_BOL();
-yy_match:
-		do
-			{
-			register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
-			if ( yy_accept[yy_current_state] )
-				{
-				(yy_last_accepting_state) = yy_current_state;
-				(yy_last_accepting_cpos) = yy_cp;
-				}
-			while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
-				{
-				yy_current_state = (int) yy_def[yy_current_state];
-				if ( yy_current_state >= 1162 )
-					yy_c = yy_meta[(unsigned int) yy_c];
-				}
-			yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
-			++yy_cp;
-			}
-		while ( yy_base[yy_current_state] != 9159 );
-
-yy_find_action:
-		yy_act = yy_accept[yy_current_state];
-		if ( yy_act == 0 )
-			{ /* have to back up */
-			yy_cp = (yy_last_accepting_cpos);
-			yy_current_state = (yy_last_accepting_state);
-			yy_act = yy_accept[yy_current_state];
-			}
-
-		YY_DO_BEFORE_ACTION;
-
-do_action:	/* This label is used only to access EOF actions. */
-
-		switch ( yy_act )
-	{ /* beginning of action switch */
-			case 0: /* must back up */
-			/* undo the effects of YY_DO_BEFORE_ACTION */
-			*yy_cp = (yy_hold_char);
-			yy_cp = (yy_last_accepting_cpos);
-			yy_current_state = (yy_last_accepting_state);
-			goto yy_find_action;
-
-case 1:
-YY_RULE_SETUP
-#line 111 "fortran.lex"
-return TOK_DEBUT;
-	YY_BREAK
-case 2:
-YY_RULE_SETUP
-#line 112 "fortran.lex"
-return TOK_FIN;
-	YY_BREAK
-case 3:
-YY_RULE_SETUP
-#line 113 "fortran.lex"
-return TOK_OMP;
-	YY_BREAK
-case 4:
-YY_RULE_SETUP
-#line 114 "fortran.lex"
-return TOK_DOLLAR;
-	YY_BREAK
-case 5:
-YY_RULE_SETUP
-#line 116 "fortran.lex"
-{return TOK_REAL8;}
-	YY_BREAK
-case 6:
-YY_RULE_SETUP
-#line 117 "fortran.lex"
-{return TOK_SUBROUTINE;}
-	YY_BREAK
-case 7:
-YY_RULE_SETUP
-#line 118 "fortran.lex"
-{return TOK_PROGRAM;}
-	YY_BREAK
-case 8:
-YY_RULE_SETUP
-#line 119 "fortran.lex"
-{inallocate = 1; return TOK_ALLOCATE;}
-	YY_BREAK
-case 9:
-YY_RULE_SETUP
-#line 120 "fortran.lex"
-{return TOK_NULLIFY;}
-	YY_BREAK
-case 10:
-YY_RULE_SETUP
-#line 121 "fortran.lex"
-{inallocate = 1; return TOK_DEALLOCATE;}
-	YY_BREAK
-case 11:
-YY_RULE_SETUP
-#line 122 "fortran.lex"
-{return TOK_RESULT;}
-	YY_BREAK
-case 12:
-YY_RULE_SETUP
-#line 123 "fortran.lex"
-{return TOK_FUNCTION;}
-	YY_BREAK
-case 13:
-YY_RULE_SETUP
-#line 124 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDSUBROUTINE;}
-	YY_BREAK
-case 14:
-YY_RULE_SETUP
-#line 125 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDPROGRAM;}
-	YY_BREAK
-case 15:
-YY_RULE_SETUP
-#line 126 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDFUNCTION;}
-	YY_BREAK
-case 16:
-YY_RULE_SETUP
-#line 127 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_ENDUNIT;}
-	YY_BREAK
-case 17:
-YY_RULE_SETUP
-#line 128 "fortran.lex"
-return TOK_INCLUDE;
-	YY_BREAK
-case 18:
-YY_RULE_SETUP
-#line 129 "fortran.lex"
-{
-                            strcpy(yylval.na,fortrantext);
-                            tmpc = input();
-                            unput(tmpc);
-                            if ( (
-                               tmpc >= 'a' && tmpc <= 'z'
-                                  ) || (
-                               tmpc >= 'A' && tmpc <= 'Z'
-                               )  )
-                               {
-                                  return TOK_USE;
-                               }
-                               else
-                               {
-                                  return TOK_NAME;
-                               }
-                         }
-	YY_BREAK
-case 19:
-YY_RULE_SETUP
-#line 146 "fortran.lex"
-{return TOK_REWIND;}
-	YY_BREAK
-case 20:
-YY_RULE_SETUP
-#line 147 "fortran.lex"
-return TOK_IMPLICIT;
-	YY_BREAK
-case 21:
-YY_RULE_SETUP
-#line 148 "fortran.lex"
-return TOK_NONE;
-	YY_BREAK
-case 22:
-YY_RULE_SETUP
-#line 149 "fortran.lex"
-return TOK_CALL;
-	YY_BREAK
-case 23:
-YY_RULE_SETUP
-#line 150 "fortran.lex"
-return TOK_TRUE;
-	YY_BREAK
-case 24:
-YY_RULE_SETUP
-#line 151 "fortran.lex"
-return TOK_FALSE;
-	YY_BREAK
-case 25:
-YY_RULE_SETUP
-#line 152 "fortran.lex"
-{return TOK_POINT_TO;}
-	YY_BREAK
-case 26:
-YY_RULE_SETUP
-#line 153 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DASTER;}
-	YY_BREAK
-case 27:
-YY_RULE_SETUP
-#line 154 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_EQV;}
-	YY_BREAK
-case 28:
-YY_RULE_SETUP
-#line 155 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_EQ;}
-	YY_BREAK
-case 29:
-YY_RULE_SETUP
-#line 156 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_GT;}
-	YY_BREAK
-case 30:
-YY_RULE_SETUP
-#line 157 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_GE;}
-	YY_BREAK
-case 31:
-YY_RULE_SETUP
-#line 158 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_LT;}
-	YY_BREAK
-case 32:
-YY_RULE_SETUP
-#line 159 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_LE;}
-	YY_BREAK
-case 33:
-YY_RULE_SETUP
-#line 160 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NEQV;}
-	YY_BREAK
-case 34:
-YY_RULE_SETUP
-#line 161 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NE;}
-	YY_BREAK
-case 35:
-YY_RULE_SETUP
-#line 162 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NOT;}
-	YY_BREAK
-case 36:
-YY_RULE_SETUP
-#line 163 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_OR;}
-	YY_BREAK
-case 37:
-YY_RULE_SETUP
-#line 164 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_XOR;}
-	YY_BREAK
-case 38:
-YY_RULE_SETUP
-#line 165 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_AND;}
-	YY_BREAK
-case 39:
-YY_RULE_SETUP
-#line 166 "fortran.lex"
-{return TOK_MODULE;}
-	YY_BREAK
-case 40:
-YY_RULE_SETUP
-#line 167 "fortran.lex"
-{return TOK_DOWHILE;}
-	YY_BREAK
-case 41:
-YY_RULE_SETUP
-#line 168 "fortran.lex"
-return TOK_ENDMODULE;
-	YY_BREAK
-case 42:
-YY_RULE_SETUP
-#line 169 "fortran.lex"
-return TOK_ENDDO;
-	YY_BREAK
-case 43:
-YY_RULE_SETUP
-#line 170 "fortran.lex"
-{return TOK_PLAINDO;}
-	YY_BREAK
-case 44:
-YY_RULE_SETUP
-#line 171 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_REAL;}
-	YY_BREAK
-case 45:
-YY_RULE_SETUP
-#line 172 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_INTEGER;}
-	YY_BREAK
-case 46:
-YY_RULE_SETUP
-#line 173 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_LOGICAL;}
-	YY_BREAK
-case 47:
-YY_RULE_SETUP
-#line 174 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHARACTER;}
-	YY_BREAK
-case 48:
-YY_RULE_SETUP
-#line 175 "fortran.lex"
-{return TOK_ALLOCATABLE;}
-	YY_BREAK
-case 49:
-YY_RULE_SETUP
-#line 176 "fortran.lex"
-return TOK_CLOSE;
-	YY_BREAK
-case 50:
-YY_RULE_SETUP
-#line 177 "fortran.lex"
-return TOK_INQUIRE;
-	YY_BREAK
-case 51:
-YY_RULE_SETUP
-#line 178 "fortran.lex"
-{return TOK_DIMENSION;}
-	YY_BREAK
-case 52:
-YY_RULE_SETUP
-#line 179 "fortran.lex"
-return TOK_PAUSE;
-	YY_BREAK
-case 53:
-YY_RULE_SETUP
-#line 180 "fortran.lex"
-return TOK_EQUIVALENCE;
-	YY_BREAK
-case 54:
-YY_RULE_SETUP
-#line 181 "fortran.lex"
-return TOK_STOP;
-	YY_BREAK
-case 55:
-YY_RULE_SETUP
-#line 182 "fortran.lex"
-return TOK_WHERE;
-	YY_BREAK
-case 56:
-YY_RULE_SETUP
-#line 183 "fortran.lex"
-return TOK_ENDWHERE;
-	YY_BREAK
-case 57:
-YY_RULE_SETUP
-#line 184 "fortran.lex"
-return TOK_ELSEWHERE;
-	YY_BREAK
-case 58:
-YY_RULE_SETUP
-#line 185 "fortran.lex"
-{return TOK_COMPLEX;}
-	YY_BREAK
-case 59:
-YY_RULE_SETUP
-#line 186 "fortran.lex"
-{return TOK_CONTAINS;}
-	YY_BREAK
-case 60:
-YY_RULE_SETUP
-#line 187 "fortran.lex"
-{return TOK_ONLY;}
-	YY_BREAK
-case 61:
-YY_RULE_SETUP
-#line 188 "fortran.lex"
-{return TOK_PARAMETER;}
-	YY_BREAK
-case 62:
-YY_RULE_SETUP
-#line 189 "fortran.lex"
-{return TOK_RECURSIVE;}
-	YY_BREAK
-case 63:
-YY_RULE_SETUP
-#line 190 "fortran.lex"
-{return TOK_COMMON;}
-	YY_BREAK
-case 64:
-YY_RULE_SETUP
-#line 191 "fortran.lex"
-{return TOK_GLOBAL;}
-	YY_BREAK
-case 65:
-YY_RULE_SETUP
-#line 192 "fortran.lex"
-{return TOK_EXTERNAL;}
-	YY_BREAK
-case 66:
-YY_RULE_SETUP
-#line 193 "fortran.lex"
-{return TOK_INTENT;}
-	YY_BREAK
-case 67:
-YY_RULE_SETUP
-#line 194 "fortran.lex"
-{return TOK_POINTER;}
-	YY_BREAK
-case 68:
-YY_RULE_SETUP
-#line 195 "fortran.lex"
-{return TOK_OPTIONAL;}
-	YY_BREAK
-case 69:
-YY_RULE_SETUP
-#line 196 "fortran.lex"
-{return TOK_SAVE;}
-	YY_BREAK
-case 70:
-YY_RULE_SETUP
-#line 197 "fortran.lex"
-{return TOK_TYPE;}
-	YY_BREAK
-case 71:
-YY_RULE_SETUP
-#line 198 "fortran.lex"
-{return TOK_TYPEPAR;}
-	YY_BREAK
-case 72:
-YY_RULE_SETUP
-#line 199 "fortran.lex"
-{if (inallocate == 1) return TOK_STAT; else {strcpy(yylval.na,fortrantext);return TOK_NAME;}}
-	YY_BREAK
-case 73:
-YY_RULE_SETUP
-#line 200 "fortran.lex"
-{return TOK_ENDTYPE;}
-	YY_BREAK
-case 74:
-YY_RULE_SETUP
-#line 201 "fortran.lex"
-return TOK_OPEN;
-	YY_BREAK
-case 75:
-YY_RULE_SETUP
-#line 202 "fortran.lex"
-return TOK_RETURN;
-	YY_BREAK
-case 76:
-/* rule 76 can match eol */
-YY_RULE_SETUP
-#line 203 "fortran.lex"
-return TOK_EXIT;
-	YY_BREAK
-case 77:
-YY_RULE_SETUP
-#line 204 "fortran.lex"
-return TOK_PRINT;
-	YY_BREAK
-case 78:
-YY_RULE_SETUP
-#line 205 "fortran.lex"
-{return TOK_PROCEDURE;}
-	YY_BREAK
-case 79:
-YY_RULE_SETUP
-#line 206 "fortran.lex"
-{return TOK_READ;}
-	YY_BREAK
-case 80:
-YY_RULE_SETUP
-#line 207 "fortran.lex"
-{return TOK_NAMELIST;}
-	YY_BREAK
-case 81:
-YY_RULE_SETUP
-#line 208 "fortran.lex"
-{return TOK_WRITE;}
-	YY_BREAK
-case 82:
-YY_RULE_SETUP
-#line 209 "fortran.lex"
-{return TOK_TARGET;}
-	YY_BREAK
-case 83:
-YY_RULE_SETUP
-#line 210 "fortran.lex"
-{return TOK_PUBLIC;}
-	YY_BREAK
-case 84:
-YY_RULE_SETUP
-#line 211 "fortran.lex"
-{return TOK_PRIVATE;}
-	YY_BREAK
-case 85:
-YY_RULE_SETUP
-#line 212 "fortran.lex"
-{strcpy(yylval.nac,fortrantext);return TOK_IN;}
-	YY_BREAK
-case 86:
-YY_RULE_SETUP
-#line 213 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DATA;}
-	YY_BREAK
-case 87:
-YY_RULE_SETUP
-#line 214 "fortran.lex"
-return TOK_CONTINUE;
-	YY_BREAK
-case 88:
-YY_RULE_SETUP
-#line 215 "fortran.lex"
-{return TOK_PLAINGOTO;}
-	YY_BREAK
-case 89:
-YY_RULE_SETUP
-#line 216 "fortran.lex"
-{strcpy(yylval.nac,fortrantext);return TOK_OUT;}
-	YY_BREAK
-case 90:
-YY_RULE_SETUP
-#line 217 "fortran.lex"
-{strcpy(yylval.nac,fortrantext);return TOK_INOUT;}
-	YY_BREAK
-case 91:
-YY_RULE_SETUP
-#line 218 "fortran.lex"
-{return TOK_INTRINSIC;}
-	YY_BREAK
-case 92:
-YY_RULE_SETUP
-#line 219 "fortran.lex"
-{return TOK_THEN;}
-	YY_BREAK
-case 93:
-YY_RULE_SETUP
-#line 220 "fortran.lex"
-{return TOK_ELSEIF;}
-	YY_BREAK
-case 94:
-YY_RULE_SETUP
-#line 221 "fortran.lex"
-{return TOK_ELSE;}
-	YY_BREAK
-case 95:
-YY_RULE_SETUP
-#line 222 "fortran.lex"
-{return TOK_ENDIF;}
-	YY_BREAK
-case 96:
-YY_RULE_SETUP
-#line 223 "fortran.lex"
-{return TOK_LOGICALIF;}
-	YY_BREAK
-case 97:
-YY_RULE_SETUP
-#line 224 "fortran.lex"
-{return TOK_SUM;}
-	YY_BREAK
-case 98:
-YY_RULE_SETUP
-#line 225 "fortran.lex"
-{return TOK_MAX;}
-	YY_BREAK
-case 99:
-YY_RULE_SETUP
-#line 226 "fortran.lex"
-{return TOK_TANH;}
-	YY_BREAK
-case 100:
-YY_RULE_SETUP
-#line 227 "fortran.lex"
-{return TOK_MAXVAL;}
-	YY_BREAK
-case 101:
-YY_RULE_SETUP
-#line 228 "fortran.lex"
-{return TOK_TRIM;}
-	YY_BREAK
-case 102:
-YY_RULE_SETUP
-#line 229 "fortran.lex"
-{return TOK_SQRT;}
-	YY_BREAK
-case 103:
-YY_RULE_SETUP
-#line 230 "fortran.lex"
-{return TOK_SELECTCASE;}
-	YY_BREAK
-case 104:
-YY_RULE_SETUP
-#line 231 "fortran.lex"
-{return TOK_CASE;}
-	YY_BREAK
-case 105:
-YY_RULE_SETUP
-#line 232 "fortran.lex"
-{return TOK_CASEDEFAULT;}
-	YY_BREAK
-case 106:
-YY_RULE_SETUP
-#line 233 "fortran.lex"
-{return TOK_ENDSELECT;}
-	YY_BREAK
-case 107:
-YY_RULE_SETUP
-#line 234 "fortran.lex"
-{return TOK_FILE;}
-	YY_BREAK
-case 108:
-YY_RULE_SETUP
-#line 235 "fortran.lex"
-{return TOK_END;}
-	YY_BREAK
-case 109:
-YY_RULE_SETUP
-#line 236 "fortran.lex"
-{return TOK_ERR;}
-	YY_BREAK
-case 110:
-YY_RULE_SETUP
-#line 237 "fortran.lex"
-{return TOK_EXIST;}
-	YY_BREAK
-case 111:
-YY_RULE_SETUP
-#line 238 "fortran.lex"
-{return TOK_MIN;}
-	YY_BREAK
-case 112:
-YY_RULE_SETUP
-#line 239 "fortran.lex"
-{return TOK_NINT;}
-	YY_BREAK
-case 113:
-YY_RULE_SETUP
-#line 240 "fortran.lex"
-{return TOK_FLOAT;}
-	YY_BREAK
-case 114:
-YY_RULE_SETUP
-#line 241 "fortran.lex"
-{return TOK_EXP;}
-	YY_BREAK
-case 115:
-YY_RULE_SETUP
-#line 242 "fortran.lex"
-{return TOK_COS;}
-	YY_BREAK
-case 116:
-YY_RULE_SETUP
-#line 243 "fortran.lex"
-{return TOK_COSH;}
-	YY_BREAK
-case 117:
-YY_RULE_SETUP
-#line 244 "fortran.lex"
-{return TOK_ACOS;}
-	YY_BREAK
-case 118:
-YY_RULE_SETUP
-#line 245 "fortran.lex"
-{return TOK_SIN;}
-	YY_BREAK
-case 119:
-YY_RULE_SETUP
-#line 246 "fortran.lex"
-{return TOK_SINH;}
-	YY_BREAK
-case 120:
-YY_RULE_SETUP
-#line 247 "fortran.lex"
-{return TOK_ASIN;}
-	YY_BREAK
-case 121:
-YY_RULE_SETUP
-#line 248 "fortran.lex"
-{return TOK_LOG;}
-	YY_BREAK
-case 122:
-YY_RULE_SETUP
-#line 249 "fortran.lex"
-{return TOK_TAN;}
-	YY_BREAK
-case 123:
-YY_RULE_SETUP
-#line 250 "fortran.lex"
-{return TOK_ATAN;}
-	YY_BREAK
-case 124:
-YY_RULE_SETUP
-#line 251 "fortran.lex"
-{return TOK_CYCLE;}
-	YY_BREAK
-case 125:
-YY_RULE_SETUP
-#line 252 "fortran.lex"
-{return TOK_ABS;}
-	YY_BREAK
-case 126:
-YY_RULE_SETUP
-#line 253 "fortran.lex"
-{return TOK_MOD;}
-	YY_BREAK
-case 127:
-YY_RULE_SETUP
-#line 254 "fortran.lex"
-{return TOK_SIGN;}
-	YY_BREAK
-case 128:
-YY_RULE_SETUP
-#line 255 "fortran.lex"
-{return TOK_MINLOC;}
-	YY_BREAK
-case 129:
-YY_RULE_SETUP
-#line 256 "fortran.lex"
-{return TOK_MAXLOC;}
-	YY_BREAK
-case 130:
-YY_RULE_SETUP
-#line 257 "fortran.lex"
-{return TOK_MINVAL;}
-	YY_BREAK
-case 131:
-YY_RULE_SETUP
-#line 258 "fortran.lex"
-{return TOK_BACKSPACE;}
-	YY_BREAK
-case 132:
-YY_RULE_SETUP
-#line 259 "fortran.lex"
-{return TOK_LEFTAB;}
-	YY_BREAK
-case 133:
-YY_RULE_SETUP
-#line 260 "fortran.lex"
-{return TOK_RIGHTAB;}
-	YY_BREAK
-case 134:
-/* rule 134 can match eol */
-YY_RULE_SETUP
-#line 261 "fortran.lex"
-{return TOK_FORMAT;}
-	YY_BREAK
-case 135:
-YY_RULE_SETUP
-#line 262 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DOUBLEPRECISION;}
-	YY_BREAK
-case 136:
-YY_RULE_SETUP
-#line 263 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DOUBLECOMPLEX;}
-	YY_BREAK
-case 137:
-YY_RULE_SETUP
-#line 264 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_SLASH;}
-	YY_BREAK
-case 138:
-YY_RULE_SETUP
-#line 265 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_DSLASH;}
-	YY_BREAK
-case 139:
-/* rule 139 can match eol */
-YY_RULE_SETUP
-#line 266 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_CUT;}
-	YY_BREAK
-case 140:
-YY_RULE_SETUP
-#line 267 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_CONSTANT;}
-	YY_BREAK
-case 141:
-YY_RULE_SETUP
-#line 268 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_MESSAGE;}
-	YY_BREAK
-case 142:
-YY_RULE_SETUP
-#line 269 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CHAR_INT;}
-	YY_BREAK
-case 143:
-YY_RULE_SETUP
-#line 270 "fortran.lex"
-{printf("debug interfacer\n");BEGIN(donottreat);}
-	YY_BREAK
-case 144:
-/* rule 144 can match eol */
-YY_RULE_SETUP
-#line 271 "fortran.lex"
-{
-						BEGIN(INITIAL);
-                        if (infixed) BEGIN(fortran77style) ;
-                        if (infree) BEGIN(fortran90style)  ;
-                        line_num_fortran++;line_num_fortran_common++;
-                        return '\n';
-						}
-	YY_BREAK
-case 145:
-YY_RULE_SETUP
-#line 278 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_NAME;}
-	YY_BREAK
-case 146:
-YY_RULE_SETUP
-#line 279 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREAL;}
-	YY_BREAK
-case 147:
-YY_RULE_SETUP
-#line 280 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREALDP;}
-	YY_BREAK
-case 148:
-YY_RULE_SETUP
-#line 281 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREALQP;}
-	YY_BREAK
-case 149:
-/* rule 149 can match eol */
-*yy_cp = (yy_hold_char); /* undo effects of setting up fortrantext */
-(yy_c_buf_p) = yy_cp -= 1;
-YY_DO_BEFORE_ACTION; /* set up fortrantext again */
-YY_RULE_SETUP
-#line 282 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTREAL;}
-	YY_BREAK
-case 150:
-YY_RULE_SETUP
-#line 283 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return TOK_CSTINT;}
-	YY_BREAK
-case 151:
-YY_RULE_SETUP
-#line 284 "fortran.lex"
-{}
-	YY_BREAK
-case 152:
-YY_RULE_SETUP
-#line 285 "fortran.lex"
-{return TOK_QUOTE;}
-	YY_BREAK
-case 153:
-YY_RULE_SETUP
-#line 286 "fortran.lex"
-{}
-	YY_BREAK
-case 154:
-YY_RULE_SETUP
-#line 287 "fortran.lex"
-{strcpy(yylval.na,fortrantext);return (int) *fortrantext;}
-	YY_BREAK
-case 155:
-YY_RULE_SETUP
-#line 288 "fortran.lex"
-{afterpercent = 1; strcpy(yylval.na,fortrantext);return (int) *fortrantext;}
-	YY_BREAK
-case 156:
-YY_RULE_SETUP
-#line 289 "fortran.lex"
-{return TOK_SEMICOLON;}
-	YY_BREAK
-case 157:
-YY_RULE_SETUP
-#line 290 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 158:
-YY_RULE_SETUP
-#line 291 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 159:
-YY_RULE_SETUP
-#line 292 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 160:
-YY_RULE_SETUP
-#line 293 "fortran.lex"
-{return (int) *fortrantext;}
-	YY_BREAK
-case 161:
-/* rule 161 can match eol */
-YY_RULE_SETUP
-#line 294 "fortran.lex"
-{colnum=0;line_num_fortran++;line_num_fortran_common++; return (int) *fortrantext;}
-	YY_BREAK
-case 162:
-*yy_cp = (yy_hold_char); /* undo effects of setting up fortrantext */
-(yy_c_buf_p) = yy_cp -= 1;
-YY_DO_BEFORE_ACTION; /* set up fortrantext again */
-YY_RULE_SETUP
-#line 295 "fortran.lex"
-
-	YY_BREAK
-case 163:
-YY_RULE_SETUP
-#line 296 "fortran.lex"
-{if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0;}
-	YY_BREAK
-case 164:
-YY_RULE_SETUP
-#line 297 "fortran.lex"
-
-	YY_BREAK
-case 165:
-YY_RULE_SETUP
-#line 298 "fortran.lex"
-{colnum=colnum-1+tabsize;}
-	YY_BREAK
-case 166:
-YY_RULE_SETUP
-#line 299 "fortran.lex"
-;
-	YY_BREAK
-case 167:
-/* rule 167 can match eol */
-YY_RULE_SETUP
-#line 300 "fortran.lex"
-{line_num_fortran++;line_num_fortran_common++;newlinef90=1;colnum=0;}
-	YY_BREAK
-case 168:
-/* rule 168 can match eol */
-YY_RULE_SETUP
-#line 301 "fortran.lex"
-{line_num_fortran++;line_num_fortran_common++;colnum=0;}
-	YY_BREAK
-case 169:
-/* rule 169 can match eol */
-YY_RULE_SETUP
-#line 302 "fortran.lex"
-{
-                           convert2lower(motparse1);
-                           if ( strncasecmp(motparse1,"contains",8) == 0 )
-                           {
-                              return TOK_CONTAINS;
-                           }
-                           else
-                           {
-                            /*  colnum=0;line_num_fortran++;line_num_fortran_common++;*/
-                             if ( !strcasecmp(motparse1,"C$AGRIF_DO_NOT_TREAT\n")) 
-                             return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                             unput('\n');
-                           }
-                         }
-	YY_BREAK
-case 170:
-/* rule 170 can match eol */
-YY_RULE_SETUP
-#line 317 "fortran.lex"
-{
-                           convert2lower(&motparse1[1]);
-                           if ( strncasecmp(&motparse1[1],"contains",8) == 0 )
-                           {
-                              return TOK_CONTAINS;
-                           }
-                           else
-                           {
-                             /* colnum=0;line_num_fortran++;line_num_fortran_common++;*/
-                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_DO_NOT_TREAT\n")) 
-                             return TOK_DONOTTREAT;
-                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                             unput('\n');
-                           }
-                         }                            
-	YY_BREAK
-case 171:
-/* rule 171 can match eol */
-YY_RULE_SETUP
-#line 332 "fortran.lex"
-{
-						BEGIN(donottreat);
-						}
-	YY_BREAK
-case 172:
-/* rule 172 can match eol */
-YY_RULE_SETUP
-#line 335 "fortran.lex"
-{
-						BEGIN(INITIAL);
-                        if (infixed) BEGIN(fortran77style) ;
-                        if (infree) BEGIN(fortran90style)  ;
-                        line_num_fortran++;line_num_fortran_common++;
-                        return '\n';
-						}
-	YY_BREAK
-case 173:
-/* rule 173 can match eol */
-YY_RULE_SETUP
-#line 342 "fortran.lex"
-{line_num_fortran++;line_num_fortran_common++;}
-	YY_BREAK
-case 174:
-/* rule 174 can match eol */
-YY_RULE_SETUP
-#line 343 "fortran.lex"
-{
-                             colnum = 0;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                          }
-	YY_BREAK
-case 175:
-YY_RULE_SETUP
-#line 348 "fortran.lex"
-{
-                             colnum = 0;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
-                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
-                          }
-	YY_BREAK
-case 176:
-YY_RULE_SETUP
-#line 353 "fortran.lex"
-ECHO;
-	YY_BREAK
-#line 4224 "fortran.yy.c"
-case YY_STATE_EOF(INITIAL):
-case YY_STATE_EOF(parameter):
-case YY_STATE_EOF(character):
-case YY_STATE_EOF(donottreat):
-case YY_STATE_EOF(fortran77style):
-case YY_STATE_EOF(fortran90style):
-	yyterminate();
-
-	case YY_END_OF_BUFFER:
-		{
-		/* Amount of text matched not including the EOB char. */
-		int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
-
-		/* Undo the effects of YY_DO_BEFORE_ACTION. */
-		*yy_cp = (yy_hold_char);
-		YY_RESTORE_YY_MORE_OFFSET
-
-		if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
-			{
-			/* We're scanning a new file or input source.  It's
-			 * possible that this happened because the user
-			 * just pointed fortranin at a new source and called
-			 * fortranlex().  If so, then we have to assure
-			 * consistency between YY_CURRENT_BUFFER and our
-			 * globals.  Here is the right place to do so, because
-			 * this is the first action (other than possibly a
-			 * back-up) that will match for the new input source.
-			 */
-			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
-			YY_CURRENT_BUFFER_LVALUE->yy_input_file = fortranin;
-			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
-			}
-
-		/* Note that here we test for yy_c_buf_p "<=" to the position
-		 * of the first EOB in the buffer, since yy_c_buf_p will
-		 * already have been incremented past the NUL character
-		 * (since all states make transitions on EOB to the
-		 * end-of-buffer state).  Contrast this with the test
-		 * in input().
-		 */
-		if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
-			{ /* This was really a NUL. */
-			yy_state_type yy_next_state;
-
-			(yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
-
-			yy_current_state = yy_get_previous_state(  );
-
-			/* Okay, we're now positioned to make the NUL
-			 * transition.  We couldn't have
-			 * yy_get_previous_state() go ahead and do it
-			 * for us because it doesn't know how to deal
-			 * with the possibility of jamming (and we don't
-			 * want to build jamming into it because then it
-			 * will run more slowly).
-			 */
-
-			yy_next_state = yy_try_NUL_trans( yy_current_state );
-
-			yy_bp = (yytext_ptr) + YY_MORE_ADJ;
-
-			if ( yy_next_state )
-				{
-				/* Consume the NUL. */
-				yy_cp = ++(yy_c_buf_p);
-				yy_current_state = yy_next_state;
-				goto yy_match;
-				}
-
-			else
-				{
-				yy_cp = (yy_c_buf_p);
-				goto yy_find_action;
-				}
-			}
-
-		else switch ( yy_get_next_buffer(  ) )
-			{
-			case EOB_ACT_END_OF_FILE:
-				{
-				(yy_did_buffer_switch_on_eof) = 0;
-
-				if ( fortranwrap( ) )
-					{
-					/* Note: because we've taken care in
-					 * yy_get_next_buffer() to have set up
-					 * fortrantext, we can now set up
-					 * yy_c_buf_p so that if some total
-					 * hoser (like flex itself) wants to
-					 * call the scanner after we return the
-					 * YY_NULL, it'll still work - another
-					 * YY_NULL will get returned.
-					 */
-					(yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
-
-					yy_act = YY_STATE_EOF(YY_START);
-					goto do_action;
-					}
-
-				else
-					{
-					if ( ! (yy_did_buffer_switch_on_eof) )
-						YY_NEW_FILE;
-					}
-				break;
-				}
-
-			case EOB_ACT_CONTINUE_SCAN:
-				(yy_c_buf_p) =
-					(yytext_ptr) + yy_amount_of_matched_text;
-
-				yy_current_state = yy_get_previous_state(  );
-
-				yy_cp = (yy_c_buf_p);
-				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
-				goto yy_match;
-
-			case EOB_ACT_LAST_MATCH:
-				(yy_c_buf_p) =
-				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
-
-				yy_current_state = yy_get_previous_state(  );
-
-				yy_cp = (yy_c_buf_p);
-				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
-				goto yy_find_action;
-			}
-		break;
-		}
-
-	default:
-		YY_FATAL_ERROR(
-			"fatal flex scanner internal error--no action found" );
-	} /* end of action switch */
-		} /* end of scanning one token */
-} /* end of fortranlex */
-
-/* yy_get_next_buffer - try to read in a new buffer
- *
- * Returns a code representing an action:
- *	EOB_ACT_LAST_MATCH -
- *	EOB_ACT_CONTINUE_SCAN - continue scanning from current position
- *	EOB_ACT_END_OF_FILE - end of file
- */
-static int yy_get_next_buffer (void)
-{
-    	register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
-	register char *source = (yytext_ptr);
-	register int number_to_move, i;
-	int ret_val;
-
-	if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
-		YY_FATAL_ERROR(
-		"fatal flex scanner internal error--end of buffer missed" );
-
-	if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
-		{ /* Don't try to fill the buffer, so this is an EOF. */
-		if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
-			{
-			/* We matched a single character, the EOB, so
-			 * treat this as a final EOF.
-			 */
-			return EOB_ACT_END_OF_FILE;
-			}
-
-		else
-			{
-			/* We matched some text prior to the EOB, first
-			 * process it.
-			 */
-			return EOB_ACT_LAST_MATCH;
-			}
-		}
-
-	/* Try to read more data. */
-
-	/* First move last chars to start of buffer. */
-	number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
-
-	for ( i = 0; i < number_to_move; ++i )
-		*(dest++) = *(source++);
-
-	if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
-		/* don't do the read, it's not guaranteed to return an EOF,
-		 * just force an EOF
-		 */
-		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
-
-	else
-		{
-			yy_size_t num_to_read =
-			YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
-
-		while ( num_to_read <= 0 )
-			{ /* Not enough room in the buffer - grow it. */
-
-			/* just a shorter name for the current buffer */
-			YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
-
-			int yy_c_buf_p_offset =
-				(int) ((yy_c_buf_p) - b->yy_ch_buf);
-
-			if ( b->yy_is_our_buffer )
-				{
-				yy_size_t new_size = b->yy_buf_size * 2;
-
-				if ( new_size <= 0 )
-					b->yy_buf_size += b->yy_buf_size / 8;
-				else
-					b->yy_buf_size *= 2;
-
-				b->yy_ch_buf = (char *)
-					/* Include room in for 2 EOB chars. */
-					fortranrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
-				}
-			else
-				/* Can't grow it, we don't own it. */
-				b->yy_ch_buf = 0;
-
-			if ( ! b->yy_ch_buf )
-				YY_FATAL_ERROR(
-				"fatal error - scanner input buffer overflow" );
-
-			(yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];
-
-			num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -
-						number_to_move - 1;
-
-			}
-
-		if ( num_to_read > YY_READ_BUF_SIZE )
-			num_to_read = YY_READ_BUF_SIZE;
-
-		/* Read in more data. */
-		YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
-			(yy_n_chars), num_to_read );
-
-		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
-		}
-
-	if ( (yy_n_chars) == 0 )
-		{
-		if ( number_to_move == YY_MORE_ADJ )
-			{
-			ret_val = EOB_ACT_END_OF_FILE;
-			fortranrestart(fortranin  );
-			}
-
-		else
-			{
-			ret_val = EOB_ACT_LAST_MATCH;
-			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
-				YY_BUFFER_EOF_PENDING;
-			}
-		}
-
-	else
-		ret_val = EOB_ACT_CONTINUE_SCAN;
-
-	if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) {
-		/* Extend the array by 50%, plus the number we really need. */
-		yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
-		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) fortranrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
-		if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
-			YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
-	}
-
-	(yy_n_chars) += number_to_move;
-	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
-	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
-
-	(yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
-
-	return ret_val;
-}
-
-/* yy_get_previous_state - get the state just before the EOB char was reached */
-
-    static yy_state_type yy_get_previous_state (void)
-{
-	register yy_state_type yy_current_state;
-	register char *yy_cp;
-    
-	yy_current_state = (yy_start);
-	yy_current_state += YY_AT_BOL();
-
-	for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
-		{
-		register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
-		if ( yy_accept[yy_current_state] )
-			{
-			(yy_last_accepting_state) = yy_current_state;
-			(yy_last_accepting_cpos) = yy_cp;
-			}
-		while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
-			{
-			yy_current_state = (int) yy_def[yy_current_state];
-			if ( yy_current_state >= 1162 )
-				yy_c = yy_meta[(unsigned int) yy_c];
-			}
-		yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
-		}
-
-	return yy_current_state;
-}
-
-/* yy_try_NUL_trans - try to make a transition on the NUL character
- *
- * synopsis
- *	next_state = yy_try_NUL_trans( current_state );
- */
-    static yy_state_type yy_try_NUL_trans  (yy_state_type yy_current_state )
-{
-	register int yy_is_jam;
-    	register char *yy_cp = (yy_c_buf_p);
-
-	register YY_CHAR yy_c = 1;
-	if ( yy_accept[yy_current_state] )
-		{
-		(yy_last_accepting_state) = yy_current_state;
-		(yy_last_accepting_cpos) = yy_cp;
-		}
-	while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
-		{
-		yy_current_state = (int) yy_def[yy_current_state];
-		if ( yy_current_state >= 1162 )
-			yy_c = yy_meta[(unsigned int) yy_c];
-		}
-	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
-	yy_is_jam = (yy_current_state == 1161);
-
-	return yy_is_jam ? 0 : yy_current_state;
-}
-
-    static void yyunput (int c, register char * yy_bp )
-{
-	register char *yy_cp;
-    
-    yy_cp = (yy_c_buf_p);
-
-	/* undo effects of setting up fortrantext */
-	*yy_cp = (yy_hold_char);
-
-	if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
-		{ /* need to shift things up to make room */
-		/* +2 for EOB chars. */
-		register yy_size_t number_to_move = (yy_n_chars) + 2;
-		register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
-					YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
-		register char *source =
-				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
-
-		while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
-			*--dest = *--source;
-
-		yy_cp += (int) (dest - source);
-		yy_bp += (int) (dest - source);
-		YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
-			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
-
-		if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
-			YY_FATAL_ERROR( "flex scanner push-back overflow" );
-		}
-
-	*--yy_cp = (char) c;
-
-	(yytext_ptr) = yy_bp;
-	(yy_hold_char) = *yy_cp;
-	(yy_c_buf_p) = yy_cp;
-}
-
-#ifndef YY_NO_INPUT
-#ifdef __cplusplus
-    static int yyinput (void)
-#else
-    static int input  (void)
-#endif
-
-{
-	int c;
-    
-	*(yy_c_buf_p) = (yy_hold_char);
-
-	if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
-		{
-		/* yy_c_buf_p now points to the character we want to return.
-		 * If this occurs *before* the EOB characters, then it's a
-		 * valid NUL; if not, then we've hit the end of the buffer.
-		 */
-		if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
-			/* This was really a NUL. */
-			*(yy_c_buf_p) = '\0';
-
-		else
-			{ /* need more input */
-			yy_size_t offset = (yy_c_buf_p) - (yytext_ptr);
-			++(yy_c_buf_p);
-
-			switch ( yy_get_next_buffer(  ) )
-				{
-				case EOB_ACT_LAST_MATCH:
-					/* This happens because yy_g_n_b()
-					 * sees that we've accumulated a
-					 * token and flags that we need to
-					 * try matching the token before
-					 * proceeding.  But for input(),
-					 * there's no matching to consider.
-					 * So convert the EOB_ACT_LAST_MATCH
-					 * to EOB_ACT_END_OF_FILE.
-					 */
-
-					/* Reset buffer status. */
-					fortranrestart(fortranin );
-
-					/*FALLTHROUGH*/
-
-				case EOB_ACT_END_OF_FILE:
-					{
-					if ( fortranwrap( ) )
-						return 0;
-
-					if ( ! (yy_did_buffer_switch_on_eof) )
-						YY_NEW_FILE;
-#ifdef __cplusplus
-					return yyinput();
-#else
-					return input();
-#endif
-					}
-
-				case EOB_ACT_CONTINUE_SCAN:
-					(yy_c_buf_p) = (yytext_ptr) + offset;
-					break;
-				}
-			}
-		}
-
-	c = *(unsigned char *) (yy_c_buf_p);	/* cast for 8-bit char's */
-	*(yy_c_buf_p) = '\0';	/* preserve fortrantext */
-	(yy_hold_char) = *++(yy_c_buf_p);
-
-	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n');
-
-	return c;
-}
-#endif	/* ifndef YY_NO_INPUT */
-
-/** Immediately switch to a different input stream.
- * @param input_file A readable stream.
- * 
- * @note This function does not reset the start condition to @c INITIAL .
- */
-    void fortranrestart  (FILE * input_file )
-{
-    
-	if ( ! YY_CURRENT_BUFFER ){
-        fortranensure_buffer_stack ();
-		YY_CURRENT_BUFFER_LVALUE =
-            fortran_create_buffer(fortranin,YY_BUF_SIZE );
-	}
-
-	fortran_init_buffer(YY_CURRENT_BUFFER,input_file );
-	fortran_load_buffer_state( );
-}
-
-/** Switch to a different input buffer.
- * @param new_buffer The new input buffer.
- * 
- */
-    void fortran_switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
-{
-    
-	/* TODO. We should be able to replace this entire function body
-	 * with
-	 *		fortranpop_buffer_state();
-	 *		fortranpush_buffer_state(new_buffer);
-     */
-	fortranensure_buffer_stack ();
-	if ( YY_CURRENT_BUFFER == new_buffer )
-		return;
-
-	if ( YY_CURRENT_BUFFER )
-		{
-		/* Flush out information for old buffer. */
-		*(yy_c_buf_p) = (yy_hold_char);
-		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
-		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
-		}
-
-	YY_CURRENT_BUFFER_LVALUE = new_buffer;
-	fortran_load_buffer_state( );
-
-	/* We don't actually know whether we did this switch during
-	 * EOF (fortranwrap()) processing, but the only time this flag
-	 * is looked at is after fortranwrap() is called, so it's safe
-	 * to go ahead and always set it.
-	 */
-	(yy_did_buffer_switch_on_eof) = 1;
-}
-
-static void fortran_load_buffer_state  (void)
-{
-    	(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
-	(yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
-	fortranin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
-	(yy_hold_char) = *(yy_c_buf_p);
-}
-
-/** Allocate and initialize an input buffer state.
- * @param file A readable stream.
- * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
- * 
- * @return the allocated buffer state.
- */
-    YY_BUFFER_STATE fortran_create_buffer  (FILE * file, int  size )
-{
-	YY_BUFFER_STATE b;
-    
-	b = (YY_BUFFER_STATE) fortranalloc(sizeof( struct yy_buffer_state )  );
-	if ( ! b )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_create_buffer()" );
-
-	b->yy_buf_size = size;
-
-	/* yy_ch_buf has to be 2 characters longer than the size given because
-	 * we need to put in 2 end-of-buffer characters.
-	 */
-	b->yy_ch_buf = (char *) fortranalloc(b->yy_buf_size + 2  );
-	if ( ! b->yy_ch_buf )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_create_buffer()" );
-
-	b->yy_is_our_buffer = 1;
-
-	fortran_init_buffer(b,file );
-
-	return b;
-}
-
-/** Destroy the buffer.
- * @param b a buffer created with fortran_create_buffer()
- * 
- */
-    void fortran_delete_buffer (YY_BUFFER_STATE  b )
-{
-    
-	if ( ! b )
-		return;
-
-	if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
-		YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
-
-	if ( b->yy_is_our_buffer )
-		fortranfree((void *) b->yy_ch_buf  );
-
-	fortranfree((void *) b  );
-}
-
-#ifndef __cplusplus
-extern int isatty (int );
-#endif /* __cplusplus */
-    
-/* Initializes or reinitializes a buffer.
- * This function is sometimes called more than once on the same buffer,
- * such as during a fortranrestart() or at EOF.
- */
-    static void fortran_init_buffer  (YY_BUFFER_STATE  b, FILE * file )
-
-{
-	int oerrno = errno;
-    
-	fortran_flush_buffer(b );
-
-	b->yy_input_file = file;
-	b->yy_fill_buffer = 1;
-
-    /* If b is the current buffer, then fortran_init_buffer was _probably_
-     * called from fortranrestart() or through yy_get_next_buffer.
-     * In that case, we don't want to reset the lineno or column.
-     */
-    if (b != YY_CURRENT_BUFFER){
-        b->yy_bs_lineno = 1;
-        b->yy_bs_column = 0;
-    }
-
-        b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
-    
-	errno = oerrno;
-}
-
-/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
- * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
- * 
- */
-    void fortran_flush_buffer (YY_BUFFER_STATE  b )
-{
-    	if ( ! b )
-		return;
-
-	b->yy_n_chars = 0;
-
-	/* We always need two end-of-buffer characters.  The first causes
-	 * a transition to the end-of-buffer state.  The second causes
-	 * a jam in that state.
-	 */
-	b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
-	b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
-
-	b->yy_buf_pos = &b->yy_ch_buf[0];
-
-	b->yy_at_bol = 1;
-	b->yy_buffer_status = YY_BUFFER_NEW;
-
-	if ( b == YY_CURRENT_BUFFER )
-		fortran_load_buffer_state( );
-}
-
-/** Pushes the new state onto the stack. The new state becomes
- *  the current state. This function will allocate the stack
- *  if necessary.
- *  @param new_buffer The new state.
- *  
- */
-void fortranpush_buffer_state (YY_BUFFER_STATE new_buffer )
-{
-    	if (new_buffer == NULL)
-		return;
-
-	fortranensure_buffer_stack();
-
-	/* This block is copied from fortran_switch_to_buffer. */
-	if ( YY_CURRENT_BUFFER )
-		{
-		/* Flush out information for old buffer. */
-		*(yy_c_buf_p) = (yy_hold_char);
-		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
-		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
-		}
-
-	/* Only push if top exists. Otherwise, replace top. */
-	if (YY_CURRENT_BUFFER)
-		(yy_buffer_stack_top)++;
-	YY_CURRENT_BUFFER_LVALUE = new_buffer;
-
-	/* copied from fortran_switch_to_buffer. */
-	fortran_load_buffer_state( );
-	(yy_did_buffer_switch_on_eof) = 1;
-}
-
-/** Removes and deletes the top of the stack, if present.
- *  The next element becomes the new top.
- *  
- */
-void fortranpop_buffer_state (void)
-{
-    	if (!YY_CURRENT_BUFFER)
-		return;
-
-	fortran_delete_buffer(YY_CURRENT_BUFFER );
-	YY_CURRENT_BUFFER_LVALUE = NULL;
-	if ((yy_buffer_stack_top) > 0)
-		--(yy_buffer_stack_top);
-
-	if (YY_CURRENT_BUFFER) {
-		fortran_load_buffer_state( );
-		(yy_did_buffer_switch_on_eof) = 1;
-	}
-}
-
-/* Allocates the stack if it does not exist.
- *  Guarantees space for at least one push.
- */
-static void fortranensure_buffer_stack (void)
-{
-	yy_size_t num_to_alloc;
-    
-	if (!(yy_buffer_stack)) {
-
-		/* First allocation is just for 2 elements, since we don't know if this
-		 * scanner will even need a stack. We use 2 instead of 1 to avoid an
-		 * immediate realloc on the next call.
-         */
-		num_to_alloc = 1;
-		(yy_buffer_stack) = (struct yy_buffer_state**)fortranalloc
-								(num_to_alloc * sizeof(struct yy_buffer_state*)
-								);
-		if ( ! (yy_buffer_stack) )
-			YY_FATAL_ERROR( "out of dynamic memory in fortranensure_buffer_stack()" );
-								  
-		memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
-				
-		(yy_buffer_stack_max) = num_to_alloc;
-		(yy_buffer_stack_top) = 0;
-		return;
-	}
-
-	if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
-
-		/* Increase the buffer to prepare for a possible push. */
-		int grow_size = 8 /* arbitrary grow size */;
-
-		num_to_alloc = (yy_buffer_stack_max) + grow_size;
-		(yy_buffer_stack) = (struct yy_buffer_state**)fortranrealloc
-								((yy_buffer_stack),
-								num_to_alloc * sizeof(struct yy_buffer_state*)
-								);
-		if ( ! (yy_buffer_stack) )
-			YY_FATAL_ERROR( "out of dynamic memory in fortranensure_buffer_stack()" );
-
-		/* zero only the new slots.*/
-		memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
-		(yy_buffer_stack_max) = num_to_alloc;
-	}
-}
-
-/** Setup the input buffer state to scan directly from a user-specified character buffer.
- * @param base the character buffer
- * @param size the size in bytes of the character buffer
- * 
- * @return the newly allocated buffer state object. 
- */
-YY_BUFFER_STATE fortran_scan_buffer  (char * base, yy_size_t  size )
-{
-	YY_BUFFER_STATE b;
-    
-	if ( size < 2 ||
-	     base[size-2] != YY_END_OF_BUFFER_CHAR ||
-	     base[size-1] != YY_END_OF_BUFFER_CHAR )
-		/* They forgot to leave room for the EOB's. */
-		return 0;
-
-	b = (YY_BUFFER_STATE) fortranalloc(sizeof( struct yy_buffer_state )  );
-	if ( ! b )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_scan_buffer()" );
-
-	b->yy_buf_size = size - 2;	/* "- 2" to take care of EOB's */
-	b->yy_buf_pos = b->yy_ch_buf = base;
-	b->yy_is_our_buffer = 0;
-	b->yy_input_file = 0;
-	b->yy_n_chars = b->yy_buf_size;
-	b->yy_is_interactive = 0;
-	b->yy_at_bol = 1;
-	b->yy_fill_buffer = 0;
-	b->yy_buffer_status = YY_BUFFER_NEW;
-
-	fortran_switch_to_buffer(b  );
-
-	return b;
-}
-
-/** Setup the input buffer state to scan a string. The next call to fortranlex() will
- * scan from a @e copy of @a str.
- * @param yystr a NUL-terminated string to scan
- * 
- * @return the newly allocated buffer state object.
- * @note If you want to scan bytes that may contain NUL values, then use
- *       fortran_scan_bytes() instead.
- */
-YY_BUFFER_STATE fortran_scan_string (yyconst char * yystr )
-{
-    
-	return fortran_scan_bytes(yystr,strlen(yystr) );
-}
-
-/** Setup the input buffer state to scan the given bytes. The next call to fortranlex() will
- * scan from a @e copy of @a bytes.
- * @param bytes the byte buffer to scan
- * @param len the number of bytes in the buffer pointed to by @a bytes.
- * 
- * @return the newly allocated buffer state object.
- */
-YY_BUFFER_STATE fortran_scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
-{
-	YY_BUFFER_STATE b;
-	char *buf;
-	yy_size_t n, i;
-    
-	/* Get memory for full buffer, including space for trailing EOB's. */
-	n = _yybytes_len + 2;
-	buf = (char *) fortranalloc(n  );
-	if ( ! buf )
-		YY_FATAL_ERROR( "out of dynamic memory in fortran_scan_bytes()" );
-
-	for ( i = 0; i < _yybytes_len; ++i )
-		buf[i] = yybytes[i];
-
-	buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
-
-	b = fortran_scan_buffer(buf,n );
-	if ( ! b )
-		YY_FATAL_ERROR( "bad buffer in fortran_scan_bytes()" );
-
-	/* It's okay to grow etc. this buffer, and we should throw it
-	 * away when we're done.
-	 */
-	b->yy_is_our_buffer = 1;
-
-	return b;
-}
-
-#ifndef YY_EXIT_FAILURE
-#define YY_EXIT_FAILURE 2
-#endif
-
-static void yy_fatal_error (yyconst char* msg )
-{
-    	(void) fprintf( stderr, "%s\n", msg );
-	exit( YY_EXIT_FAILURE );
-}
-
-/* Redefine yyless() so it works in section 3 code. */
-
-#undef yyless
-#define yyless(n) \
-	do \
-		{ \
-		/* Undo effects of setting up fortrantext. */ \
-        int yyless_macro_arg = (n); \
-        YY_LESS_LINENO(yyless_macro_arg);\
-		fortrantext[fortranleng] = (yy_hold_char); \
-		(yy_c_buf_p) = fortrantext + yyless_macro_arg; \
-		(yy_hold_char) = *(yy_c_buf_p); \
-		*(yy_c_buf_p) = '\0'; \
-		fortranleng = yyless_macro_arg; \
-		} \
-	while ( 0 )
-
-/* Accessor  methods (get/set functions) to struct members. */
-
-/** Get the current line number.
- * 
- */
-int fortranget_lineno  (void)
-{
-        
-    return fortranlineno;
-}
-
-/** Get the input stream.
- * 
- */
-FILE *fortranget_in  (void)
-{
-        return fortranin;
-}
-
-/** Get the output stream.
- * 
- */
-FILE *fortranget_out  (void)
-{
-        return fortranout;
-}
-
-/** Get the length of the current token.
- * 
- */
-yy_size_t fortranget_leng  (void)
-{
-        return fortranleng;
-}
-
-/** Get the current token.
- * 
- */
-
-char *fortranget_text  (void)
-{
-        return fortrantext;
-}
-
-/** Set the current line number.
- * @param line_number
- * 
- */
-void fortranset_lineno (int  line_number )
-{
-    
-    fortranlineno = line_number;
-}
-
-/** Set the input stream. This does not discard the current
- * input buffer.
- * @param in_str A readable stream.
- * 
- * @see fortran_switch_to_buffer
- */
-void fortranset_in (FILE *  in_str )
-{
-        fortranin = in_str ;
-}
-
-void fortranset_out (FILE *  out_str )
-{
-        fortranout = out_str ;
-}
-
-int fortranget_debug  (void)
-{
-        return fortran_flex_debug;
-}
-
-void fortranset_debug (int  bdebug )
-{
-        fortran_flex_debug = bdebug ;
-}
-
-static int yy_init_globals (void)
-{
-        /* Initialization is the same as for the non-reentrant scanner.
-     * This function is called from fortranlex_destroy(), so don't allocate here.
-     */
-
-    (yy_buffer_stack) = 0;
-    (yy_buffer_stack_top) = 0;
-    (yy_buffer_stack_max) = 0;
-    (yy_c_buf_p) = (char *) 0;
-    (yy_init) = 0;
-    (yy_start) = 0;
-
-/* Defined in main.c */
-#ifdef YY_STDINIT
-    fortranin = stdin;
-    fortranout = stdout;
-#else
-    fortranin = (FILE *) 0;
-    fortranout = (FILE *) 0;
-#endif
-
-    /* For future reference: Set errno on error, since we are called by
-     * fortranlex_init()
-     */
-    return 0;
-}
-
-/* fortranlex_destroy is for both reentrant and non-reentrant scanners. */
-int fortranlex_destroy  (void)
-{
-    
-    /* Pop the buffer stack, destroying each element. */
-	while(YY_CURRENT_BUFFER){
-		fortran_delete_buffer(YY_CURRENT_BUFFER  );
-		YY_CURRENT_BUFFER_LVALUE = NULL;
-		fortranpop_buffer_state();
-	}
-
-	/* Destroy the stack itself. */
-	fortranfree((yy_buffer_stack) );
-	(yy_buffer_stack) = NULL;
-
-    /* Reset the globals. This is important in a non-reentrant scanner so the next time
-     * fortranlex() is called, initialization will occur. */
-    yy_init_globals( );
-
-    return 0;
-}
-
-/*
- * Internal utility routines.
- */
-
-#ifndef yytext_ptr
-static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
-{
-	register int i;
-	for ( i = 0; i < n; ++i )
-		s1[i] = s2[i];
-}
-#endif
-
-#ifdef YY_NEED_STRLEN
-static int yy_flex_strlen (yyconst char * s )
-{
-	register int n;
-	for ( n = 0; s[n]; ++n )
-		;
-
-	return n;
-}
-#endif
-
-void *fortranalloc (yy_size_t  size )
-{
-	return (void *) malloc( size );
-}
-
-void *fortranrealloc  (void * ptr, yy_size_t  size )
-{
-	/* The cast to (char *) in the following accommodates both
-	 * implementations that use char* generic pointers, and those
-	 * that use void* generic pointers.  It works with the latter
-	 * because both ANSI C and C++ allow castless assignment from
-	 * any pointer type to void*, and deal with argument conversions
-	 * as though doing an assignment.
-	 */
-	return (void *) realloc( (char *) ptr, size );
-}
-
-void fortranfree (void * ptr )
-{
-	free( (char *) ptr );	/* see fortranrealloc() for (char *) cast */
-}
-
-#define YYTABLES_NAME "yytables"
-
-#line 353 "fortran.lex"
-
-
-
-fortranerror(char *s)
-{
-   if (!strcasecmp(curfile,mainfile))
-   {
-      printf("%s line %d, file %s motclef = %s\n",s,line_num_fortran,curfile,fortrantext);
-   }
-   else
-   {
-      printf("%s line %d, file %s motclef = %s curbuf = %s\n",s,line_num_fortran_common,curfile,fortrantext,curbuf);
-   }
-/*   exit(0);*/
-}
-
-int fortranwrap()
-{
-}
-
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c	(revision 5682)
@@ -1,20 +1,23 @@
-/* A Bison parser, made by GNU Bison 2.7.12-4996.  */
-
-/* Bison implementation for Yacc-like parsers in C
-   
-      Copyright (C) 1984, 1989-1990, 2000-2013 Free Software Foundation, Inc.
-   
-   This program is free software: you can redistribute it and/or modify
+/* A Bison parser, made by GNU Bison 2.3.  */
+
+/* Skeleton implementation for Bison's Yacc-like parsers in C
+
+   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
-   the Free Software Foundation, either version 3 of the License, or
-   (at your option) any later version.
-   
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
-   
+
    You should have received a copy of the GNU General Public License
-   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.  */
 
 /* As a special exception, you may create a larger work that contains
@@ -27,5 +30,5 @@
    Bison output files to be licensed under the GNU General Public
    License without this special exception.
-   
+
    This special exception was added by the Free Software Foundation in
    version 2.2 of Bison.  */
@@ -45,5 +48,5 @@
 
 /* Bison version.  */
-#define YYBISON_VERSION "2.7.12-4996"
+#define YYBISON_VERSION "2.3"
 
 /* Skeleton name.  */
@@ -53,49 +56,16 @@
 #define YYPURE 0
 
-/* Push parsers.  */
-#define YYPUSH 0
-
-/* Pull parsers.  */
-#define YYPULL 1
-
-
-
-
-/* Copy the first part of user declarations.  */
-/* Line 371 of yacc.c  */
-#line 35 "convert.y"
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include "decl.h"
-
-/* Line 371 of yacc.c  */
-#line 75 "convert.tab.c"
-
-# ifndef YY_NULL
-#  if defined __cplusplus && 201103L <= __cplusplus
-#   define YY_NULL nullptr
-#  else
-#   define YY_NULL 0
-#  endif
-# endif
-
-/* Enabling verbose error messages.  */
-#ifdef YYERROR_VERBOSE
-# undef YYERROR_VERBOSE
-# define YYERROR_VERBOSE 1
-#else
-# define YYERROR_VERBOSE 0
-#endif
-
-
-/* Enabling traces.  */
-#ifndef YYDEBUG
-# define YYDEBUG 0
-#endif
-#if YYDEBUG
-extern int yydebug;
-#endif
+/* Using locations.  */
+#define YYLSP_NEEDED 0
+
+/* Substitute the variable and function names.  */
+#define yyparse convert_parse
+#define yylex   convert_lex
+#define yyerror convert_error
+#define yylval  convert_lval
+#define yychar  convert_char
+#define yydebug convert_debug
+#define yynerrs convert_nerrs
+
 
 /* Tokens.  */
@@ -106,48 +76,80 @@
    enum yytokentype {
      TOK_SEP = 258,
-     TOK_USE = 259,
-     TOK_MODULEMAIN = 260,
-     TOK_NOTGRIDDEP = 261,
-     TOK_USEITEM = 262,
-     TOK_NAME = 263,
-     TOK_PROBTYPE = 264
+     TOK_KIND = 259,
+     TOK_EQUAL = 260,
+     TOK_USE = 261,
+     TOK_MODULEMAIN = 262,
+     TOK_NOTGRIDDEP = 263,
+     TOK_USEITEM = 264,
+     TOK_NAME = 265,
+     TOK_CSTINT = 266,
+     TOK_PROBTYPE = 267
    };
 #endif
-
+/* Tokens.  */
+#define TOK_SEP 258
+#define TOK_KIND 259
+#define TOK_EQUAL 260
+#define TOK_USE 261
+#define TOK_MODULEMAIN 262
+#define TOK_NOTGRIDDEP 263
+#define TOK_USEITEM 264
+#define TOK_NAME 265
+#define TOK_CSTINT 266
+#define TOK_PROBTYPE 267
+
+
+
+
+/* Copy the first part of user declarations.  */
+#line 35 "convert.y"
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+int line_num=1;
+extern FILE * convert_in;
+
+int convert_error(const char *s)
+{
+    printf("##\n## ERROR in conv: '%s' (line %d, file: %s)\n##\n", s, line_num, config_file);
+    exit(0);
+}
+
+
+
+/* Enabling traces.  */
+#ifndef YYDEBUG
+# define YYDEBUG 1
+#endif
+
+/* Enabling verbose error messages.  */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+/* Enabling the token table.  */
+#ifndef YYTOKEN_TABLE
+# define YYTOKEN_TABLE 0
+#endif
 
 #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
 typedef union YYSTYPE
-{
-/* Line 387 of yacc.c  */
-#line 42 "convert.y"
-
-       int ival;
-       char na[LONG_C];
-       listnom * ln;
-       
-
-/* Line 387 of yacc.c  */
-#line 131 "convert.tab.c"
-} YYSTYPE;
-# define YYSTYPE_IS_TRIVIAL 1
+#line 52 "convert.y"
+{
+    char na[LONG_M];
+}
+/* Line 193 of yacc.c.  */
+#line 149 "convert.tab.c"
+	YYSTYPE;
 # define yystype YYSTYPE /* obsolescent; will be withdrawn */
 # define YYSTYPE_IS_DECLARED 1
-#endif
-
-extern YYSTYPE yylval;
-
-#ifdef YYPARSE_PARAM
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void *YYPARSE_PARAM);
-#else
-int yyparse ();
-#endif
-#else /* ! YYPARSE_PARAM */
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void);
-#else
-int yyparse ();
-#endif
-#endif /* ! YYPARSE_PARAM */
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
 
 
@@ -155,6 +157,7 @@
 /* Copy the second part of user declarations.  */
 
-/* Line 390 of yacc.c  */
-#line 159 "convert.tab.c"
+
+/* Line 216 of yacc.c.  */
+#line 162 "convert.tab.c"
 
 #ifdef short
@@ -209,17 +212,9 @@
 #  if ENABLE_NLS
 #   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
-#   define YY_(Msgid) dgettext ("bison-runtime", Msgid)
+#   define YY_(msgid) dgettext ("bison-runtime", msgid)
 #  endif
 # endif
 # ifndef YY_
-#  define YY_(Msgid) Msgid
-# endif
-#endif
-
-#ifndef __attribute__
-/* This feature is available in gcc versions 2.5 and later.  */
-# if (! defined __GNUC__ || __GNUC__ < 2 \
-      || (__GNUC__ == 2 && __GNUC_MINOR__ < 5))
-#  define __attribute__(Spec) /* empty */
+#  define YY_(msgid) msgid
 # endif
 #endif
@@ -227,25 +222,24 @@
 /* Suppress unused-variable warnings by "using" E.  */
 #if ! defined lint || defined __GNUC__
-# define YYUSE(E) ((void) (E))
+# define YYUSE(e) ((void) (e))
 #else
-# define YYUSE(E) /* empty */
-#endif
-
+# define YYUSE(e) /* empty */
+#endif
 
 /* Identity function, used to suppress warnings about constant conditions.  */
 #ifndef lint
-# define YYID(N) (N)
+# define YYID(n) (n)
 #else
 #if (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 static int
-YYID (int yyi)
+YYID (int i)
 #else
 static int
-YYID (yyi)
-    int yyi;
-#endif
-{
-  return yyi;
+YYID (i)
+    int i;
+#endif
+{
+  return i;
 }
 #endif
@@ -268,10 +262,9 @@
 #   else
 #    define YYSTACK_ALLOC alloca
-#    if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
+#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 #     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-      /* Use EXIT_SUCCESS as a witness for stdlib.h.  */
-#     ifndef EXIT_SUCCESS
-#      define EXIT_SUCCESS 0
+#     ifndef _STDLIB_H
+#      define _STDLIB_H 1
 #     endif
 #    endif
@@ -296,15 +289,15 @@
 #   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
 #  endif
-#  if (defined __cplusplus && ! defined EXIT_SUCCESS \
+#  if (defined __cplusplus && ! defined _STDLIB_H \
        && ! ((defined YYMALLOC || defined malloc) \
 	     && (defined YYFREE || defined free)))
 #   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-#   ifndef EXIT_SUCCESS
-#    define EXIT_SUCCESS 0
+#   ifndef _STDLIB_H
+#    define _STDLIB_H 1
 #   endif
 #  endif
 #  ifndef YYMALLOC
 #   define YYMALLOC malloc
-#   if ! defined malloc && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
+#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
@@ -313,5 +306,5 @@
 #  ifndef YYFREE
 #   define YYFREE free
-#   if ! defined free && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
+#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
      || defined __cplusplus || defined _MSC_VER)
 void free (void *); /* INFRINGES ON USER NAME SPACE */
@@ -329,7 +322,7 @@
 union yyalloc
 {
-  yytype_int16 yyss_alloc;
-  YYSTYPE yyvs_alloc;
-};
+  yytype_int16 yyss;
+  YYSTYPE yyvs;
+  };
 
 /* The size of the maximum gap between one aligned stack and the next.  */
@@ -342,5 +335,21 @@
       + YYSTACK_GAP_MAXIMUM)
 
-# define YYCOPY_NEEDED 1
+/* Copy COUNT objects from FROM to TO.  The source and destination do
+   not overlap.  */
+# ifndef YYCOPY
+#  if defined __GNUC__ && 1 < __GNUC__
+#   define YYCOPY(To, From, Count) \
+      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
+#  else
+#   define YYCOPY(To, From, Count)		\
+      do					\
+	{					\
+	  YYSIZE_T yyi;				\
+	  for (yyi = 0; yyi < (Count); yyi++)	\
+	    (To)[yyi] = (From)[yyi];		\
+	}					\
+      while (YYID (0))
+#  endif
+# endif
 
 /* Relocate STACK from its old location to the new one.  The
@@ -349,10 +358,10 @@
    stack.  Advance YYPTR to a properly aligned location for the next
    stack.  */
-# define YYSTACK_RELOCATE(Stack_alloc, Stack)				\
+# define YYSTACK_RELOCATE(Stack)					\
     do									\
       {									\
 	YYSIZE_T yynewbytes;						\
-	YYCOPY (&yyptr->Stack_alloc, Stack, yysize);			\
-	Stack = &yyptr->Stack_alloc;					\
+	YYCOPY (&yyptr->Stack, Stack, yysize);				\
+	Stack = &yyptr->Stack;						\
 	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
 	yyptr += yynewbytes / sizeof (*yyptr);				\
@@ -362,41 +371,21 @@
 #endif
 
-#if defined YYCOPY_NEEDED && YYCOPY_NEEDED
-/* Copy COUNT objects from SRC to DST.  The source and destination do
-   not overlap.  */
-# ifndef YYCOPY
-#  if defined __GNUC__ && 1 < __GNUC__
-#   define YYCOPY(Dst, Src, Count) \
-      __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src)))
-#  else
-#   define YYCOPY(Dst, Src, Count)              \
-      do                                        \
-        {                                       \
-          YYSIZE_T yyi;                         \
-          for (yyi = 0; yyi < (Count); yyi++)   \
-            (Dst)[yyi] = (Src)[yyi];            \
-        }                                       \
-      while (YYID (0))
-#  endif
-# endif
-#endif /* !YYCOPY_NEEDED */
-
 /* YYFINAL -- State number of the termination state.  */
 #define YYFINAL  2
 /* YYLAST -- Last index in YYTABLE.  */
-#define YYLAST   23
+#define YYLAST   29
 
 /* YYNTOKENS -- Number of terminals.  */
-#define YYNTOKENS  18
+#define YYNTOKENS  16
 /* YYNNTS -- Number of nonterminals.  */
 #define YYNNTS  3
 /* YYNRULES -- Number of rules.  */
-#define YYNRULES  10
+#define YYNRULES  11
 /* YYNRULES -- Number of states.  */
-#define YYNSTATES  24
+#define YYNSTATES  29
 
 /* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
 #define YYUNDEFTOK  2
-#define YYMAXUTOK   264
+#define YYMAXUTOK   267
 
 #define YYTRANSLATE(YYX)						\
@@ -407,13 +396,13 @@
 {
        0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-      17,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+      15,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-      13,    14,     2,     2,    10,     2,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     2,     2,     2,    12,    11,
+       2,     2,     2,     2,    13,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,    14,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
-       2,    15,     2,    16,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
@@ -432,5 +421,5 @@
        2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
        2,     2,     2,     2,     2,     2,     1,     2,     3,     4,
-       5,     6,     7,     8,     9
+       5,     6,     7,     8,     9,    10,    11,    12
 };
 
@@ -441,5 +430,5 @@
 {
        0,     0,     3,     4,     7,     9,    13,    19,    27,    31,
-      36
+      37,    42
 };
 
@@ -447,8 +436,9 @@
 static const yytype_int8 yyrhs[] =
 {
-      19,     0,    -1,    -1,    19,    20,    -1,    17,    -1,     9,
-       8,    11,    -1,     9,     8,    10,     8,    11,    -1,     9,
-       8,    10,     8,    10,     8,    11,    -1,     5,     8,    11,
-      -1,     6,     3,     8,    11,    -1,     4,     7,    11,    -1
+      17,     0,    -1,    -1,    17,    18,    -1,    15,    -1,    12,
+      10,    14,    -1,    12,    10,    13,    10,    14,    -1,    12,
+      10,    13,    10,    13,    10,    14,    -1,     7,    10,    14,
+      -1,     4,    10,     5,    11,    14,    -1,     8,     3,    10,
+      14,    -1,     6,     9,    14,    -1
 };
 
@@ -456,18 +446,18 @@
 static const yytype_uint8 yyrline[] =
 {
-       0,    63,    63,    64,    66,    67,    68,    69,    71,    74,
-      75
+       0,    71,    71,    72,    75,    76,    77,    78,    79,    84,
+     100,   104
 };
 #endif
 
-#if YYDEBUG || YYERROR_VERBOSE || 0
+#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
 /* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
    First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
 static const char *const yytname[] =
 {
-  "$end", "error", "$undefined", "TOK_SEP", "TOK_USE", "TOK_MODULEMAIN",
-  "TOK_NOTGRIDDEP", "TOK_USEITEM", "TOK_NAME", "TOK_PROBTYPE", "','",
-  "';'", "':'", "'('", "')'", "'['", "']'", "'\\n'", "$accept", "input",
-  "line", YY_NULL
+  "$end", "error", "$undefined", "TOK_SEP", "TOK_KIND", "TOK_EQUAL",
+  "TOK_USE", "TOK_MODULEMAIN", "TOK_NOTGRIDDEP", "TOK_USEITEM", "TOK_NAME",
+  "TOK_CSTINT", "TOK_PROBTYPE", "','", "';'", "'\\n'", "$accept", "input",
+  "line", 0
 };
 #endif
@@ -479,5 +469,5 @@
 {
        0,   256,   257,   258,   259,   260,   261,   262,   263,   264,
-      44,    59,    58,    40,    41,    91,    93,    10
+     265,   266,   267,    44,    59,    10
 };
 # endif
@@ -486,6 +476,6 @@
 static const yytype_uint8 yyr1[] =
 {
-       0,    18,    19,    19,    20,    20,    20,    20,    20,    20,
-      20
+       0,    16,    17,    17,    18,    18,    18,    18,    18,    18,
+      18,    18
 };
 
@@ -493,16 +483,16 @@
 static const yytype_uint8 yyr2[] =
 {
-       0,     2,     0,     2,     1,     3,     5,     7,     3,     4,
-       3
+       0,     2,     0,     2,     1,     3,     5,     7,     3,     5,
+       4,     3
 };
 
-/* YYDEFACT[STATE-NAME] -- Default reduction number in state STATE-NUM.
-   Performed when YYTABLE doesn't specify something else to do.  Zero
+/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
+   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
    means the default is an error.  */
 static const yytype_uint8 yydefact[] =
 {
-       2,     0,     1,     0,     0,     0,     0,     4,     3,     0,
-       0,     0,     0,    10,     8,     0,     0,     5,     9,     0,
-       0,     6,     0,     7
+       2,     0,     1,     0,     0,     0,     0,     0,     4,     3,
+       0,     0,     0,     0,     0,     0,    11,     8,     0,     0,
+       5,     0,    10,     0,     9,     0,     6,     0,     7
 };
 
@@ -510,15 +500,15 @@
 static const yytype_int8 yydefgoto[] =
 {
-      -1,     1,     8
+      -1,     1,     9
 };
 
 /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
    STATE-NUM.  */
-#define YYPACT_NINF -10
+#define YYPACT_NINF -13
 static const yytype_int8 yypact[] =
 {
-     -10,     0,   -10,    -4,     2,     8,     4,   -10,   -10,     3,
-       5,     7,    -9,   -10,   -10,     9,    10,   -10,   -10,    -3,
-      11,   -10,    12,   -10
+     -13,     0,   -13,    -7,     2,    -5,    10,     4,   -13,   -13,
+      11,     3,     5,     8,   -12,     9,   -13,   -13,     7,    12,
+     -13,    13,   -13,    -4,   -13,    14,   -13,    15,   -13
 };
 
@@ -526,29 +516,24 @@
 static const yytype_int8 yypgoto[] =
 {
-     -10,   -10,   -10
+     -13,   -13,   -13
 };
 
 /* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
    positive, shift that token.  If negative, reduce the rule which
-   number is the opposite.  If YYTABLE_NINF, syntax error.  */
+   number is the opposite.  If zero, do what YYDEFACT says.
+   If YYTABLE_NINF, syntax error.  */
 #define YYTABLE_NINF -1
 static const yytype_uint8 yytable[] =
 {
-       2,    16,    17,     9,     3,     4,     5,    20,    21,     6,
-      10,    11,    12,     0,    13,    15,    14,     7,    19,    22,
-      18,     0,     0,    23
+       2,    19,    20,    10,     3,    12,     4,     5,     6,    25,
+      26,    11,     7,    13,    14,     8,    15,    16,    18,    17,
+      21,    22,    23,     0,    27,     0,     0,    24,     0,    28
 };
 
-#define yypact_value_is_default(Yystate) \
-  (!!((Yystate) == (-10)))
-
-#define yytable_value_is_error(Yytable_value) \
-  YYID (0)
-
 static const yytype_int8 yycheck[] =
 {
-       0,    10,    11,     7,     4,     5,     6,    10,    11,     9,
-       8,     3,     8,    -1,    11,     8,    11,    17,     8,     8,
-      11,    -1,    -1,    11
+       0,    13,    14,    10,     4,    10,     6,     7,     8,    13,
+      14,     9,    12,     3,    10,    15,     5,    14,    10,    14,
+      11,    14,    10,    -1,    10,    -1,    -1,    14,    -1,    14
 };
 
@@ -557,7 +542,7 @@
 static const yytype_uint8 yystos[] =
 {
-       0,    19,     0,     4,     5,     6,     9,    17,    20,     7,
-       8,     3,     8,    11,    11,     8,    10,    11,    11,     8,
-      10,    11,     8,    11
+       0,    17,     0,     4,     6,     7,     8,    12,    15,    18,
+      10,     9,    10,     3,    10,     5,    14,    14,    10,    13,
+      14,    11,    14,    10,    14,    13,    14,    10,    14
 };
 
@@ -574,31 +559,22 @@
 /* Like YYERROR except do call yyerror.  This remains here temporarily
    to ease the transition to the new meaning of YYERROR, for GCC.
-   Once GCC version 2 has supplanted version 1, this can go.  However,
-   YYFAIL appears to be in use.  Nevertheless, it is formally deprecated
-   in Bison 2.4.2's NEWS entry, where a plan to phase it out is
-   discussed.  */
+   Once GCC version 2 has supplanted version 1, this can go.  */
 
 #define YYFAIL		goto yyerrlab
-#if defined YYFAIL
-  /* This is here to suppress warnings from the GCC cpp's
-     -Wunused-macros.  Normally we don't worry about that warning, but
-     some users do, and we want to make it easy for users to remove
-     YYFAIL uses, which will produce warnings from Bison 2.5.  */
-#endif
 
 #define YYRECOVERING()  (!!yyerrstatus)
 
-#define YYBACKUP(Token, Value)                                  \
-do                                                              \
-  if (yychar == YYEMPTY)                                        \
-    {                                                           \
-      yychar = (Token);                                         \
-      yylval = (Value);                                         \
-      YYPOPSTACK (yylen);                                       \
-      yystate = *yyssp;                                         \
-      goto yybackup;                                            \
-    }                                                           \
-  else                                                          \
-    {                                                           \
+#define YYBACKUP(Token, Value)					\
+do								\
+  if (yychar == YYEMPTY && yylen == 1)				\
+    {								\
+      yychar = (Token);						\
+      yylval = (Value);						\
+      yytoken = YYTRANSLATE (yychar);				\
+      YYPOPSTACK (1);						\
+      goto yybackup;						\
+    }								\
+  else								\
+    {								\
       yyerror (YY_("syntax error: cannot back up")); \
       YYERROR;							\
@@ -606,16 +582,53 @@
 while (YYID (0))
 
-/* Error token number */
+
 #define YYTERROR	1
 #define YYERRCODE	256
 
 
-/* This macro is provided for backward compatibility. */
+/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
+   If N is 0, then set CURRENT to the empty location which ends
+   the previous symbol: RHS[0] (always defined).  */
+
+#define YYRHSLOC(Rhs, K) ((Rhs)[K])
+#ifndef YYLLOC_DEFAULT
+# define YYLLOC_DEFAULT(Current, Rhs, N)				\
+    do									\
+      if (YYID (N))                                                    \
+	{								\
+	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
+	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
+	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
+	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
+	}								\
+      else								\
+	{								\
+	  (Current).first_line   = (Current).last_line   =		\
+	    YYRHSLOC (Rhs, 0).last_line;				\
+	  (Current).first_column = (Current).last_column =		\
+	    YYRHSLOC (Rhs, 0).last_column;				\
+	}								\
+    while (YYID (0))
+#endif
+
+
+/* YY_LOCATION_PRINT -- Print the location on the stream.
+   This macro was not mandated originally: define only if we know
+   we won't break user code: when these are the locations we know.  */
+
 #ifndef YY_LOCATION_PRINT
-# define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
+#  define YY_LOCATION_PRINT(File, Loc)			\
+     fprintf (File, "%d.%d-%d.%d",			\
+	      (Loc).first_line, (Loc).first_column,	\
+	      (Loc).last_line,  (Loc).last_column)
+# else
+#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+# endif
 #endif
 
 
 /* YYLEX -- calling `yylex' with the right arguments.  */
+
 #ifdef YYLEX_PARAM
 # define YYLEX yylex (YYLEX_PARAM)
@@ -667,6 +680,4 @@
 #endif
 {
-  FILE *yyo = yyoutput;
-  YYUSE (yyo);
   if (!yyvaluep)
     return;
@@ -677,5 +688,9 @@
   YYUSE (yyoutput);
 # endif
-  YYUSE (yytype);
+  switch (yytype)
+    {
+      default:
+	break;
+    }
 }
 
@@ -714,18 +729,15 @@
      || defined __cplusplus || defined _MSC_VER)
 static void
-yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop)
+yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
 #else
 static void
-yy_stack_print (yybottom, yytop)
-    yytype_int16 *yybottom;
-    yytype_int16 *yytop;
+yy_stack_print (bottom, top)
+    yytype_int16 *bottom;
+    yytype_int16 *top;
 #endif
 {
   YYFPRINTF (stderr, "Stack now");
-  for (; yybottom <= yytop; yybottom++)
-    {
-      int yybot = *yybottom;
-      YYFPRINTF (stderr, " %d", yybot);
-    }
+  for (; bottom <= top; ++bottom)
+    YYFPRINTF (stderr, " %d", *bottom);
   YYFPRINTF (stderr, "\n");
 }
@@ -761,9 +773,9 @@
   for (yyi = 0; yyi < yynrhs; yyi++)
     {
-      YYFPRINTF (stderr, "   $%d = ", yyi + 1);
+      fprintf (stderr, "   $%d = ", yyi + 1);
       yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
 		       &(yyvsp[(yyi + 1) - (yynrhs)])
 		       		       );
-      YYFPRINTF (stderr, "\n");
+      fprintf (stderr, "\n");
     }
 }
@@ -801,4 +813,6 @@
 # define YYMAXDEPTH 10000
 #endif
+
+
 
 
@@ -904,143 +918,114 @@
 # endif
 
-/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message
-   about the unexpected token YYTOKEN for the state stack whose top is
-   YYSSP.
-
-   Return 0 if *YYMSG was successfully written.  Return 1 if *YYMSG is
-   not large enough to hold the message.  In that case, also set
-   *YYMSG_ALLOC to the required number of bytes.  Return 2 if the
-   required number of bytes is too large to store.  */
-static int
-yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg,
-                yytype_int16 *yyssp, int yytoken)
-{
-  YYSIZE_T yysize0 = yytnamerr (YY_NULL, yytname[yytoken]);
-  YYSIZE_T yysize = yysize0;
-  enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
-  /* Internationalized format string. */
-  const char *yyformat = YY_NULL;
-  /* Arguments of yyformat. */
-  char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
-  /* Number of reported tokens (one for the "unexpected", one per
-     "expected"). */
-  int yycount = 0;
-
-  /* There are many possibilities here to consider:
-     - Assume YYFAIL is not used.  It's too flawed to consider.  See
-       <http://lists.gnu.org/archive/html/bison-patches/2009-12/msg00024.html>
-       for details.  YYERROR is fine as it does not invoke this
-       function.
-     - If this state is a consistent state with a default action, then
-       the only way this function was invoked is if the default action
-       is an error action.  In that case, don't check for expected
-       tokens because there are none.
-     - The only way there can be no lookahead present (in yychar) is if
-       this state is a consistent state with a default action.  Thus,
-       detecting the absence of a lookahead is sufficient to determine
-       that there is no unexpected or expected token to report.  In that
-       case, just report a simple "syntax error".
-     - Don't assume there isn't a lookahead just because this state is a
-       consistent state with a default action.  There might have been a
-       previous inconsistent state, consistent state with a non-default
-       action, or user semantic action that manipulated yychar.
-     - Of course, the expected token list depends on states to have
-       correct lookahead information, and it depends on the parser not
-       to perform extra reductions after fetching a lookahead from the
-       scanner and before detecting a syntax error.  Thus, state merging
-       (from LALR or IELR) and default reductions corrupt the expected
-       token list.  However, the list is correct for canonical LR with
-       one exception: it will still contain any token that will not be
-       accepted due to an error action in a later state.
-  */
-  if (yytoken != YYEMPTY)
+/* Copy into YYRESULT an error message about the unexpected token
+   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
+   including the terminating null byte.  If YYRESULT is null, do not
+   copy anything; just return the number of bytes that would be
+   copied.  As a special case, return 0 if an ordinary "syntax error"
+   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
+   size calculation.  */
+static YYSIZE_T
+yysyntax_error (char *yyresult, int yystate, int yychar)
+{
+  int yyn = yypact[yystate];
+
+  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
+    return 0;
+  else
     {
-      int yyn = yypact[*yyssp];
-      yyarg[yycount++] = yytname[yytoken];
-      if (!yypact_value_is_default (yyn))
-        {
-          /* Start YYX at -YYN if negative to avoid negative indexes in
-             YYCHECK.  In other words, skip the first -YYN actions for
-             this state because they are default actions.  */
-          int yyxbegin = yyn < 0 ? -yyn : 0;
-          /* Stay within bounds of both yycheck and yytname.  */
-          int yychecklim = YYLAST - yyn + 1;
-          int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
-          int yyx;
-
-          for (yyx = yyxbegin; yyx < yyxend; ++yyx)
-            if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR
-                && !yytable_value_is_error (yytable[yyx + yyn]))
-              {
-                if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
-                  {
-                    yycount = 1;
-                    yysize = yysize0;
-                    break;
-                  }
-                yyarg[yycount++] = yytname[yyx];
-                {
-                  YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULL, yytname[yyx]);
-                  if (! (yysize <= yysize1
-                         && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
-                    return 2;
-                  yysize = yysize1;
-                }
-              }
-        }
+      int yytype = YYTRANSLATE (yychar);
+      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
+      YYSIZE_T yysize = yysize0;
+      YYSIZE_T yysize1;
+      int yysize_overflow = 0;
+      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+      int yyx;
+
+# if 0
+      /* This is so xgettext sees the translatable formats that are
+	 constructed on the fly.  */
+      YY_("syntax error, unexpected %s");
+      YY_("syntax error, unexpected %s, expecting %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
+# endif
+      char *yyfmt;
+      char const *yyf;
+      static char const yyunexpected[] = "syntax error, unexpected %s";
+      static char const yyexpecting[] = ", expecting %s";
+      static char const yyor[] = " or %s";
+      char yyformat[sizeof yyunexpected
+		    + sizeof yyexpecting - 1
+		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
+		       * (sizeof yyor - 1))];
+      char const *yyprefix = yyexpecting;
+
+      /* Start YYX at -YYN if negative to avoid negative indexes in
+	 YYCHECK.  */
+      int yyxbegin = yyn < 0 ? -yyn : 0;
+
+      /* Stay within bounds of both yycheck and yytname.  */
+      int yychecklim = YYLAST - yyn + 1;
+      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+      int yycount = 1;
+
+      yyarg[0] = yytname[yytype];
+      yyfmt = yystpcpy (yyformat, yyunexpected);
+
+      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+	  {
+	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+	      {
+		yycount = 1;
+		yysize = yysize0;
+		yyformat[sizeof yyunexpected - 1] = '\0';
+		break;
+	      }
+	    yyarg[yycount++] = yytname[yyx];
+	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
+	    yysize_overflow |= (yysize1 < yysize);
+	    yysize = yysize1;
+	    yyfmt = yystpcpy (yyfmt, yyprefix);
+	    yyprefix = yyor;
+	  }
+
+      yyf = YY_(yyformat);
+      yysize1 = yysize + yystrlen (yyf);
+      yysize_overflow |= (yysize1 < yysize);
+      yysize = yysize1;
+
+      if (yysize_overflow)
+	return YYSIZE_MAXIMUM;
+
+      if (yyresult)
+	{
+	  /* Avoid sprintf, as that infringes on the user's name space.
+	     Don't have undefined behavior even if the translation
+	     produced a string with the wrong number of "%s"s.  */
+	  char *yyp = yyresult;
+	  int yyi = 0;
+	  while ((*yyp = *yyf) != '\0')
+	    {
+	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
+		{
+		  yyp += yytnamerr (yyp, yyarg[yyi++]);
+		  yyf += 2;
+		}
+	      else
+		{
+		  yyp++;
+		  yyf++;
+		}
+	    }
+	}
+      return yysize;
     }
-
-  switch (yycount)
-    {
-# define YYCASE_(N, S)                      \
-      case N:                               \
-        yyformat = S;                       \
-      break
-      YYCASE_(0, YY_("syntax error"));
-      YYCASE_(1, YY_("syntax error, unexpected %s"));
-      YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s"));
-      YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s"));
-      YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s"));
-      YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"));
-# undef YYCASE_
-    }
-
-  {
-    YYSIZE_T yysize1 = yysize + yystrlen (yyformat);
-    if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
-      return 2;
-    yysize = yysize1;
-  }
-
-  if (*yymsg_alloc < yysize)
-    {
-      *yymsg_alloc = 2 * yysize;
-      if (! (yysize <= *yymsg_alloc
-             && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM))
-        *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM;
-      return 1;
-    }
-
-  /* Avoid sprintf, as that infringes on the user's name space.
-     Don't have undefined behavior even if the translation
-     produced a string with the wrong number of "%s"s.  */
-  {
-    char *yyp = *yymsg;
-    int yyi = 0;
-    while ((*yyp = *yyformat) != '\0')
-      if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount)
-        {
-          yyp += yytnamerr (yyp, yyarg[yyi++]);
-          yyformat += 2;
-        }
-      else
-        {
-          yyp++;
-          yyformat++;
-        }
-  }
-  return 0;
 }
 #endif /* YYERROR_VERBOSE */
+
+
 
 /*-----------------------------------------------.
@@ -1067,27 +1052,41 @@
   YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
 
-  YYUSE (yytype);
-}
-
-
-
-
-/* The lookahead symbol.  */
+  switch (yytype)
+    {
+
+      default:
+	break;
+    }
+}
+
+
+
+/* Prevent warnings from -Wmissing-prototypes.  */
+
+#ifdef YYPARSE_PARAM
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void *YYPARSE_PARAM);
+#else
+int yyparse ();
+#endif
+#else /* ! YYPARSE_PARAM */
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void);
+#else
+int yyparse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+/* The look-ahead symbol.  */
 int yychar;
 
-
-#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
-# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
-# define YY_IGNORE_MAYBE_UNINITIALIZED_END
-#endif
-#ifndef YY_INITIAL_VALUE
-# define YY_INITIAL_VALUE(Value) /* Nothing. */
-#endif
-
-/* The semantic value of the lookahead symbol.  */
-YYSTYPE yylval YY_INITIAL_VALUE(yyval_default);
+/* The semantic value of the look-ahead symbol.  */
+YYSTYPE yylval;
 
 /* Number of syntax errors so far.  */
 int yynerrs;
+
 
 
@@ -1118,35 +1117,12 @@
 #endif
 {
-    int yystate;
-    /* Number of tokens to shift before error messages enabled.  */
-    int yyerrstatus;
-
-    /* The stacks and their tools:
-       `yyss': related to states.
-       `yyvs': related to semantic values.
-
-       Refer to the stacks through separate pointers, to allow yyoverflow
-       to reallocate them elsewhere.  */
-
-    /* The state stack.  */
-    yytype_int16 yyssa[YYINITDEPTH];
-    yytype_int16 *yyss;
-    yytype_int16 *yyssp;
-
-    /* The semantic value stack.  */
-    YYSTYPE yyvsa[YYINITDEPTH];
-    YYSTYPE *yyvs;
-    YYSTYPE *yyvsp;
-
-    YYSIZE_T yystacksize;
-
+  
+  int yystate;
   int yyn;
   int yyresult;
-  /* Lookahead token as an internal (translated) token number.  */
+  /* Number of tokens to shift before error messages enabled.  */
+  int yyerrstatus;
+  /* Look-ahead token as an internal (translated) token number.  */
   int yytoken = 0;
-  /* The variables used to return semantic value and location from the
-     action routines.  */
-  YYSTYPE yyval;
-
 #if YYERROR_VERBOSE
   /* Buffer for error messages, and its allocated size.  */
@@ -1156,5 +1132,32 @@
 #endif
 
+  /* Three stacks and their tools:
+     `yyss': related to states,
+     `yyvs': related to semantic values,
+     `yyls': related to locations.
+
+     Refer to the stacks thru separate pointers, to allow yyoverflow
+     to reallocate them elsewhere.  */
+
+  /* The state stack.  */
+  yytype_int16 yyssa[YYINITDEPTH];
+  yytype_int16 *yyss = yyssa;
+  yytype_int16 *yyssp;
+
+  /* The semantic value stack.  */
+  YYSTYPE yyvsa[YYINITDEPTH];
+  YYSTYPE *yyvs = yyvsa;
+  YYSTYPE *yyvsp;
+
+
+
 #define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N))
+
+  YYSIZE_T yystacksize = YYINITDEPTH;
+
+  /* The variables used to return semantic value and location from the
+     action routines.  */
+  YYSTYPE yyval;
+
 
   /* The number of symbols on the RHS of the reduced rule.
@@ -1162,8 +1165,4 @@
   int yylen = 0;
 
-  yyssp = yyss = yyssa;
-  yyvsp = yyvs = yyvsa;
-  yystacksize = YYINITDEPTH;
-
   YYDPRINTF ((stderr, "Starting parse\n"));
 
@@ -1171,5 +1170,14 @@
   yyerrstatus = 0;
   yynerrs = 0;
-  yychar = YYEMPTY; /* Cause a token to be read.  */
+  yychar = YYEMPTY;		/* Cause a token to be read.  */
+
+  /* Initialize stack pointers.
+     Waste one element of value and location stack
+     so that they stay on the same level as the state stack.
+     The wasted elements are never initialized.  */
+
+  yyssp = yyss;
+  yyvsp = yyvs;
+
   goto yysetstate;
 
@@ -1198,4 +1206,5 @@
 	yytype_int16 *yyss1 = yyss;
 
+
 	/* Each stack pointer address is followed by the size of the
 	   data in use in that stack, in bytes.  This used to be a
@@ -1205,4 +1214,5 @@
 		    &yyss1, yysize * sizeof (*yyssp),
 		    &yyvs1, yysize * sizeof (*yyvsp),
+
 		    &yystacksize);
 
@@ -1227,6 +1237,7 @@
 	if (! yyptr)
 	  goto yyexhaustedlab;
-	YYSTACK_RELOCATE (yyss_alloc, yyss);
-	YYSTACK_RELOCATE (yyvs_alloc, yyvs);
+	YYSTACK_RELOCATE (yyss);
+	YYSTACK_RELOCATE (yyvs);
+
 #  undef YYSTACK_RELOCATE
 	if (yyss1 != yyssa)
@@ -1239,4 +1250,5 @@
       yyvsp = yyvs + yysize - 1;
 
+
       YYDPRINTF ((stderr, "Stack size increased to %lu\n",
 		  (unsigned long int) yystacksize));
@@ -1247,7 +1259,4 @@
 
   YYDPRINTF ((stderr, "Entering state %d\n", yystate));
-
-  if (yystate == YYFINAL)
-    YYACCEPT;
 
   goto yybackup;
@@ -1259,14 +1268,14 @@
 
   /* Do appropriate processing given the current state.  Read a
-     lookahead token if we need one and don't already have one.  */
-
-  /* First try to decide what to do without reference to lookahead token.  */
+     look-ahead token if we need one and don't already have one.  */
+
+  /* First try to decide what to do without reference to look-ahead token.  */
   yyn = yypact[yystate];
-  if (yypact_value_is_default (yyn))
+  if (yyn == YYPACT_NINF)
     goto yydefault;
 
-  /* Not known => get a lookahead token if don't already have one.  */
-
-  /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
+  /* Not known => get a look-ahead token if don't already have one.  */
+
+  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
   if (yychar == YYEMPTY)
     {
@@ -1294,9 +1303,12 @@
   if (yyn <= 0)
     {
-      if (yytable_value_is_error (yyn))
-        goto yyerrlab;
+      if (yyn == 0 || yyn == YYTABLE_NINF)
+	goto yyerrlab;
       yyn = -yyn;
       goto yyreduce;
     }
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
 
   /* Count tokens shifted since error; after three, turn off error
@@ -1305,14 +1317,13 @@
     yyerrstatus--;
 
-  /* Shift the lookahead token.  */
+  /* Shift the look-ahead token.  */
   YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
 
-  /* Discard the shifted token.  */
-  yychar = YYEMPTY;
+  /* Discard the shifted token unless it is eof.  */
+  if (yychar != YYEOF)
+    yychar = YYEMPTY;
 
   yystate = yyn;
-  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
   *++yyvsp = yylval;
-  YY_IGNORE_MAYBE_UNINITIALIZED_END
 
   goto yynewstate;
@@ -1351,61 +1362,65 @@
     {
         case 5:
-/* Line 1787 of yacc.c  */
-#line 67 "convert.y"
-    {initdimprob(1,(yyvsp[(2) - (3)].na),"0","0");}
+#line 76 "convert.y"
+    { initdimprob(1,(yyvsp[(2) - (3)].na),"0","0"); ;}
     break;
 
   case 6:
-/* Line 1787 of yacc.c  */
-#line 68 "convert.y"
-    {initdimprob(2,(yyvsp[(2) - (5)].na), (yyvsp[(4) - (5)].na),"0");}
+#line 77 "convert.y"
+    { initdimprob(2,(yyvsp[(2) - (5)].na), (yyvsp[(4) - (5)].na),"0"); ;}
     break;
 
   case 7:
-/* Line 1787 of yacc.c  */
-#line 70 "convert.y"
-    {initdimprob(3,(yyvsp[(2) - (7)].na), (yyvsp[(4) - (7)].na), (yyvsp[(6) - (7)].na));}
+#line 78 "convert.y"
+    { initdimprob(3,(yyvsp[(2) - (7)].na), (yyvsp[(4) - (7)].na), (yyvsp[(6) - (7)].na)); ;}
     break;
 
   case 8:
-/* Line 1787 of yacc.c  */
-#line 72 "convert.y"
-    {listofmodules = Addtolistnom((yyvsp[(2) - (3)].na),listofmodules,0);
-                                                        Addmoduletothelist((yyvsp[(2) - (3)].na));}
+#line 80 "convert.y"
+    {
+            listofmodules = Addtolistnom((yyvsp[(2) - (3)].na),listofmodules,0);
+            Addmoduletothelist((yyvsp[(2) - (3)].na));
+        ;}
     break;
 
   case 9:
-/* Line 1787 of yacc.c  */
-#line 74 "convert.y"
-    {Add_NotGridDepend_Var_1((yyvsp[(3) - (4)].na));}
+#line 85 "convert.y"
+    {
+            if (!strcasecmp((yyvsp[(4) - (5)].na),"4"))
+            {
+                listofkind = Addtolistnom((yyvsp[(2) - (5)].na),listofkind,4);
+            }
+            else if (!strcasecmp((yyvsp[(4) - (5)].na),"8"))
+            {
+                listofkind = Addtolistnom((yyvsp[(2) - (5)].na),listofkind,8);
+            }
+            else
+            {
+                printf("##\n## Unknown kind type : %s (must be 4 or 8)\n##",(yyvsp[(4) - (5)].na));
+                exit(0);
+            }
+        ;}
     break;
 
   case 10:
-/* Line 1787 of yacc.c  */
-#line 75 "convert.y"
+#line 101 "convert.y"
     {
-                                    if (!strcasecmp((yyvsp[(2) - (3)].na),"FIXED_GRIDS"))
-                                                                 fixedgrids=1;
-                                    if (!strcasecmp((yyvsp[(2) - (3)].na),"ONLY_FIXED_GRIDS"))
-                                                             onlyfixedgrids=1;
-                                 }
+            Add_NotGridDepend_Var_1((yyvsp[(3) - (4)].na));
+        ;}
     break;
 
-
-/* Line 1787 of yacc.c  */
-#line 1397 "convert.tab.c"
+  case 11:
+#line 105 "convert.y"
+    {
+            if (!strcasecmp((yyvsp[(2) - (3)].na),"FIXED_GRIDS"))      fixedgrids = 1;
+            if (!strcasecmp((yyvsp[(2) - (3)].na),"ONLY_FIXED_GRIDS")) onlyfixedgrids = 1;
+        ;}
+    break;
+
+
+/* Line 1267 of yacc.c.  */
+#line 1420 "convert.tab.c"
       default: break;
     }
-  /* User semantic actions sometimes alter yychar, and that requires
-     that yytoken be updated with the new translation.  We take the
-     approach of translating immediately before every use of yytoken.
-     One alternative is translating here after every semantic action,
-     but that translation would be missed if the semantic action invokes
-     YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or
-     if it invokes YYBACKUP.  In the case of YYABORT or YYACCEPT, an
-     incorrect destructor might then be invoked immediately.  In the
-     case of YYERROR or YYBACKUP, subsequent parser actions might lead
-     to an incorrect destructor call or verbose syntax error message
-     before the lookahead is translated.  */
   YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
 
@@ -1415,4 +1430,5 @@
 
   *++yyvsp = yyval;
+
 
   /* Now `shift' the result of the reduction.  Determine what state
@@ -1435,8 +1451,4 @@
 `------------------------------------*/
 yyerrlab:
-  /* Make sure we have latest lookahead translation.  See comments at
-     user semantic actions for why this is necessary.  */
-  yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar);
-
   /* If not already recovering from an error, report this error.  */
   if (!yyerrstatus)
@@ -1446,34 +1458,35 @@
       yyerror (YY_("syntax error"));
 #else
-# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \
-                                        yyssp, yytoken)
       {
-        char const *yymsgp = YY_("syntax error");
-        int yysyntax_error_status;
-        yysyntax_error_status = YYSYNTAX_ERROR;
-        if (yysyntax_error_status == 0)
-          yymsgp = yymsg;
-        else if (yysyntax_error_status == 1)
-          {
-            if (yymsg != yymsgbuf)
-              YYSTACK_FREE (yymsg);
-            yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc);
-            if (!yymsg)
-              {
-                yymsg = yymsgbuf;
-                yymsg_alloc = sizeof yymsgbuf;
-                yysyntax_error_status = 2;
-              }
-            else
-              {
-                yysyntax_error_status = YYSYNTAX_ERROR;
-                yymsgp = yymsg;
-              }
-          }
-        yyerror (yymsgp);
-        if (yysyntax_error_status == 2)
-          goto yyexhaustedlab;
+	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
+	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
+	  {
+	    YYSIZE_T yyalloc = 2 * yysize;
+	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
+	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
+	    if (yymsg != yymsgbuf)
+	      YYSTACK_FREE (yymsg);
+	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
+	    if (yymsg)
+	      yymsg_alloc = yyalloc;
+	    else
+	      {
+		yymsg = yymsgbuf;
+		yymsg_alloc = sizeof yymsgbuf;
+	      }
+	  }
+
+	if (0 < yysize && yysize <= yymsg_alloc)
+	  {
+	    (void) yysyntax_error (yymsg, yystate, yychar);
+	    yyerror (yymsg);
+	  }
+	else
+	  {
+	    yyerror (YY_("syntax error"));
+	    if (yysize != 0)
+	      goto yyexhaustedlab;
+	  }
       }
-# undef YYSYNTAX_ERROR
 #endif
     }
@@ -1483,5 +1496,5 @@
   if (yyerrstatus == 3)
     {
-      /* If just tried and failed to reuse lookahead token after an
+      /* If just tried and failed to reuse look-ahead token after an
 	 error, discard it.  */
 
@@ -1500,5 +1513,5 @@
     }
 
-  /* Else will try to reuse lookahead token after shifting the error
+  /* Else will try to reuse look-ahead token after shifting the error
      token.  */
   goto yyerrlab1;
@@ -1534,5 +1547,5 @@
     {
       yyn = yypact[yystate];
-      if (!yypact_value_is_default (yyn))
+      if (yyn != YYPACT_NINF)
 	{
 	  yyn += YYTERROR;
@@ -1557,7 +1570,8 @@
     }
 
-  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
   *++yyvsp = yylval;
-  YY_IGNORE_MAYBE_UNINITIALIZED_END
 
 
@@ -1583,5 +1597,5 @@
   goto yyreturn;
 
-#if !defined yyoverflow || YYERROR_VERBOSE
+#ifndef yyoverflow
 /*-------------------------------------------------.
 | yyexhaustedlab -- memory exhaustion comes here.  |
@@ -1594,12 +1608,7 @@
 
 yyreturn:
-  if (yychar != YYEMPTY)
-    {
-      /* Make sure we have latest lookahead translation.  See comments at
-         user semantic actions for why this is necessary.  */
-      yytoken = YYTRANSLATE (yychar);
-      yydestruct ("Cleanup: discarding lookahead",
-                  yytoken, &yylval);
-    }
+  if (yychar != YYEOF && yychar != YYEMPTY)
+     yydestruct ("Cleanup: discarding lookahead",
+		 yytoken, &yylval);
   /* Do not reclaim the symbols of the rule which action triggered
      this YYABORT or YYACCEPT.  */
@@ -1625,375 +1634,360 @@
 
 
-/* Line 2050 of yacc.c  */
-#line 82 "convert.y"
-
+#line 110 "convert.y"
+
+
+void print_usage()
+{
+    printf("usage : conv <config_file> -convfile  <FILENAME>\n");
+    printf(" [-workdir <directory>] [-incdir <directory>]\n");
+    printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
+    printf(" [-convfile  <FILENAME>] [-SubloopScalar] [-SubloopScalar1] \n");
+    printf(" [-free|-fixed]\n");
+    exit(0);
+}
 
 int main(int argc,char *argv[])
 {
-   extern FILE * yyin ;
-   FILE *dependglobaloutput;
-   int i;
-   listnom *parcours;
-   listvar *newvar;
-   int stylegiven = 0;
-   int infreegiven ;
-   int infixedgiven ;
-   int lengthmainfile;
-
-   if (argc < 2)
-   {
-       printf("usage : conv <file> [-rm] [-incdir <directory>] \n");
-       printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
-       printf(" [-convfile  <FILENAME >] -SubloopScalar -SubloopScalar1 \n");
-       printf(" [-free|-fixed]\n");
-       exit(0);
-   }
+    extern FILE * convert_in ;
+    FILE *dependglobaloutput;
+    int i;
+    listnom *parcours;
+    listvar *newvar;
+    int stylegiven = 0;
+    int infreegiven ;
+    int infixedgiven ;
+    int lengthmainfile;
+
+    char filetoparse[LONG_FNAME];
+
 /******************************************************************************/
 /*  1-  Variables initialization                                              */
 /******************************************************************************/
-   List_Global_Var=(listvar *)NULL;
-   List_GlobalParameter_Var=(listvar *)NULL;
-   List_Allocate_Var=(listallocate *)NULL;
-   List_Common_Var=(listvar *)NULL;
-   List_SubroutineWhereAgrifUsed=(listnom *)NULL;
-   List_Subroutine_For_Alloc=(listnom *)NULL;
-   List_Include=(listusemodule *)NULL;
-   List_NameOfModuleUsed=(listusemodule *)NULL;
-   listofmoduletmp=(listusemodule *)NULL;
-   List_SubroutineDeclaration_Var=(listvar *)NULL;
-   List_UsedInSubroutine_Var=(listvar *)NULL;
-   List_NotGridDepend_Var=(listvar *)NULL;
-   Listofavailableindices=(listindice *)NULL;
-   List_CouplePointed_Var=(listvarpointtovar *)NULL;
-   List_ModuleUsed_Var = (listvar *)NULL;
-   List_ModuleUsedInModuleUsed_Var = (listvar *)NULL;
-   List_GlobParamModuleUsed_Var = (listparameter *)NULL;
-   List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *)NULL;
-   List_SubroutineArgument_Var = (listvar *)NULL;
-   List_FunctionType_Var = (listvar *)NULL;
-   tmpuselocallist = (listusemodule *)NULL;
-   List_ContainsSubroutine = (listnom *)NULL;
-   oldfortranout = (FILE *)NULL;
-
-   strcpy(mainfile,argv[1]);
-   strcpy(nomdir,"AGRIF_INC");
-   strcpy(commondirin,".");
-   strcpy(commondirout,".");
-   strcpy(filetoparse," ");
-   strcpy(subofagrifinitgrids,"");
-   strcpy(meetagrifinitgrids,"");
-   strcpy(mpiinitvar,"");
-
-   length_last = 0 ;
-   length_first = 0 ;
-   length_v_typevar = 0 ;
-   length_v_nomvar = 0 ;
-   length_v_dimchar = 0 ;
-   length_v_modulename = 0 ;
-   length_v_commonname = 0 ;
-   length_v_vallengspec = 0 ;
-   length_v_nameinttypename = 0 ;
-   length_v_commoninfile = 0 ;
-   length_v_subroutinename = 0 ;
-   length_v_precision = 0 ;
-   length_v_IntentSpec = 0 ;
-   length_v_initialvalue = 0 ;
-   length_v_readedlistdimension = 0 ;
-   length_u_usemodule = 0 ;
-   length_u_charusemodule = 0 ;
-   length_u_cursubroutine = 0 ;
-   length_u_modulename = 0 ;
-   length_n_name = 0 ;
-   length_c_namevar = 0 ;
-   length_c_namepointedvar = 0 ;
-   length_o_nom = 0 ;
-   length_o_module = 0 ;
-   length_a_nomvar = 0 ;
-   length_a_subroutine = 0 ;
-   length_a_module = 0 ;
-   length_t_usemodule = 0 ;
-   length_t_cursubroutine = 0 ;
-   length_curfilename = 0 ;
-   length_nomfileoutput = 0 ;
-   length_motparse = 0 ;
-   length_mainfile = 0 ;
-   length_nomdir = 0 ;
-   length_commondirout = 0 ;
-   length_commondirin = 0 ;
-   length_filetoparse = 0 ;
-   length_curbuf = 0 ;
-   length_toprintglob = 0 ;
-   length_tmpvargridname = 0 ;
-   length_ligne_Subloop = 0 ;
-   length_lvargridname_toamr = 0 ;
-   length_toprint_utilagrif = 0 ;
-   length_toprinttmp_utilchar = 0 ;
-   length_ligne_writedecl = 0 ;
-   length_newname_toamr = 0 ;
-   length_newname_writedecl = 0 ;
-   length_ligne_toamr = 0 ;
-   length_tmpligne_writedecl = 0 ;
-   value_char_size = 0 ;
-   value_char_size1 = 0 ;
-   value_char_size2 = 0 ;
-   value_char_size3 = 0 ;
-   inallocate = 0;
-   infixed = 1;
-   infree  = 0;
-
-   checkexistcommon=1;
-   todebug=0;
-   onlyfixedgrids=0;
-   fixedgrids=0;
-   InAgrifParentDef = 0;
-   IndicenbmaillesX=0;
-   IndicenbmaillesY=0;
-   IndicenbmaillesZ=0;
-   created_dimensionlist = 1;
-   indicemaxtabvars = 0;   /* current indice in the table tabvars             */
-   SubloopScalar = 0;
-   todebug = 0;
-   todebugfree = 0;
-   retour77 = 1 ;
-   mark = 0 ;
-   shouldincludempif = 0 ;
-   Read_val_max();
+    List_Global_Var = (listvar *) NULL;
+    List_GlobalParameter_Var = (listvar *) NULL;
+    List_Common_Var = (listvar *) NULL;
+    List_Allocate_Var = (listallocate *) NULL;
+    List_SubroutineWhereAgrifUsed = (listnom *) NULL;
+    List_Subroutine_For_Alloc = (listnom *) NULL;
+    List_Include = (listusemodule *) NULL;
+    List_NameOfModuleUsed = (listusemodule *) NULL;
+    listofmoduletmp = (listusemodule *) NULL;
+    List_SubroutineDeclaration_Var = (listvar *) NULL;
+    List_UsedInSubroutine_Var = (listvar *) NULL;
+    List_NotGridDepend_Var = (listvar *) NULL;
+    Listofavailableindices = (listindice *) NULL;
+    Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+    List_CouplePointed_Var = (listvarpointtovar *) NULL;
+    List_ModuleUsed_Var = (listvar *) NULL;
+    List_ModuleUsedInModuleUsed_Var = (listvar *) NULL;
+    List_GlobParamModuleUsed_Var = (listparameter *) NULL;
+    List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *) NULL;
+    List_SubroutineArgument_Var = (listvar *) NULL;
+    List_FunctionType_Var = (listvar *) NULL;
+    tmpuselocallist = (listusemodule *) NULL;
+    List_ContainsSubroutine = (listnom *) NULL;
+    oldfortran_out = (FILE *) NULL;
+
+    if (argc < 2) print_usage();
+    
+    strcpy(config_file, argv[1]);
+    strcpy(work_dir, ".");
+    strcpy(input_dir, ".");
+    strcpy(output_dir, "AGRIF_MODELFILES");
+    strcpy(include_dir, "AGRIF_INC");
+    strcpy(filetoparse, "");
+    strcpy(subofagrifinitgrids, "");
+    strcpy(meetagrifinitgrids, "");
+    strcpy(mpiinitvar, "");
+
+    length_last = 0 ;
+    length_first = 0 ;
+    length_v_vallengspec = 0 ;
+    length_v_commoninfile = 0 ;
+    length_v_precision = 0 ;
+    length_v_IntentSpec = 0 ;
+    length_v_initialvalue = 0 ;
+    length_v_readedlistdimension = 0 ;
+    length_a_nomvar = 0 ;
+    length_toprintglob = 0 ;
+    length_tmpvargridname = 0 ;
+    length_ligne_Subloop = 0 ;
+    length_toprint_utilagrif = 0 ;
+    length_toprinttmp_utilchar = 0 ;
+    length_ligne_writedecl = 0 ;
+    length_newname_toamr = 0 ;
+    length_newname_writedecl = 0 ;
+    length_ligne_toamr = 0 ;
+    length_tmpligne_writedecl = 0 ;
+    value_char_size = 0 ;
+    value_char_size1 = 0 ;
+    value_char_size2 = 0 ;
+    value_char_size3 = 0 ;
+    inallocate = 0;
+    infixed = 1;
+    infree  = 0;
+
+    onlyfixedgrids=0;
+    fixedgrids=0;
+    InAgrifParentDef = 0;
+    IndicenbmaillesX=0;
+    IndicenbmaillesY=0;
+    IndicenbmaillesZ=0;
+    created_dimensionlist = 1;
+    /* current indice in the table tabvars             */
+    for ( i=0 ; i<NB_CAT_VARIABLES ; i++)
+    {
+        indicemaxtabvars[i] = 0;
+    }
+    SubloopScalar = 0;
+    todebug = 0;
+    retour77 = 1 ;
+    shouldincludempif = 0 ;
+
+    Read_val_max();
+
 /******************************************************************************/
 /*  2-  Program arguments                                                     */
 /******************************************************************************/
 
-   if ((yyin=fopen(argv[1],"r"))==NULL)
-   {
-      printf("the file %s doesn't exist \n",argv[1]);
-      exit(0);
-   }
-
-   i=2;
-   while (i<argc)
-   {
-      if (!strcasecmp(argv[i],"-incdir"))
-      {
-         strcpy(nomdir,argv[i+1]);
-         i++;
-      }
-      else if (!strcasecmp(argv[i],"-comdirin")) /* input directory           */
-      {
-         strcpy(commondirin,argv[i+1]);
-         i++;
-      }
-      else if (!strcasecmp(argv[i],"-comdirout")) /* output directory         */
-      {
-         strcpy(commondirout,argv[i+1]);
-         i++;
-      }
-      else if (!strcasecmp(argv[i],"-convfile")) /* file to parse             */
-      {
-         strcpy(filetoparse,argv[i+1]);
-         i++;
-         lengthmainfile = strlen(filetoparse);
-         if (!strcasecmp(&filetoparse[lengthmainfile-4],".f90"))
-         {
-         infixed = 0;
-         infree = 1;
-         }
-         else
-         {
-         infixed = 1;
-         infree = 0;
-         }
-      }
-      else if (!strcasecmp(argv[i],"-free")) /* file to parse        */
-      {
-         stylegiven = 1;
-         infreegiven  = 1 ;
-         infixedgiven = 0;
-      }   
-      else if (!strcasecmp(argv[i],"-fixed")) /* file to parse        */
-      {
-         stylegiven = 1;
-         infreegiven  = 0;
-         infixedgiven = 1;
-      }         
-      else if (!strcasecmp(argv[i],"-SubloopScalar")) /* file to parse        */
-      {
-         SubloopScalar = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-SubloopScalar1")) /* file to parse       */
-      {
-         SubloopScalar = 2 ;
-      }
-      else if (!strcasecmp(argv[i],"-todebug")) /* file to parse       */
-      {
-         todebug = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-mark")) /* file to parse       */
-      {
-         mark = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-todebugfree")) /* file to parse       */
-      {
-         todebugfree = 1 ;
-      }
-      else if (!strcasecmp(argv[i],"-rm"))
-      {
-         checkexistcommon=0;
-      }
-      else
-      {
-         printf("Unkwon option : %s\n",argv[i]);
-         exit(0);
-      }
-      i++;
-   }
-
-   if (stylegiven == 1) 
-   {
-   infree = infreegiven;
-   infixed = infixedgiven;   
-   }
-   Save_Length(nomdir,34);
-   Save_Length(commondirout,35);
-   Save_Length(commondirin,36);
-   Save_Length(filetoparse,37);
+    if ( (convert_in=fopen(config_file,"r")) == NULL )
+    {
+        printf("##\n## ERROR: the configuration file '%s' doesn't exist.\n##\n", config_file);
+        print_usage();
+    }
+
+    i=2;
+    while ( i < argc )
+    {
+        if (!strcasecmp(argv[i], "-workdir"))
+        {
+            strcpy(work_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-incdir"))
+        {
+            strcpy(include_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirin")) /* input directory           */
+        {
+            strcpy(input_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirout")) /* output directory         */
+        {
+            strcpy(output_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-convfile")) /* file to parse             */
+        {
+            strcpy(filetoparse, argv[i+1]);
+            i++;
+            lengthmainfile = strlen(filetoparse);
+            if (!strcasecmp(&filetoparse[lengthmainfile-4], ".f90"))
+            {
+                infixed = 0;
+                infree = 1;
+            }
+            else
+            {
+                infixed = 1;
+                infree = 0;
+            }
+        }
+        else if (!strcasecmp(argv[i], "-free"))
+        {
+            stylegiven = 1;
+            infreegiven  = 1 ;
+            infixedgiven = 0;
+        }
+        else if (!strcasecmp(argv[i], "-fixed"))
+        {
+            stylegiven = 1;
+            infreegiven  = 0;
+            infixedgiven = 1;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar"))
+        {
+            SubloopScalar = 1 ;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar1"))
+        {
+            SubloopScalar = 2 ;
+        }
+        else if (!strcasecmp(argv[i], "-todebug"))
+        {
+            todebug = 1 ;
+        }
+        else if (!strcasecmp(argv[i],"-rm")) { }
+        else
+        {
+            printf("##\n## Unkwon option : %s\n##\n", argv[i]);
+            exit(0);
+        }
+        i++;
+    }
+    // Check input file
+    if ( strlen(filetoparse) == 0 )         // -convfile has not been specified
+    {
+        printf("##\n## ERROR: please provide a file to parse with -convfile.\n##\n");
+        print_usage();
+    }
+    // Setup input & output directories
+    if ( strcasecmp(work_dir, ".") != 0 )   // -workdir has been changed...
+    {
+        if ( strcasecmp(input_dir,  ".") == 0 )                 // ...and -comdirin  has NOT been changed
+        {
+            strcpy(input_dir, work_dir);
+        }
+        if ( strcasecmp(output_dir, "AGRIF_MODELFILES") == 0 )  // ...and -comdirout has NOT been changed
+        {
+            sprintf(output_dir, "%s/%s", work_dir, "AGRIF_MODELFILES");
+        }
+        if ( strcasecmp(include_dir, "AGRIF_INC") == 0 )        // ...and -incdir    has NOT been changed
+        {
+            sprintf(include_dir, "%s/%s", work_dir, "AGRIF_INC");
+        }
+    }
+    if (stylegiven == 1)
+    {
+        infree  = infreegiven;
+        infixed = infixedgiven;
+    }
 
 /******************************************************************************/
-/*  3-  Parsing of the  conv file <name>.in                                   */
+/*  3-  Parsing of the conv file <name>.in                                    */
 /******************************************************************************/
 
-   if ((yyin=fopen(argv[1],"r"))==NULL)
-   {
-       printf("the file %s doesn't exist \n",argv[1]);
-       exit(0);
-   }
-   strcpy(mainfile,argv[1]);
-   Save_Length(mainfile,33);
-
-   if ( strstr(filetoparse,".f90") ||
-        strstr(filetoparse,".F90") ) retour77 = 0;
-
-   yyparse();
+    if ( strstr(filetoparse, ".f90") || strstr(filetoparse, ".F90") ) retour77 = 0;
+
+    convert_parse();
 
 /******************************************************************************/
 /*  4-  Preparation of the file parsing                                       */
 /******************************************************************************/
-   if ((yyin=fopen(filetoparse,"r"))==NULL) /* Is the file to parse exist ?   */
-   {
-      printf("the file %s doesn't exist \n",filetoparse);
-      exit(0);
-   }
-   /* mainfile : the name of the file to parse                                */
-   strcpy(mainfile,filetoparse);
-   /*                                                                         */
-   if ((dependglobaloutput=fopen(".dependglobal_agrif","r"))!=NULL)
-   {
-      fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars);
-      fclose(dependglobaloutput);
-   }
-   Readthedependavailablefile();
-   /* Read the .dependnbxnby file which contains indices of nbmaillsX,        */
-   /*    nbmailleY and nbmailleZ                                              */
-   Readthedependnbxnbyfile();
-   Read_Subroutine_For_Alloc();
+
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    /*                                                                         */
+    if ( (dependglobaloutput=fopen(dependfilename, "r")) != NULL )
+    {
+        for (i=0;i<NB_CAT_VARIABLES;i++)
+        {
+            fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars[i]);
+        }
+        fclose(dependglobaloutput);
+    }
+    Readthedependavailablefile();
+    /* Read the .dependnbxnby file which contains indices of nbmaillsX, nbmailleY and nbmailleZ */
+    Readthedependnbxnbyfile();
+    Read_Subroutine_For_Alloc();
+
 /******************************************************************************/
 /*  5-  Parsing of the input file (2 times)                                   */
 /******************************************************************************/
-   /* Record all variable in list                                             */
-   firstpass = 1;
-   processfortran(filetoparse);
-   /*                                                                         */
-   CompleteThelistvarindoloop();
-   /* Read list of module used                                                */
-   RecordUseModulesVariables();
-   /* Read list of module used in module used                                 */
-   RecordUseModulesUseModulesVariables();
-   /* Save variables are considered as globals ones                           */
-   Update_List_Global_Var_From_List_Save_Var();
-   /* Update all lists                                                        */
-   ListUpdate();
-   /*                                                                         */
-   Clean_List_Global_Var();
-   /* Indice tabvars identification                                           */
-   IndiceTabvarsIdentification();
-   /* Update all lists                                                        */
-   ListUpdate();
-   /* The allocation subroutine is necessary ????                             */
-   New_Allocate_Subroutine_Is_Necessary();
-   /* The allocation subroutine is necessary for common list                  */
-   New_Allocate_Subroutine_For_Common_Is_Necessary();
-   /* Sort List_SubroutineArgument_Var                                        */
-   Sort_List_SubroutineArgument_Var();
-   /* Clean all lists                                                         */
-   ListClean();
-   /* Update Indice of List_UsedInSubroutine_Var from module used             */
-   List_UsedInSubroutine_Var_Update_From_Module_Used();
-   /* Update List_SubroutineWhereAgrifUsed                                    */
-   UpdateList_SubroutineWhereAgrifUsed();
-   /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
-   UpdateList_UsedInSubroutine_With_dimension();;
-   /*                                                                         */
-   ModifyThelistvarindoloop();
-   /*                                                                         */
-   UpdateListDeclarationWithDimensionList();
-   /*                                                                         */
-   GiveTypeOfVariables();
-   Affiche();
-   /* Build new subroutines                                                   */
-   firstpass = 0;
-   processfortran(filetoparse);
-
-   newvar = (listvar *)NULL;
-/*newvar = List_Global_Var; */
-   while ( newvar )
-   {
-      printf("++++ %s %d %s %s %s\n",
-      newvar->var->v_nomvar,
-      newvar->var->v_nbdim,
-      newvar->var->v_subroutinename,
-      newvar->var->v_modulename,
-      newvar->var->v_typevar
-             );
-      newvar = newvar->suiv;
-   }
+
+    /* Record all variables in list                                            */
+    firstpass = 1;
+    process_fortran(filetoparse);
+
+    CompleteThelistvarindoloop();
+    /* Read list of module used                                                */
+    RecordUseModulesVariables();
+    /* Read list of module used in module used                                 */
+    RecordUseModulesUseModulesVariables();
+    /* Save variables are considered as globals ones                           */
+    Update_List_Global_Var_From_List_Save_Var();
+    /* Update all lists                                                        */
+    ListUpdate();
+
+    Clean_List_Global_Var();
+    /* Indice tabvars identification                                           */
+    IndiceTabvarsIdentification();
+    /* Update all lists                                                        */
+    ListUpdate();
+    /* The allocation subroutine is necessary ????                             */
+    New_Allocate_Subroutine_Is_Necessary();
+    /* The allocation subroutine is necessary for common list                  */
+    New_Allocate_Subroutine_For_Common_Is_Necessary();
+    /* Sort List_SubroutineArgument_Var                                        */
+    Sort_List_SubroutineArgument_Var();
+    /* Clean all lists                                                         */
+    ListClean();
+    /* Update Indice of List_UsedInSubroutine_Var from module used             */
+    List_UsedInSubroutine_Var_Update_From_Module_Used();
+    /* Update List_SubroutineWhereAgrifUsed                                    */
+    UpdateList_SubroutineWhereAgrifUsed();
+    /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
+    UpdateList_UsedInSubroutine_With_dimension();
+
+    ModifyThelistvarindoloop();
+    UpdateListDeclarationWithDimensionList();
+    GiveTypeOfVariables();
+
+    /* Build new subroutines                                                   */
+    firstpass = 0;
+    process_fortran(filetoparse);
+
+    newvar = (listvar *) NULL;
+
+    while ( newvar )
+    {
+        printf("++++ %s %d %s %s %s\n",
+            newvar->var->v_nomvar,
+            newvar->var->v_nbdim,
+            newvar->var->v_subroutinename,
+            newvar->var->v_modulename,
+            newvar->var->v_typevar);
+        newvar = newvar->suiv;
+    }
+
 /******************************************************************************/
 /*  6-  Write informations in output files                                    */
 /******************************************************************************/
 
-   /* Write the .dependglobal_agrif file which contain the max indice         */
-   /*    of the tabvars table                                                 */
-   dependglobaloutput = fopen(".dependglobal_agrif","w");
-   fprintf(dependglobaloutput,"%d\n",indicemaxtabvars);
-   fclose(dependglobaloutput);
-   /* Write the list of available indice                                      */
-   Writethedependavailablefile();
-   /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
-   /*    nbmailleY and nbmailleZ                                              */
-   Writethedependnbxnbyfile();
-   /* Write the .depend<namefile> file which contain general informations     */
-   /*    about variable of this file                                          */
-   parcours = List_NameOfModule;
-   while( parcours )
-   {
-      Writethedependlistofmoduleused(parcours->o_nom);
-      WritedependParameterList(parcours->o_nom);
-      Writethedependfile(parcours->o_nom,List_Global_Var);
-      parcours=parcours->suiv;
-   }
-   parcours = List_NameOfCommon;
-   while( parcours )
-   {
-      Writethedependfile(parcours->o_nom,List_Common_Var);
-      parcours=parcours->suiv;
-   }
-   Write_Subroutine_For_Alloc();
+    /* Write the .dependglobal_agrif file which contain the max indice         */
+    /*    of the tabvars table                                                 */
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    dependglobaloutput = fopen(dependfilename, "w");
+    for (i=0;i<NB_CAT_VARIABLES;i++)
+    {
+        fprintf(dependglobaloutput,"%d\n",indicemaxtabvars[i]);
+    }
+    fclose(dependglobaloutput);
+    /* Write the list of available indice                                      */
+    Writethedependavailablefile();
+    /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
+    /*    nbmailleY and nbmailleZ                                              */
+    Writethedependnbxnbyfile();
+    /* Write the .depend<namefile> file which contain general informations     */
+    /*    about variable of this file                                          */
+    parcours = List_NameOfModule;
+    while( parcours )
+    {
+        Writethedependlistofmoduleused(parcours->o_nom);
+        WritedependParameterList(parcours->o_nom);
+        Writethedependfile(parcours->o_nom,List_Global_Var);
+        parcours=parcours->suiv;
+    }
+    parcours = List_NameOfCommon;
+    while( parcours )
+    {
+        Writethedependfile(parcours->o_nom,List_Common_Var);
+        parcours=parcours->suiv;
+    }
+    Write_Subroutine_For_Alloc();
+
 /******************************************************************************/
 /*  7-  Create files in AGRIF_INC directory                                   */
 /******************************************************************************/
-   creefichieramr(NameTamponfile);
-
-   Write_val_max();
-
-   if ( todebug == 1 ) printf("Out of CONV \n");
-   return 0;
-}
+
+    creefichieramr();
+
+    Write_val_max();
+
+    if ( todebug == 1 ) printf("Out of CONV \n");
+    return 0;
+}
+
 #line 2 "convert.yy.c"
 
@@ -2003,9 +1997,28 @@
 
 /* A lexical scanner generated by flex */
+
+#define yy_create_buffer convert__create_buffer
+#define yy_delete_buffer convert__delete_buffer
+#define yy_flex_debug convert__flex_debug
+#define yy_init_buffer convert__init_buffer
+#define yy_flush_buffer convert__flush_buffer
+#define yy_load_buffer_state convert__load_buffer_state
+#define yy_switch_to_buffer convert__switch_to_buffer
+#define yyin convert_in
+#define yyleng convert_leng
+#define yylex convert_lex
+#define yylineno convert_lineno
+#define yyout convert_out
+#define yyrestart convert_restart
+#define yytext convert_text
+#define yywrap convert_wrap
+#define yyalloc convert_alloc
+#define yyrealloc convert_realloc
+#define yyfree convert_free
 
 #define FLEX_SCANNER
 #define YY_FLEX_MAJOR_VERSION 2
 #define YY_FLEX_MINOR_VERSION 5
-#define YY_FLEX_SUBMINOR_VERSION 37
+#define YY_FLEX_SUBMINOR_VERSION 35
 #if YY_FLEX_SUBMINOR_VERSION > 0
 #define FLEX_BETA
@@ -2045,4 +2058,5 @@
 typedef int32_t flex_int32_t;
 typedef uint32_t flex_uint32_t;
+typedef uint64_t flex_uint64_t;
 #else
 typedef signed char flex_int8_t;
@@ -2052,4 +2066,5 @@
 typedef unsigned short int flex_uint16_t;
 typedef unsigned int flex_uint32_t;
+#endif /* ! C99 */
 
 /* Limits of integral types. */
@@ -2081,6 +2096,4 @@
 #define UINT32_MAX             (4294967295U)
 #endif
-
-#endif /* ! C99 */
 
 #endif /* ! FLEXINT_H */
@@ -2134,5 +2147,5 @@
 
 /* Special action meaning "start processing a new file". */
-#define YY_NEW_FILE yyrestart(yyin  )
+#define YY_NEW_FILE convert_restart(convert_in  )
 
 #define YY_END_OF_BUFFER_CHAR 0
@@ -2157,7 +2170,7 @@
 #endif
 
-extern yy_size_t yyleng;
-
-extern FILE *yyin, *yyout;
+extern yy_size_t convert_leng;
+
+extern FILE *convert_in, *convert_out;
 
 #define EOB_ACT_CONTINUE_SCAN 0
@@ -2171,5 +2184,5 @@
 	do \
 		{ \
-		/* Undo effects of setting up yytext. */ \
+		/* Undo effects of setting up convert_text. */ \
         int yyless_macro_arg = (n); \
         YY_LESS_LINENO(yyless_macro_arg);\
@@ -2177,5 +2190,5 @@
 		YY_RESTORE_YY_MORE_OFFSET \
 		(yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
-		YY_DO_BEFORE_ACTION; /* set up yytext again */ \
+		YY_DO_BEFORE_ACTION; /* set up convert_text again */ \
 		} \
 	while ( 0 )
@@ -2240,6 +2253,6 @@
 	 *
 	 * When we actually see the EOF, we change the status to "new"
-	 * (via yyrestart()), so that the user can continue scanning by
-	 * just pointing yyin at a new input file.
+	 * (via convert_restart()), so that the user can continue scanning by
+	 * just pointing convert_in at a new input file.
 	 */
 #define YY_BUFFER_EOF_PENDING 2
@@ -2268,8 +2281,8 @@
 #define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
 
-/* yy_hold_char holds the character lost when yytext is formed. */
+/* yy_hold_char holds the character lost when convert_text is formed. */
 static char yy_hold_char;
 static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
-yy_size_t yyleng;
+yy_size_t convert_leng;
 
 /* Points to current character in buffer. */
@@ -2278,39 +2291,39 @@
 static int yy_start = 0;	/* start state number */
 
-/* Flag which is used to allow yywrap()'s to do buffer switches
- * instead of setting up a fresh yyin.  A bit of a hack ...
+/* Flag which is used to allow convert_wrap()'s to do buffer switches
+ * instead of setting up a fresh convert_in.  A bit of a hack ...
  */
 static int yy_did_buffer_switch_on_eof;
 
-void yyrestart (FILE *input_file  );
-void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer  );
-YY_BUFFER_STATE yy_create_buffer (FILE *file,int size  );
-void yy_delete_buffer (YY_BUFFER_STATE b  );
-void yy_flush_buffer (YY_BUFFER_STATE b  );
-void yypush_buffer_state (YY_BUFFER_STATE new_buffer  );
-void yypop_buffer_state (void );
-
-static void yyensure_buffer_stack (void );
-static void yy_load_buffer_state (void );
-static void yy_init_buffer (YY_BUFFER_STATE b,FILE *file  );
-
-#define YY_FLUSH_BUFFER yy_flush_buffer(YY_CURRENT_BUFFER )
-
-YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size  );
-YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str  );
-YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,yy_size_t len  );
-
-void *yyalloc (yy_size_t  );
-void *yyrealloc (void *,yy_size_t  );
-void yyfree (void *  );
-
-#define yy_new_buffer yy_create_buffer
+void convert_restart (FILE *input_file  );
+void convert__switch_to_buffer (YY_BUFFER_STATE new_buffer  );
+YY_BUFFER_STATE convert__create_buffer (FILE *file,int size  );
+void convert__delete_buffer (YY_BUFFER_STATE b  );
+void convert__flush_buffer (YY_BUFFER_STATE b  );
+void convert_push_buffer_state (YY_BUFFER_STATE new_buffer  );
+void convert_pop_buffer_state (void );
+
+static void convert_ensure_buffer_stack (void );
+static void convert__load_buffer_state (void );
+static void convert__init_buffer (YY_BUFFER_STATE b,FILE *file  );
+
+#define YY_FLUSH_BUFFER convert__flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE convert__scan_buffer (char *base,yy_size_t size  );
+YY_BUFFER_STATE convert__scan_string (yyconst char *yy_str  );
+YY_BUFFER_STATE convert__scan_bytes (yyconst char *bytes,yy_size_t len  );
+
+void *convert_alloc (yy_size_t  );
+void *convert_realloc (void *,yy_size_t  );
+void convert_free (void *  );
+
+#define yy_new_buffer convert__create_buffer
 
 #define yy_set_interactive(is_interactive) \
 	{ \
 	if ( ! YY_CURRENT_BUFFER ){ \
-        yyensure_buffer_stack (); \
+        convert_ensure_buffer_stack (); \
 		YY_CURRENT_BUFFER_LVALUE =    \
-            yy_create_buffer(yyin,YY_BUF_SIZE ); \
+            convert__create_buffer(convert_in,YY_BUF_SIZE ); \
 	} \
 	YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
@@ -2320,7 +2333,7 @@
 	{ \
 	if ( ! YY_CURRENT_BUFFER ){\
-        yyensure_buffer_stack (); \
+        convert_ensure_buffer_stack (); \
 		YY_CURRENT_BUFFER_LVALUE =    \
-            yy_create_buffer(yyin,YY_BUF_SIZE ); \
+            convert__create_buffer(convert_in,YY_BUF_SIZE ); \
 	} \
 	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
@@ -2331,16 +2344,19 @@
 /* Begin user sect3 */
 
+#define convert_wrap(n) 1
+#define YY_SKIP_YYWRAP
+
 typedef unsigned char YY_CHAR;
 
-FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0;
+FILE *convert_in = (FILE *) 0, *convert_out = (FILE *) 0;
 
 typedef int yy_state_type;
 
-extern int yylineno;
-
-int yylineno = 1;
-
-extern char *yytext;
-#define yytext_ptr yytext
+extern int convert_lineno;
+
+int convert_lineno = 1;
+
+extern char *convert_text;
+#define yytext_ptr convert_text
 
 static yy_state_type yy_get_previous_state (void );
@@ -2350,15 +2366,15 @@
 
 /* Done after the current pattern has been matched and before the
- * corresponding action - sets up yytext.
+ * corresponding action - sets up convert_text.
  */
 #define YY_DO_BEFORE_ACTION \
 	(yytext_ptr) = yy_bp; \
-	yyleng = (size_t) (yy_cp - yy_bp); \
+	convert_leng = (yy_size_t) (yy_cp - yy_bp); \
 	(yy_hold_char) = *yy_cp; \
 	*yy_cp = '\0'; \
 	(yy_c_buf_p) = yy_cp;
 
-#define YY_NUM_RULES 12
-#define YY_END_OF_BUFFER 13
+#define YY_NUM_RULES 15
+#define YY_END_OF_BUFFER 16
 /* This struct is not used in this scanner,
    but its presence is necessary. */
@@ -2368,14 +2384,15 @@
 	flex_int32_t yy_nxt;
 	};
-static yyconst flex_int16_t yy_accept[77] =
+static yyconst flex_int16_t yy_accept[84] =
     {   0,
-        0,    0,    0,    0,   13,   12,   11,   10,   12,    9,
-       12,   12,   12,    9,    8,    8,    8,    8,    8,    8,
-       11,    0,    4,    7,    7,    7,    5,    8,    8,    8,
-        8,    8,    8,    8,    6,    8,    8,    8,    8,    3,
-        8,    8,    8,    8,    8,    8,    8,    8,    8,    8,
-        8,    8,    8,    8,    8,    8,    8,    8,    8,    8,
-        8,    8,    8,    8,    8,    2,    8,    8,    8,    1,
-        8,    8,    8,    8,    6,    0
+        0,    0,    0,    0,   16,   15,   14,   13,   15,   12,
+       11,   11,   11,   11,   12,    7,   10,   10,   10,   10,
+       10,   10,   10,   14,    0,    4,   11,    9,    9,    9,
+        5,   10,   10,   10,   10,   10,   10,   10,   10,    8,
+       10,   10,   10,   10,   10,    3,   10,    6,   10,   10,
+       10,   10,   10,   10,   10,   10,   10,   10,   10,   10,
+       10,   10,   10,   10,   10,   10,   10,   10,   10,   10,
+       10,   10,    2,   10,   10,   10,    1,   10,   10,   10,
+       10,    8,    0
     } ;
 
@@ -2388,12 +2405,12 @@
         6,    1,    1,    7,    1,    1,    1,    8,    9,   10,
        11,    8,    8,    8,   12,    8,    8,   13,   14,    1,
-        1,    1,    1,    1,   15,   16,   16,   17,   18,   19,
-       20,   16,   21,   16,   16,   22,   23,   24,   25,   26,
-       16,   27,   28,   29,   30,   16,   16,   31,   32,   16,
-       33,    1,   34,    1,   35,    1,   36,   16,   16,   37,
-
-       38,   39,   40,   16,   41,   16,   16,   42,   43,   44,
-       45,   46,   16,   47,   48,   49,   50,   16,   16,   51,
-       52,   16,    1,    1,    1,    1,    1,    1,    1,    1,
+       15,    1,    1,    1,   16,   17,   17,   18,   19,   20,
+       21,   17,   22,   17,   23,   24,   25,   26,   27,   28,
+       17,   29,   30,   31,   32,   17,   17,   33,   34,   17,
+       35,    1,   36,    1,   37,    1,   38,   17,   17,   39,
+
+       40,   41,   42,   17,   43,   17,   44,   45,   46,   47,
+       48,   49,   17,   50,   51,   52,   53,   17,   17,   54,
+       55,   17,    1,    1,    1,    1,    1,    1,    1,    1,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
@@ -2412,67 +2429,72 @@
     } ;
 
-static yyconst flex_int32_t yy_meta[53] =
+static yyconst flex_int32_t yy_meta[56] =
     {   0,
         1,    1,    2,    1,    1,    1,    1,    3,    3,    3,
-        3,    3,    1,    1,    3,    3,    3,    3,    3,    3,
+        3,    3,    1,    1,    1,    3,    3,    3,    3,    3,
         3,    3,    3,    3,    3,    3,    3,    3,    3,    3,
-        3,    3,    1,    1,    3,    3,    3,    3,    3,    3,
+        3,    3,    3,    3,    1,    1,    3,    3,    3,    3,
         3,    3,    3,    3,    3,    3,    3,    3,    3,    3,
-        3,    3
+        3,    3,    3,    3,    3
     } ;
 
-static yyconst flex_int16_t yy_base[79] =
+static yyconst flex_int16_t yy_base[86] =
     {   0,
-        0,    0,    0,    0,  150,  164,  147,  164,  144,  164,
-       36,   37,   38,  134,    0,   44,   32,   34,   44,   33,
-      144,  141,  140,  164,  164,  164,  164,    0,  131,   31,
-       34,   42,   39,   49,    0,   50,   49,   38,   56,    0,
-       59,   52,  107,   68,  106,   72,   75,   72,   77,   81,
-       79,   76,   75,   86,   73,   88,   85,   89,   90,   79,
-       93,   86,   99,   97,  103,    0,   37,  115,  114,    0,
-      108,  116,  121,  112,    0,  164,  160,   57
+        0,    0,    0,    0,  192,  194,  186,  194,  176,  194,
+       48,   53,   58,   69,  164,  194,    0,   60,   51,   47,
+       49,   67,   55,  173,  170,  169,   90,  194,  194,  194,
+      194,    0,  160,   53,   62,   58,   66,   62,   74,    0,
+       85,   95,   94,   82,  101,    0,  101,    0,   91,  134,
+       96,  133,  100,  103,   99,  105,  109,  106,  102,  101,
+      113,   99,  115,  113,  119,  127,  123,  139,  130,  142,
+      137,  132,    0,   81,  144,  143,    0,  136,  144,  150,
+      139,    0,  194,  190,   81
     } ;
 
-static yyconst flex_int16_t yy_def[79] =
+static yyconst flex_int16_t yy_def[86] =
     {   0,
-       76,    1,    1,    1,   76,   76,   76,   76,   77,   76,
-       76,   76,   76,   76,   78,   78,   78,   78,   78,   78,
-       76,   77,   77,   76,   76,   76,   76,   78,   78,   78,
-       78,   78,   78,   78,   78,   78,   78,   78,   78,   78,
-       78,   78,   78,   78,   78,   78,   78,   78,   78,   78,
-       78,   78,   78,   78,   78,   78,   78,   78,   78,   78,
-       78,   78,   78,   78,   78,   78,   78,   78,   78,   78,
-       78,   78,   78,   78,   78,    0,   76,   76
+       83,    1,    1,    1,   83,   83,   83,   83,   84,   83,
+       83,   83,   83,   83,   83,   83,   85,   85,   85,   85,
+       85,   85,   85,   83,   84,   84,   83,   83,   83,   83,
+       83,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,    0,   83,   83
     } ;
 
-static yyconst flex_int16_t yy_nxt[217] =
+static yyconst flex_int16_t yy_nxt[250] =
     {   0,
-        6,    7,    8,    9,   10,   10,   10,    6,   11,   12,
-       13,    6,   14,   10,   15,   15,   15,   15,   16,   15,
-       15,   15,   15,   17,   18,   19,   15,   15,   15,   20,
-       15,   15,   10,   10,   15,   15,   15,   15,   16,   15,
-       15,   15,   15,   17,   18,   19,   15,   15,   15,   20,
-       15,   15,   24,   25,   26,   29,   31,   32,   33,   28,
-       34,   36,   37,   38,   30,   39,   40,   41,   42,   43,
-       44,   69,   24,   25,   26,   45,   31,   32,   46,   33,
-       34,   36,   37,   38,   30,   39,   40,   41,   42,   43,
-       48,   44,   50,   51,   52,   45,   53,   54,   46,   55,
-
-       56,   57,   58,   59,   60,   61,   62,   63,   64,   65,
-       48,   66,   50,   51,   52,   67,   53,   54,   68,   55,
-       56,   57,   58,   59,   60,   61,   62,   63,   64,   65,
-       35,   66,   70,   71,   72,   67,   73,   74,   68,   75,
-       49,   47,   35,   23,   23,   21,   27,   23,   21,   76,
-       35,   76,   70,   71,   72,   76,   73,   74,   76,   75,
-       22,   76,   22,    5,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76
+        6,    7,    8,    9,   10,   10,   10,   11,   12,   13,
+       14,   11,   15,   10,   16,   17,   17,   17,   17,   18,
+       17,   17,   19,   17,   17,   20,   21,   22,   17,   17,
+       17,   23,   17,   17,   10,   10,   17,   17,   17,   17,
+       18,   17,   17,   19,   17,   17,   20,   21,   22,   17,
+       17,   17,   23,   17,   17,   27,   27,   27,   27,   27,
+       27,   27,   27,   27,   27,   27,   27,   27,   27,   27,
+       28,   33,   35,   36,   37,   29,   27,   27,   27,   27,
+       27,   34,   38,   32,   39,   41,   30,   42,   43,   44,
+       45,   28,   46,   35,   36,   37,   29,   27,   27,   27,
+
+       27,   27,   34,   47,   38,   39,   41,   30,   42,   43,
+       44,   45,   48,   46,   49,   50,   51,   76,   52,   53,
+       55,   57,   58,   59,   47,   60,   61,   62,   63,   64,
+       65,   66,   67,   48,   68,   49,   50,   69,   51,   52,
+       53,   55,   57,   58,   59,   70,   60,   61,   62,   63,
+       64,   65,   66,   67,   71,   68,   72,   73,   69,   74,
+       75,   40,   77,   78,   79,   80,   70,   81,   82,   56,
+       54,   40,   26,   26,   24,   71,   31,   72,   73,   26,
+       74,   75,   40,   77,   78,   79,   80,   24,   81,   82,
+       25,   83,   25,    5,   83,   83,   83,   83,   83,   83,
+
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83
     } ;
 
-static yyconst flex_int16_t yy_chk[217] =
+static yyconst flex_int16_t yy_chk[250] =
     {   0,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
@@ -2481,23 +2503,26 @@
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
         1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
-        1,    1,   11,   12,   13,   16,   17,   18,   19,   78,
-       20,   30,   31,   32,   16,   33,   34,   36,   37,   38,
-       39,   67,   11,   12,   13,   41,   17,   18,   42,   19,
-       20,   30,   31,   32,   16,   33,   34,   36,   37,   38,
-       44,   39,   46,   47,   48,   41,   49,   50,   42,   51,
-
-       52,   53,   54,   55,   56,   57,   58,   59,   60,   61,
-       44,   62,   46,   47,   48,   63,   49,   50,   64,   51,
-       52,   53,   54,   55,   56,   57,   58,   59,   60,   61,
-       65,   62,   68,   69,   71,   63,   72,   73,   64,   74,
-       45,   43,   29,   23,   22,   21,   14,    9,    7,    5,
-       65,    0,   68,   69,   71,    0,   72,   73,    0,   74,
-       77,    0,   77,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-
-       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
-       76,   76,   76,   76,   76,   76
+        1,    1,    1,    1,    1,   11,   11,   11,   11,   11,
+       12,   12,   12,   12,   12,   13,   13,   13,   13,   13,
+       12,   18,   19,   20,   21,   13,   14,   14,   14,   14,
+       14,   18,   22,   85,   23,   34,   14,   35,   36,   37,
+       38,   12,   39,   19,   20,   21,   13,   27,   27,   27,
+
+       27,   27,   18,   41,   22,   23,   34,   14,   35,   36,
+       37,   38,   42,   39,   43,   44,   45,   74,   47,   49,
+       51,   53,   54,   55,   41,   56,   57,   58,   59,   60,
+       61,   62,   63,   42,   64,   43,   44,   65,   45,   47,
+       49,   51,   53,   54,   55,   66,   56,   57,   58,   59,
+       60,   61,   62,   63,   67,   64,   68,   69,   65,   70,
+       71,   72,   75,   76,   78,   79,   66,   80,   81,   52,
+       50,   33,   26,   25,   24,   67,   15,   68,   69,    9,
+       70,   71,   72,   75,   76,   78,   79,    7,   80,   81,
+       84,    5,   84,   83,   83,   83,   83,   83,   83,   83,
+
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83
     } ;
 
@@ -2505,6 +2530,6 @@
 static char *yy_last_accepting_cpos;
 
-extern int yy_flex_debug;
-int yy_flex_debug = 0;
+extern int convert__flex_debug;
+int convert__flex_debug = 0;
 
 /* The intent behind this definition is that it'll catch
@@ -2515,5 +2540,5 @@
 #define YY_MORE_ADJ 0
 #define YY_RESTORE_YY_MORE_OFFSET
-char *yytext;
+char *convert_text;
 #line 1 "convert.lex"
 /******************************************************************************/
@@ -2552,13 +2577,11 @@
 /******************************************************************************/
 
-#line 37 "convert.lex"
+#line 40 "convert.lex"
 #include <math.h>
 #include <stdlib.h>
 #include <string.h>
-int line_num=1;
-extern FILE * yyin;
-#define MAX_INCLUDE_DEPTH 30
-YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
-#line 566 "convert.yy.c"
+
+#define YY_NO_INPUT
+#line 595 "convert.yy.c"
 
 #define INITIAL 0
@@ -2582,29 +2605,29 @@
    These are made visible to non-reentrant scanners for convenience. */
 
-int yylex_destroy (void );
-
-int yyget_debug (void );
-
-void yyset_debug (int debug_flag  );
-
-YY_EXTRA_TYPE yyget_extra (void );
-
-void yyset_extra (YY_EXTRA_TYPE user_defined  );
-
-FILE *yyget_in (void );
-
-void yyset_in  (FILE * in_str  );
-
-FILE *yyget_out (void );
-
-void yyset_out  (FILE * out_str  );
-
-yy_size_t yyget_leng (void );
-
-char *yyget_text (void );
-
-int yyget_lineno (void );
-
-void yyset_lineno (int line_number  );
+int convert_lex_destroy (void );
+
+int convert_get_debug (void );
+
+void convert_set_debug (int debug_flag  );
+
+YY_EXTRA_TYPE convert_get_extra (void );
+
+void convert_set_extra (YY_EXTRA_TYPE user_defined  );
+
+FILE *convert_get_in (void );
+
+void convert_set_in  (FILE * in_str  );
+
+FILE *convert_get_out (void );
+
+void convert_set_out  (FILE * out_str  );
+
+yy_size_t convert_get_leng (void );
+
+char *convert_get_text (void );
+
+int convert_get_lineno (void );
+
+void convert_set_lineno (int line_number  );
 
 /* Macros after this point can all be overridden by user definitions in
@@ -2614,7 +2637,7 @@
 #ifndef YY_SKIP_YYWRAP
 #ifdef __cplusplus
-extern "C" int yywrap (void );
+extern "C" int convert_wrap (void );
 #else
-extern int yywrap (void );
+extern int convert_wrap (void );
 #endif
 #endif
@@ -2650,5 +2673,5 @@
  * we now use fwrite().
  */
-#define ECHO do { if (fwrite( yytext, yyleng, 1, yyout )) {} } while (0)
+#define ECHO fwrite( convert_text, convert_leng, 1, convert_out )
 #endif
 
@@ -2661,11 +2684,11 @@
 		{ \
 		int c = '*'; \
-		size_t n; \
+		yy_size_t n; \
 		for ( n = 0; n < max_size && \
-			     (c = getc( yyin )) != EOF && c != '\n'; ++n ) \
+			     (c = getc( convert_in )) != EOF && c != '\n'; ++n ) \
 			buf[n] = (char) c; \
 		if ( c == '\n' ) \
 			buf[n++] = (char) c; \
-		if ( c == EOF && ferror( yyin ) ) \
+		if ( c == EOF && ferror( convert_in ) ) \
 			YY_FATAL_ERROR( "input in flex scanner failed" ); \
 		result = n; \
@@ -2674,5 +2697,5 @@
 		{ \
 		errno=0; \
-		while ( (result = fread(buf, 1, max_size, yyin))==0 && ferror(yyin)) \
+		while ( (result = fread(buf, 1, max_size, convert_in))==0 && ferror(convert_in)) \
 			{ \
 			if( errno != EINTR) \
@@ -2682,5 +2705,5 @@
 				} \
 			errno=0; \
-			clearerr(yyin); \
+			clearerr(convert_in); \
 			} \
 		}\
@@ -2715,10 +2738,10 @@
 #define YY_DECL_IS_OURS 1
 
-extern int yylex (void);
-
-#define YY_DECL int yylex (void)
+extern int convert_lex (void);
+
+#define YY_DECL int convert_lex (void)
 #endif /* !YY_DECL */
 
-/* Code executed at the beginning of each rule, after yytext and yyleng
+/* Code executed at the beginning of each rule, after convert_text and convert_leng
  * have been set up.
  */
@@ -2743,7 +2766,7 @@
 	register int yy_act;
     
-#line 55 "convert.lex"
-
-#line 751 "convert.yy.c"
+#line 54 "convert.lex"
+
+#line 780 "convert.yy.c"
 
 	if ( !(yy_init) )
@@ -2758,17 +2781,17 @@
 			(yy_start) = 1;	/* first start state */
 
-		if ( ! yyin )
-			yyin = stdin;
-
-		if ( ! yyout )
-			yyout = stdout;
+		if ( ! convert_in )
+			convert_in = stdin;
+
+		if ( ! convert_out )
+			convert_out = stdout;
 
 		if ( ! YY_CURRENT_BUFFER ) {
-			yyensure_buffer_stack ();
+			convert_ensure_buffer_stack ();
 			YY_CURRENT_BUFFER_LVALUE =
-				yy_create_buffer(yyin,YY_BUF_SIZE );
+				convert__create_buffer(convert_in,YY_BUF_SIZE );
 		}
 
-		yy_load_buffer_state( );
+		convert__load_buffer_state( );
 		}
 
@@ -2777,5 +2800,5 @@
 		yy_cp = (yy_c_buf_p);
 
-		/* Support of yytext. */
+		/* Support of convert_text. */
 		*yy_cp = (yy_hold_char);
 
@@ -2798,5 +2821,5 @@
 				{
 				yy_current_state = (int) yy_def[yy_current_state];
-				if ( yy_current_state >= 77 )
+				if ( yy_current_state >= 84 )
 					yy_c = yy_meta[(unsigned int) yy_c];
 				}
@@ -2804,5 +2827,5 @@
 			++yy_cp;
 			}
-		while ( yy_base[yy_current_state] != 164 );
+		while ( yy_base[yy_current_state] != 194 );
 
 yy_find_action:
@@ -2830,65 +2853,79 @@
 case 1:
 YY_RULE_SETUP
-#line 56 "convert.lex"
-return TOK_MODULEMAIN; /* name of the module                      */
+#line 55 "convert.lex"
+{ return TOK_MODULEMAIN; } /* name of the module                      */
 	YY_BREAK
 case 2:
 YY_RULE_SETUP
-#line 57 "convert.lex"
-return TOK_NOTGRIDDEP; /* variable which are not grid dependent   */
+#line 56 "convert.lex"
+{ return TOK_NOTGRIDDEP; } /* variable which are not grid dependent   */
 	YY_BREAK
 case 3:
 YY_RULE_SETUP
-#line 58 "convert.lex"
-return TOK_USE;
+#line 57 "convert.lex"
+{ return TOK_USE; }
 	YY_BREAK
 case 4:
 YY_RULE_SETUP
-#line 59 "convert.lex"
-{}
+#line 58 "convert.lex"
+{ }
 	YY_BREAK
 case 5:
 YY_RULE_SETUP
-#line 60 "convert.lex"
-return TOK_SEP;
+#line 59 "convert.lex"
+{ return TOK_SEP; }
 	YY_BREAK
 case 6:
 YY_RULE_SETUP
-#line 61 "convert.lex"
-{strcpy(yylval.na,yytext); return TOK_USEITEM;}
+#line 60 "convert.lex"
+{ return TOK_KIND; }
 	YY_BREAK
 case 7:
 YY_RULE_SETUP
-#line 62 "convert.lex"
-{strcpy(yylval.na,yytext); return TOK_PROBTYPE;}
+#line 61 "convert.lex"
+{ return TOK_EQUAL; }
 	YY_BREAK
-/* dimension of the problem                */
 case 8:
 YY_RULE_SETUP
-#line 64 "convert.lex"
-{strcpy(yylval.na,yytext); return TOK_NAME;}
+#line 62 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_USEITEM;  }
 	YY_BREAK
 case 9:
 YY_RULE_SETUP
-#line 65 "convert.lex"
-{return (int) *yytext;}
+#line 63 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_PROBTYPE; }  /* dimension of the problem */
 	YY_BREAK
 case 10:
-/* rule 10 can match eol */
 YY_RULE_SETUP
-#line 66 "convert.lex"
-{line_num++;return (int) *yytext;}
+#line 64 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_NAME; }
 	YY_BREAK
 case 11:
 YY_RULE_SETUP
-#line 67 "convert.lex"
-;
+#line 65 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_CSTINT; }
 	YY_BREAK
 case 12:
 YY_RULE_SETUP
+#line 66 "convert.lex"
+{ return (int) *convert_text; }
+	YY_BREAK
+case 13:
+/* rule 13 can match eol */
+YY_RULE_SETUP
+#line 67 "convert.lex"
+{ line_num++; return (int) *convert_text; }
+	YY_BREAK
+case 14:
+YY_RULE_SETUP
 #line 68 "convert.lex"
+;
+	YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 69 "convert.lex"
 ECHO;
 	YY_BREAK
-#line 896 "convert.yy.c"
+#line 939 "convert.yy.c"
 case YY_STATE_EOF(INITIAL):
 case YY_STATE_EOF(character):
@@ -2908,6 +2945,6 @@
 			/* We're scanning a new file or input source.  It's
 			 * possible that this happened because the user
-			 * just pointed yyin at a new source and called
-			 * yylex().  If so, then we have to assure
+			 * just pointed convert_in at a new source and called
+			 * convert_lex().  If so, then we have to assure
 			 * consistency between YY_CURRENT_BUFFER and our
 			 * globals.  Here is the right place to do so, because
@@ -2916,5 +2953,5 @@
 			 */
 			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
-			YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin;
+			YY_CURRENT_BUFFER_LVALUE->yy_input_file = convert_in;
 			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
 			}
@@ -2969,9 +3006,9 @@
 				(yy_did_buffer_switch_on_eof) = 0;
 
-				if ( yywrap( ) )
+				if ( convert_wrap( ) )
 					{
 					/* Note: because we've taken care in
 					 * yy_get_next_buffer() to have set up
-					 * yytext, we can now set up
+					 * convert_text, we can now set up
 					 * yy_c_buf_p so that if some total
 					 * hoser (like flex itself) wants to
@@ -3022,5 +3059,5 @@
 	} /* end of action switch */
 		} /* end of scanning one token */
-} /* end of yylex */
+} /* end of convert_lex */
 
 /* yy_get_next_buffer - try to read in a new buffer
@@ -3084,5 +3121,5 @@
 
 			/* just a shorter name for the current buffer */
-			YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE;
+			YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
 
 			int yy_c_buf_p_offset =
@@ -3100,5 +3137,5 @@
 				b->yy_ch_buf = (char *)
 					/* Include room in for 2 EOB chars. */
-					yyrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
+					convert_realloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
 				}
 			else
@@ -3132,5 +3169,5 @@
 			{
 			ret_val = EOB_ACT_END_OF_FILE;
-			yyrestart(yyin  );
+			convert_restart(convert_in  );
 			}
 
@@ -3149,5 +3186,5 @@
 		/* Extend the array by 50%, plus the number we really need. */
 		yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
-		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
+		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) convert_realloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
 		if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
 			YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
@@ -3183,5 +3220,5 @@
 			{
 			yy_current_state = (int) yy_def[yy_current_state];
-			if ( yy_current_state >= 77 )
+			if ( yy_current_state >= 84 )
 				yy_c = yy_meta[(unsigned int) yy_c];
 			}
@@ -3211,11 +3248,11 @@
 		{
 		yy_current_state = (int) yy_def[yy_current_state];
-		if ( yy_current_state >= 77 )
+		if ( yy_current_state >= 84 )
 			yy_c = yy_meta[(unsigned int) yy_c];
 		}
 	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
-	yy_is_jam = (yy_current_state == 76);
-
-		return yy_is_jam ? 0 : yy_current_state;
+	yy_is_jam = (yy_current_state == 83);
+
+	return yy_is_jam ? 0 : yy_current_state;
 }
 
@@ -3226,5 +3263,5 @@
     yy_cp = (yy_c_buf_p);
 
-	/* undo effects of setting up yytext */
+	/* undo effects of setting up convert_text */
 	*yy_cp = (yy_hold_char);
 
@@ -3298,5 +3335,5 @@
 
 					/* Reset buffer status. */
-					yyrestart(yyin );
+					convert_restart(convert_in );
 
 					/*FALLTHROUGH*/
@@ -3304,6 +3341,6 @@
 				case EOB_ACT_END_OF_FILE:
 					{
-					if ( yywrap( ) )
-						return EOF;
+					if ( convert_wrap( ) )
+						return 0;
 
 					if ( ! (yy_did_buffer_switch_on_eof) )
@@ -3324,5 +3361,5 @@
 
 	c = *(unsigned char *) (yy_c_buf_p);	/* cast for 8-bit char's */
-	*(yy_c_buf_p) = '\0';	/* preserve yytext */
+	*(yy_c_buf_p) = '\0';	/* preserve convert_text */
 	(yy_hold_char) = *++(yy_c_buf_p);
 
@@ -3336,15 +3373,15 @@
  * @note This function does not reset the start condition to @c INITIAL .
  */
-    void yyrestart  (FILE * input_file )
+    void convert_restart  (FILE * input_file )
 {
     
 	if ( ! YY_CURRENT_BUFFER ){
-        yyensure_buffer_stack ();
+        convert_ensure_buffer_stack ();
 		YY_CURRENT_BUFFER_LVALUE =
-            yy_create_buffer(yyin,YY_BUF_SIZE );
+            convert__create_buffer(convert_in,YY_BUF_SIZE );
 	}
 
-	yy_init_buffer(YY_CURRENT_BUFFER,input_file );
-	yy_load_buffer_state( );
+	convert__init_buffer(YY_CURRENT_BUFFER,input_file );
+	convert__load_buffer_state( );
 }
 
@@ -3353,13 +3390,13 @@
  * 
  */
-    void yy_switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
+    void convert__switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
 {
     
 	/* TODO. We should be able to replace this entire function body
 	 * with
-	 *		yypop_buffer_state();
-	 *		yypush_buffer_state(new_buffer);
+	 *		convert_pop_buffer_state();
+	 *		convert_push_buffer_state(new_buffer);
      */
-	yyensure_buffer_stack ();
+	convert_ensure_buffer_stack ();
 	if ( YY_CURRENT_BUFFER == new_buffer )
 		return;
@@ -3374,9 +3411,9 @@
 
 	YY_CURRENT_BUFFER_LVALUE = new_buffer;
-	yy_load_buffer_state( );
+	convert__load_buffer_state( );
 
 	/* We don't actually know whether we did this switch during
-	 * EOF (yywrap()) processing, but the only time this flag
-	 * is looked at is after yywrap() is called, so it's safe
+	 * EOF (convert_wrap()) processing, but the only time this flag
+	 * is looked at is after convert_wrap() is called, so it's safe
 	 * to go ahead and always set it.
 	 */
@@ -3384,9 +3421,9 @@
 }
 
-static void yy_load_buffer_state  (void)
+static void convert__load_buffer_state  (void)
 {
     	(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
 	(yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
-	yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+	convert_in = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
 	(yy_hold_char) = *(yy_c_buf_p);
 }
@@ -3398,11 +3435,11 @@
  * @return the allocated buffer state.
  */
-    YY_BUFFER_STATE yy_create_buffer  (FILE * file, int  size )
+    YY_BUFFER_STATE convert__create_buffer  (FILE * file, int  size )
 {
 	YY_BUFFER_STATE b;
     
-	b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state )  );
+	b = (YY_BUFFER_STATE) convert_alloc(sizeof( struct yy_buffer_state )  );
 	if ( ! b )
-		YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+		YY_FATAL_ERROR( "out of dynamic memory in convert__create_buffer()" );
 
 	b->yy_buf_size = size;
@@ -3411,11 +3448,11 @@
 	 * we need to put in 2 end-of-buffer characters.
 	 */
-	b->yy_ch_buf = (char *) yyalloc(b->yy_buf_size + 2  );
+	b->yy_ch_buf = (char *) convert_alloc(b->yy_buf_size + 2  );
 	if ( ! b->yy_ch_buf )
-		YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+		YY_FATAL_ERROR( "out of dynamic memory in convert__create_buffer()" );
 
 	b->yy_is_our_buffer = 1;
 
-	yy_init_buffer(b,file );
+	convert__init_buffer(b,file );
 
 	return b;
@@ -3423,8 +3460,8 @@
 
 /** Destroy the buffer.
- * @param b a buffer created with yy_create_buffer()
+ * @param b a buffer created with convert__create_buffer()
  * 
  */
-    void yy_delete_buffer (YY_BUFFER_STATE  b )
+    void convert__delete_buffer (YY_BUFFER_STATE  b )
 {
     
@@ -3436,25 +3473,29 @@
 
 	if ( b->yy_is_our_buffer )
-		yyfree((void *) b->yy_ch_buf  );
-
-	yyfree((void *) b  );
-}
-
+		convert_free((void *) b->yy_ch_buf  );
+
+	convert_free((void *) b  );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+    
 /* Initializes or reinitializes a buffer.
  * This function is sometimes called more than once on the same buffer,
- * such as during a yyrestart() or at EOF.
+ * such as during a convert_restart() or at EOF.
  */
-    static void yy_init_buffer  (YY_BUFFER_STATE  b, FILE * file )
+    static void convert__init_buffer  (YY_BUFFER_STATE  b, FILE * file )
 
 {
 	int oerrno = errno;
     
-	yy_flush_buffer(b );
+	convert__flush_buffer(b );
 
 	b->yy_input_file = file;
 	b->yy_fill_buffer = 1;
 
-    /* If b is the current buffer, then yy_init_buffer was _probably_
-     * called from yyrestart() or through yy_get_next_buffer.
+    /* If b is the current buffer, then convert__init_buffer was _probably_
+     * called from convert_restart() or through yy_get_next_buffer.
      * In that case, we don't want to reset the lineno or column.
      */
@@ -3473,5 +3514,5 @@
  * 
  */
-    void yy_flush_buffer (YY_BUFFER_STATE  b )
+    void convert__flush_buffer (YY_BUFFER_STATE  b )
 {
     	if ( ! b )
@@ -3493,5 +3534,5 @@
 
 	if ( b == YY_CURRENT_BUFFER )
-		yy_load_buffer_state( );
+		convert__load_buffer_state( );
 }
 
@@ -3502,12 +3543,12 @@
  *  
  */
-void yypush_buffer_state (YY_BUFFER_STATE new_buffer )
+void convert_push_buffer_state (YY_BUFFER_STATE new_buffer )
 {
     	if (new_buffer == NULL)
 		return;
 
-	yyensure_buffer_stack();
-
-	/* This block is copied from yy_switch_to_buffer. */
+	convert_ensure_buffer_stack();
+
+	/* This block is copied from convert__switch_to_buffer. */
 	if ( YY_CURRENT_BUFFER )
 		{
@@ -3523,6 +3564,6 @@
 	YY_CURRENT_BUFFER_LVALUE = new_buffer;
 
-	/* copied from yy_switch_to_buffer. */
-	yy_load_buffer_state( );
+	/* copied from convert__switch_to_buffer. */
+	convert__load_buffer_state( );
 	(yy_did_buffer_switch_on_eof) = 1;
 }
@@ -3532,10 +3573,10 @@
  *  
  */
-void yypop_buffer_state (void)
+void convert_pop_buffer_state (void)
 {
     	if (!YY_CURRENT_BUFFER)
 		return;
 
-	yy_delete_buffer(YY_CURRENT_BUFFER );
+	convert__delete_buffer(YY_CURRENT_BUFFER );
 	YY_CURRENT_BUFFER_LVALUE = NULL;
 	if ((yy_buffer_stack_top) > 0)
@@ -3543,5 +3584,5 @@
 
 	if (YY_CURRENT_BUFFER) {
-		yy_load_buffer_state( );
+		convert__load_buffer_state( );
 		(yy_did_buffer_switch_on_eof) = 1;
 	}
@@ -3551,5 +3592,5 @@
  *  Guarantees space for at least one push.
  */
-static void yyensure_buffer_stack (void)
+static void convert_ensure_buffer_stack (void)
 {
 	yy_size_t num_to_alloc;
@@ -3562,9 +3603,9 @@
          */
 		num_to_alloc = 1;
-		(yy_buffer_stack) = (struct yy_buffer_state**)yyalloc
+		(yy_buffer_stack) = (struct yy_buffer_state**)convert_alloc
 								(num_to_alloc * sizeof(struct yy_buffer_state*)
 								);
 		if ( ! (yy_buffer_stack) )
-			YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );
+			YY_FATAL_ERROR( "out of dynamic memory in convert_ensure_buffer_stack()" );
 								  
 		memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
@@ -3581,10 +3622,10 @@
 
 		num_to_alloc = (yy_buffer_stack_max) + grow_size;
-		(yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc
+		(yy_buffer_stack) = (struct yy_buffer_state**)convert_realloc
 								((yy_buffer_stack),
 								num_to_alloc * sizeof(struct yy_buffer_state*)
 								);
 		if ( ! (yy_buffer_stack) )
-			YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );
+			YY_FATAL_ERROR( "out of dynamic memory in convert_ensure_buffer_stack()" );
 
 		/* zero only the new slots.*/
@@ -3600,5 +3641,5 @@
  * @return the newly allocated buffer state object. 
  */
-YY_BUFFER_STATE yy_scan_buffer  (char * base, yy_size_t  size )
+YY_BUFFER_STATE convert__scan_buffer  (char * base, yy_size_t  size )
 {
 	YY_BUFFER_STATE b;
@@ -3610,7 +3651,7 @@
 		return 0;
 
-	b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state )  );
+	b = (YY_BUFFER_STATE) convert_alloc(sizeof( struct yy_buffer_state )  );
 	if ( ! b )
-		YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );
+		YY_FATAL_ERROR( "out of dynamic memory in convert__scan_buffer()" );
 
 	b->yy_buf_size = size - 2;	/* "- 2" to take care of EOB's */
@@ -3624,10 +3665,10 @@
 	b->yy_buffer_status = YY_BUFFER_NEW;
 
-	yy_switch_to_buffer(b  );
+	convert__switch_to_buffer(b  );
 
 	return b;
 }
 
-/** Setup the input buffer state to scan a string. The next call to yylex() will
+/** Setup the input buffer state to scan a string. The next call to convert_lex() will
  * scan from a @e copy of @a str.
  * @param yystr a NUL-terminated string to scan
@@ -3635,31 +3676,30 @@
  * @return the newly allocated buffer state object.
  * @note If you want to scan bytes that may contain NUL values, then use
- *       yy_scan_bytes() instead.
+ *       convert__scan_bytes() instead.
  */
-YY_BUFFER_STATE yy_scan_string (yyconst char * yystr )
+YY_BUFFER_STATE convert__scan_string (yyconst char * yystr )
 {
     
-	return yy_scan_bytes(yystr,strlen(yystr) );
-}
-
-/** Setup the input buffer state to scan the given bytes. The next call to yylex() will
+	return convert__scan_bytes(yystr,strlen(yystr) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to convert_lex() will
  * scan from a @e copy of @a bytes.
- * @param yybytes the byte buffer to scan
- * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes.
+ * @param bytes the byte buffer to scan
+ * @param len the number of bytes in the buffer pointed to by @a bytes.
  * 
  * @return the newly allocated buffer state object.
  */
-YY_BUFFER_STATE yy_scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
+YY_BUFFER_STATE convert__scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
 {
 	YY_BUFFER_STATE b;
 	char *buf;
-	yy_size_t n;
-	int i;
+	yy_size_t n, i;
     
 	/* Get memory for full buffer, including space for trailing EOB's. */
 	n = _yybytes_len + 2;
-	buf = (char *) yyalloc(n  );
+	buf = (char *) convert_alloc(n  );
 	if ( ! buf )
-		YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );
+		YY_FATAL_ERROR( "out of dynamic memory in convert__scan_bytes()" );
 
 	for ( i = 0; i < _yybytes_len; ++i )
@@ -3668,7 +3708,7 @@
 	buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
 
-	b = yy_scan_buffer(buf,n );
+	b = convert__scan_buffer(buf,n );
 	if ( ! b )
-		YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );
+		YY_FATAL_ERROR( "bad buffer in convert__scan_bytes()" );
 
 	/* It's okay to grow etc. this buffer, and we should throw it
@@ -3696,12 +3736,12 @@
 	do \
 		{ \
-		/* Undo effects of setting up yytext. */ \
+		/* Undo effects of setting up convert_text. */ \
         int yyless_macro_arg = (n); \
         YY_LESS_LINENO(yyless_macro_arg);\
-		yytext[yyleng] = (yy_hold_char); \
-		(yy_c_buf_p) = yytext + yyless_macro_arg; \
+		convert_text[convert_leng] = (yy_hold_char); \
+		(yy_c_buf_p) = convert_text + yyless_macro_arg; \
 		(yy_hold_char) = *(yy_c_buf_p); \
 		*(yy_c_buf_p) = '\0'; \
-		yyleng = yyless_macro_arg; \
+		convert_leng = yyless_macro_arg; \
 		} \
 	while ( 0 )
@@ -3712,8 +3752,8 @@
  * 
  */
-int yyget_lineno  (void)
+int convert_get_lineno  (void)
 {
         
-    return yylineno;
+    return convert_lineno;
 }
 
@@ -3721,7 +3761,7 @@
  * 
  */
-FILE *yyget_in  (void)
-{
-        return yyin;
+FILE *convert_get_in  (void)
+{
+        return convert_in;
 }
 
@@ -3729,7 +3769,7 @@
  * 
  */
-FILE *yyget_out  (void)
-{
-        return yyout;
+FILE *convert_get_out  (void)
+{
+        return convert_out;
 }
 
@@ -3737,7 +3777,7 @@
  * 
  */
-yy_size_t yyget_leng  (void)
-{
-        return yyleng;
+yy_size_t convert_get_leng  (void)
+{
+        return convert_leng;
 }
 
@@ -3746,7 +3786,7 @@
  */
 
-char *yyget_text  (void)
-{
-        return yytext;
+char *convert_get_text  (void)
+{
+        return convert_text;
 }
 
@@ -3755,8 +3795,8 @@
  * 
  */
-void yyset_lineno (int  line_number )
+void convert_set_lineno (int  line_number )
 {
     
-    yylineno = line_number;
+    convert_lineno = line_number;
 }
 
@@ -3765,24 +3805,24 @@
  * @param in_str A readable stream.
  * 
- * @see yy_switch_to_buffer
+ * @see convert__switch_to_buffer
  */
-void yyset_in (FILE *  in_str )
-{
-        yyin = in_str ;
-}
-
-void yyset_out (FILE *  out_str )
-{
-        yyout = out_str ;
-}
-
-int yyget_debug  (void)
-{
-        return yy_flex_debug;
-}
-
-void yyset_debug (int  bdebug )
-{
-        yy_flex_debug = bdebug ;
+void convert_set_in (FILE *  in_str )
+{
+        convert_in = in_str ;
+}
+
+void convert_set_out (FILE *  out_str )
+{
+        convert_out = out_str ;
+}
+
+int convert_get_debug  (void)
+{
+        return convert__flex_debug;
+}
+
+void convert_set_debug (int  bdebug )
+{
+        convert__flex_debug = bdebug ;
 }
 
@@ -3790,5 +3830,5 @@
 {
         /* Initialization is the same as for the non-reentrant scanner.
-     * This function is called from yylex_destroy(), so don't allocate here.
+     * This function is called from convert_lex_destroy(), so don't allocate here.
      */
 
@@ -3802,34 +3842,34 @@
 /* Defined in main.c */
 #ifdef YY_STDINIT
-    yyin = stdin;
-    yyout = stdout;
+    convert_in = stdin;
+    convert_out = stdout;
 #else
-    yyin = (FILE *) 0;
-    yyout = (FILE *) 0;
+    convert_in = (FILE *) 0;
+    convert_out = (FILE *) 0;
 #endif
 
     /* For future reference: Set errno on error, since we are called by
-     * yylex_init()
+     * convert_lex_init()
      */
     return 0;
 }
 
-/* yylex_destroy is for both reentrant and non-reentrant scanners. */
-int yylex_destroy  (void)
+/* convert_lex_destroy is for both reentrant and non-reentrant scanners. */
+int convert_lex_destroy  (void)
 {
     
     /* Pop the buffer stack, destroying each element. */
 	while(YY_CURRENT_BUFFER){
-		yy_delete_buffer(YY_CURRENT_BUFFER  );
+		convert__delete_buffer(YY_CURRENT_BUFFER  );
 		YY_CURRENT_BUFFER_LVALUE = NULL;
-		yypop_buffer_state();
+		convert_pop_buffer_state();
 	}
 
 	/* Destroy the stack itself. */
-	yyfree((yy_buffer_stack) );
+	convert_free((yy_buffer_stack) );
 	(yy_buffer_stack) = NULL;
 
     /* Reset the globals. This is important in a non-reentrant scanner so the next time
-     * yylex() is called, initialization will occur. */
+     * convert_lex() is called, initialization will occur. */
     yy_init_globals( );
 
@@ -3861,10 +3901,10 @@
 #endif
 
-void *yyalloc (yy_size_t  size )
+void *convert_alloc (yy_size_t  size )
 {
 	return (void *) malloc( size );
 }
 
-void *yyrealloc  (void * ptr, yy_size_t  size )
+void *convert_realloc  (void * ptr, yy_size_t  size )
 {
 	/* The cast to (char *) in the following accommodates both
@@ -3878,32 +3918,13 @@
 }
 
-void yyfree (void * ptr )
-{
-	free( (char *) ptr );	/* see yyrealloc() for (char *) cast */
+void convert_free (void * ptr )
+{
+	free( (char *) ptr );	/* see convert_realloc() for (char *) cast */
 }
 
 #define YYTABLES_NAME "yytables"
 
-#line 68 "convert.lex"
-
-
-
-
-int yywrap()
-{
-}
-
-
-yyerror(char *s)
-{
-if (!strcasecmp(curfile,mainfile))
-{
-   printf("Dans convert %s line %d, fichier %s\n",s,line_num,curfile);
-}
-else
-{
-   printf("Dans convert %s line %d, fichier %s\n",s,line_num,curfile);
-}
-exit(0);
-}
-
+#line 69 "convert.lex"
+
+
+
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/run
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/run	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/run	(revision 5682)
@@ -1,2 +1,2 @@
-gmake -f Makefile.lex clean
-gmake -f Makefile.lex
+make -f Makefile.lex clean
+make -f Makefile.lex
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c	(revision 5682)
@@ -37,288 +37,224 @@
 #include <string.h>
 #include "decl.h"
-char lvargridname[LONG_4C];
-char lvargridname2[LONG_4C];
-
-
-/******************************************************************************/
-/*                       variablenameroottabvars                              */
+
+const char * tabvarsname(const variable *var)
+{
+    static char * tname[5] = {
+        "tabvars",      // v_catvar == 0
+        "tabvars_c",    // v_catvar == 1
+        "tabvars_r",    // v_catvar == 2
+        "tabvars_l",    // v_catvar == 3
+        "tabvars_i"     // v_catvar == 4
+    };
+    return tname[var->v_catvar];    // v_catvar should never be ouside the range [0:4].
+}
+
+/******************************************************************************/
+/*                        variablecurgridtabvars                              */
 /******************************************************************************/
 /* This subroutine is used to create the string                               */
 /******************************************************************************/
 /*                                                                            */
-/*  ----------->  Agrif_Mygrid % tabvars (i) % var                            */
-/*                                                                            */
-/******************************************************************************/
-char *variablenameroottabvars (variable * var)
-{
-  char *ligne;
-
-  ligne = (char *) malloc (LONG_C * sizeof (char));
-  sprintf (ligne, "Agrif_Mygrid %% tabvars(%d) %% var ", var->v_indicetabvars);
-  return ligne;
-}
-
-
-/******************************************************************************/
-/*                        variablenametabvars                                 */
+/*  ----------->  Agrif_Curgrid % tabvars (i)                                 */
+/*                                                                            */
+/******************************************************************************/
+const char * variablecurgridtabvars(int which_grid)
+{
+    static char * varname[4] = {
+        " Agrif_%s(%d)",                // which_grid == 0
+        " Agrif_%s(%d) %% parent_var",  // which_grid == 1
+        " Agrif_Mygrid %% %s(%d)",      // which_grid == 2
+        " Agrif_Curgrid %% %s(%d)",     // which_grid == 3
+    };
+
+    return varname[which_grid];
+}
+
+void WARNING_CharSize(const variable *var)
+{
+    if ( var->v_nbdim == 0 )
+    {
+        if ( convert2int(var->v_dimchar) > 2400 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 2400. You must change         \n");
+            printf("   the dimension of carray0                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 161. Replace 2400 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),1);
+    }
+    else if ( var->v_nbdim == 1 )
+    {
+        if ( convert2int(var->v_dimchar) > 200 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 200. You must change          \n");
+            printf("   the dimension of carray1                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 162. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),2);
+    }
+    else if ( var->v_nbdim == 2 )
+    {
+        if ( convert2int(var->v_dimchar) > 200 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 200. You must change          \n");
+            printf("   the dimension of carray2                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 163. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),3);
+    }
+    else if ( var->v_nbdim == 3 )
+    {
+        if ( convert2int(var->v_dimchar) > 200 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 200. You must change          \n");
+            printf("   the dimension of carray3                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 164. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),4);
+    }
+}
+/******************************************************************************/
+/*                           vargridnametabvars                               */
 /******************************************************************************/
 /* This subroutine is used to create the string                               */
 /******************************************************************************/
 /*                                                                            */
-/*  if iorindice = 0 ---------->  Agrif_Gr % tabvars (i) % var                */
-/*                                                                            */
-/*  if iorindice = 1 ---------->  Agrif_Gr % tabvars (12) % var               */
-/*                                                                            */
-/******************************************************************************/
-char *variablenametabvars (variable * var, int iorindice)
-{
-  char *ligne;
-
-  ligne = (char *) malloc (LONG_C * sizeof (char));
-  if ( iorindice == 0 ) sprintf (ligne, " Agrif_Gr %% tabvars(%d)%% var",
-                                 var->v_indicetabvars);
-  else sprintf (ligne, " Agrif_Gr %% tabvars(i)%% var");
-  return ligne;
-}
-
-/******************************************************************************/
-/*                        variablecurgridtabvars                              */
+/*  if iorindice == 0 ----------->  Agrif_Gr % tabvars (i) % array1           */
+/*                                                                            */
+/*  if iorindice == 1 ----------->  Agrif_Gr % tabvars (12) % array1          */
+/*                                                                            */
+/******************************************************************************/
+const char *vargridnametabvars (const variable * var, int iorindice)
+{
+    static char tname_1[LONG_C];
+    static char tname_2[LONG_C];
+
+    if ( iorindice == 0 ) sprintf(tname_1, "Agrif_Gr %% %s(%d)", tabvarsname(var), var->v_indicetabvars);
+    else                  sprintf(tname_1, "Agrif_Gr %% %s(i)",  tabvarsname(var));
+
+    if (!strcasecmp(var->v_typevar, "REAL"))
+    {
+        if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
+        else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
+        else                                                sprintf(tname_2, "%% array%d",  var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "integer"))
+    {
+        sprintf(tname_2, "%% iarray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "logical"))
+    {
+        sprintf(tname_2, "%% larray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "character"))
+    {
+        WARNING_CharSize(var);
+        sprintf (tname_2, "%% carray%d", var->v_nbdim);
+    }
+
+    strcat(tname_1, tname_2);
+    Save_Length(tname_1, 46);
+
+    return tname_1;
+}
+
+/******************************************************************************/
+/*                           vargridcurgridtabvars                            */
 /******************************************************************************/
 /* This subroutine is used to create the string                               */
 /******************************************************************************/
 /*                                                                            */
-/*  ----------->  Agrif_Curgrid % tabvars (i) % var                           */
-/*                                                                            */
-/******************************************************************************/
-char *variablecurgridtabvars (variable * var,int ParentOrCurgrid)
-{
-  char *ligne;
-
-  ligne = (char *) malloc (LONG_C * sizeof (char));
-  if ( ParentOrCurgrid == 0 ) sprintf (ligne, " Agrif_tabvars(%d) %% var",
-                              var->v_indicetabvars);
-  else if ( ParentOrCurgrid == 1 ) sprintf (ligne,
-                              " Agrif_tabvars(%d) %% parent_var %% var",
-                               var->v_indicetabvars);
-  else if ( ParentOrCurgrid == 2 ) sprintf (ligne,
-                              " Agrif_Mygrid %% tabvars(%d) %% var",
-                               var->v_indicetabvars);
-  else if ( ParentOrCurgrid == 3 ) sprintf (ligne,
-                              " Agrif_Curgrid %% tabvars(%d) %% var",
-                               var->v_indicetabvars);
-  else sprintf (ligne, " AGRIF_Mygrid %% tabvars(%d) %% var",
-                               var->v_indicetabvars);
-  return ligne;
-}
-
-void WARNING_CharSize(variable *var)
-{
-   if ( var->v_nbdim == 0 )
-   {
-      if ( convert2int(var->v_dimchar) > 2050 )
-      {
-         printf("WARNING : The dimension of the character  %s   \n",
-                                                              var->v_nomvar);
-         printf("   is upper than 2050. You must change         \n");
-         printf("   the dimension of carray0                    \n");
-         printf("   in the file AGRIF/AGRIF_FILES/modtypes.F    \n");
-         printf("   line 247. Replace 300 with %d.              \n",
-                                            convert2int(var->v_dimchar)+100);
-      }
-      Save_Length_int(convert2int(var->v_dimchar),1);
-   }
-   else if ( var->v_nbdim == 1 )
-   {
-      if ( convert2int(var->v_dimchar) > 300 )
-      {
-         printf("WARNING : The dimension of the character  %s   \n",
-                                                              var->v_nomvar);
-         printf("   is upper than 300. You must change          \n");
-         printf("   the dimension of carray1                    \n");
-         printf("   in the file AGRIF/AGRIF_FILES/modtypes.F    \n");
-         printf("   line 247. Replace 300 with %d.              \n",
-                                            convert2int(var->v_dimchar)+100);
-      }
-      Save_Length_int(convert2int(var->v_dimchar),2);
-   }
-   else if ( var->v_nbdim == 2 )
-   {
-      if ( convert2int(var->v_dimchar) > 300 )
-      {
-         printf("WARNING : The dimension of the character  %s   \n",
-                                                              var->v_nomvar);
-         printf("   is upper than 300. You must change          \n");
-         printf("   the dimension of carray2                    \n");
-         printf("   in the file AGRIF/AGRIF_FILES/modtypes.F    \n");
-         printf("   line 247. Replace 300 with %d.              \n",
-                                            convert2int(var->v_dimchar)+100);
-      }
-      Save_Length_int(convert2int(var->v_dimchar),3);
-   }
-   else if ( var->v_nbdim == 3 )
-   {
-      if ( convert2int(var->v_dimchar) > 300 )
-      {
-         printf("WARNING : The dimension of the character  %s   \n",
-                                                              var->v_nomvar);
-         printf("   is upper than 300. You must change          \n");
-         printf("   the dimension of carray3                    \n");
-         printf("   in the file AGRIF/AGRIF_FILES/modtypes.F    \n");
-         printf("   line 247. Replace 300 with %d.              \n",
-                                            convert2int(var->v_dimchar)+100);
-      }
-      Save_Length_int(convert2int(var->v_dimchar),4);
-   }
-}
-/******************************************************************************/
-/*                           vargridnametabvars                               */
+/* if which_grid == 0 -->  Agrif_Curgrid % tabvars (i) % array1               */
+/*                                                                            */
+/* if which_grid == 1 -->  Agrif_tabvars (i) % parent_var % array1            */
+/*                                                                            */
+/* if which_grid == 2 -->  Agrif_Gr % tabvars (i) % array1                    */
+/*                                                                            */
+/******************************************************************************/
+const char *vargridcurgridtabvars(const variable *var, int which_grid)
+{
+    static char tname_1[LONG_C];
+    static char tname_2[LONG_C];
+
+    if (!strcasecmp(var->v_typevar,"type"))
+    {
+        sprintf(tname_1, "Agrif_%s_var(Agrif_Curgrid%%fixedrank)%%%s", var->v_modulename, var->v_nomvar);
+    }
+    else
+    {
+        sprintf(tname_1, variablecurgridtabvars(which_grid), tabvarsname(var), var->v_indicetabvars);
+
+        if (!strcasecmp(var->v_typevar, "REAL"))
+        {
+            if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
+            else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
+            else                                                sprintf(tname_2, "%% array%d", var->v_nbdim);
+        }
+        else if (!strcasecmp(var->v_typevar, "INTEGER"))
+        {
+            sprintf(tname_2, "%% iarray%d", var->v_nbdim);
+        }
+        else if (!strcasecmp(var->v_typevar, "LOGICAL"))
+        {
+            sprintf(tname_2, "%% larray%d", var->v_nbdim);
+        }
+        else if (!strcasecmp(var->v_typevar, "CHARACTER"))
+        {
+            WARNING_CharSize(var);
+            sprintf(tname_2, "%% carray%d", var->v_nbdim);
+        }
+        strcat(tname_1, tname_2);
+    }
+    Save_Length(tname_1, 46);
+
+    return tname_1;
+}
+
+/******************************************************************************/
+/*                  vargridcurgridtabvarswithoutAgrif_Gr                      */
 /******************************************************************************/
 /* This subroutine is used to create the string                               */
 /******************************************************************************/
 /*                                                                            */
-/*  if iorindice == 0 ----------->  Agrif_Gr % tabvars (i) % var % array1     */
-/*                                                                            */
-/*  if iorindice == 1 ----------->  Agrif_Gr % tabvars (12) % var % array1    */
-/*                                                                            */
-/******************************************************************************/
-char *vargridnametabvars (variable * var,int iorindice)
-{
-  char *tmp;
-  char tmp1[LONG_C];
-
-  tmp = variablenametabvars (var,iorindice);
-  strcpy(tmp1,tmp);
-  if ( todebugfree == 1 ) free(tmp);
-
-  sprintf (lvargridname, "%s", tmp1);
-  if (!strcasecmp (var->v_typevar, "REAL"))
-    {
-      if ( !strcasecmp(var->v_nameinttypename,"8") )
-                           sprintf (lvargridname2, "%% darray%d", var->v_nbdim);
-      else if ( !strcasecmp(var->v_nameinttypename,"4") )
-                           sprintf (lvargridname2, "%% sarray%d", var->v_nbdim);
-      else sprintf (lvargridname2, "%% array%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "INTEGER"))
-    {
-      sprintf (lvargridname2, "%% iarray%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "LOGICAL"))
-    {
-      sprintf (lvargridname2, "%% larray%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "CHARACTER"))
-    {
-      WARNING_CharSize(var);
-      sprintf (lvargridname2, "%% carray%d", var->v_nbdim);
-    }
-
-  strcat (lvargridname, lvargridname2);
-
-  Save_Length(lvargridname,42);
-  Save_Length(lvargridname2,42);
-  return lvargridname;
-}
-
-/******************************************************************************/
-/*                           vargridcurgridtabvars                            */
-/******************************************************************************/
-/* This subroutine is used to create the string                               */
-/******************************************************************************/
-/*                                                                            */
-/* if ParentOrCurgrid == 0 -->  Agrif_Curgrid % tabvars (i) % var % array1    */
-/*                                                                            */
-/* if ParentOrCurgrid == 1 -->  Agrif_tabvars (i) % parent_var %var % array1  */
-/*                                                                            */
-/* if ParentOrCurgrid == 2 -->  Agrif_Gr % tabvars (i) % var % array1         */
-/*                                                                            */
-/******************************************************************************/
-char *vargridcurgridtabvars (variable * var,int ParentOrCurgrid)
-{
-  char *tmp;
-  char tmp1[LONG_C];
-
- if (!strcasecmp(var->v_typevar,"type"))
-  {
-  strcpy(lvargridname2,"");
-  sprintf(lvargridname,"Agrif_%s_var(Agrif_Curgrid%%fixedrank)%%%s",var->v_modulename,var->v_nomvar);
-  printf("modulename = %s %s\n",var->v_nomvar, var->v_modulename);
-  }
-  else
-  {
-  tmp = variablecurgridtabvars (var,ParentOrCurgrid);
-  strcpy(tmp1,tmp);
-  if ( todebugfree == 1 ) free(tmp);
-
-  sprintf (lvargridname, "%s", tmp1);
-  if (!strcasecmp (var->v_typevar, "REAL"))
-    {
-      if ( !strcasecmp(var->v_nameinttypename,"8") )
-                           sprintf (lvargridname2, "%% darray%d", var->v_nbdim);
-      else if ( !strcasecmp(var->v_nameinttypename,"4") )
-                           sprintf (lvargridname2, "%% sarray%d", var->v_nbdim);
-      else sprintf (lvargridname2, "%% array%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "INTEGER"))
-    {
-      sprintf (lvargridname2, "%% iarray%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "LOGICAL"))
-    {
-      sprintf (lvargridname2, "%% larray%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "CHARACTER"))
-    {
-      WARNING_CharSize(var);
-      sprintf (lvargridname2, "%% carray%d", var->v_nbdim);
-    }
-  }
-
-  strcat (lvargridname, lvargridname2);
-
-  Save_Length(lvargridname,42);
-  Save_Length(lvargridname2,42);
-  return lvargridname;
-}
-
-/******************************************************************************/
-/*                  vargridcurgridtabvarswithoutAgrif_Gr                      */
-/******************************************************************************/
-/* This subroutine is used to create the string                               */
-/******************************************************************************/
-/*                                                                            */
-/******************************************************************************/
-char *vargridcurgridtabvarswithoutAgrif_Gr (variable * var)
-{
-
-  sprintf (lvargridname, "(%d) %% var", var->v_indicetabvars);
-
-  if (!strcasecmp (var->v_typevar, "REAL"))
-    {
-      if ( !strcasecmp(var->v_nameinttypename,"8") )
-                           sprintf (lvargridname2, "%% darray%d", var->v_nbdim);
-      else if ( !strcasecmp(var->v_nameinttypename,"4") )
-                           sprintf (lvargridname2, "%% sarray%d", var->v_nbdim);
-      else sprintf (lvargridname2, "%% array%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "INTEGER"))
-    {
-      sprintf (lvargridname2, "%% iarray%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "LOGICAL"))
-    {
-      sprintf (lvargridname2, "%% larray%d", var->v_nbdim);
-    }
-  else if (!strcasecmp (var->v_typevar, "CHARACTER"))
-    {
-      WARNING_CharSize(var);
-      sprintf (lvargridname2, "%% carray%d", var->v_nbdim);
-    }
-
-  strcat (lvargridname, lvargridname2);
-
-  Save_Length(lvargridname,42);
-  Save_Length(lvargridname2,42);
-  return lvargridname;
+/******************************************************************************/
+const char *vargridcurgridtabvarswithoutAgrif_Gr(const variable *var)
+{
+    static char tname_1[LONG_C];
+    static char tname_2[LONG_C];
+
+    sprintf(tname_1, "(%d)", var->v_indicetabvars);
+
+    if (!strcasecmp (var->v_typevar, "REAL"))
+    {
+        if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
+        else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
+        else                                                sprintf(tname_2, "%% array%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "INTEGER"))
+    {
+        sprintf(tname_2, "%% iarray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "LOGICAL"))
+    {
+        sprintf(tname_2, "%% larray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "CHARACTER"))
+    {
+        WARNING_CharSize(var);
+        sprintf(tname_2, "%% carray%d", var->v_nbdim);
+    }
+
+    strcat(tname_1, tname_2);
+    Save_Length(tname_1, 46);
+
+    return tname_1;
 }
 
@@ -333,51 +269,32 @@
 /*                                                                            */
 /******************************************************************************/
-char *vargridparam (variable * v, int whichone)
-{
-  typedim dim;
-  listdim *newdim;
-  char newname[LONG_4C];
-
-  newdim = v->v_dimension;
-  if (!newdim) return "";
-
-  strcpy (tmpvargridname, "(");
-  while (newdim)
-  {
-     dim = newdim->dim;
-
-     strcpy(newname,"");
-     strcpy(newname,
-            ChangeTheInitalvaluebyTabvarsName(dim.first,List_Global_Var,
-                                                                     whichone));
-                                                                     
-        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,
-                       List_Common_Var,whichone));
-
-        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,
-                       List_ModuleUsed_Var,whichone));
-
-     strcat (tmpvargridname, newname);
-     strcat (tmpvargridname, " : ");
-
-     strcpy(newname,"");
-     strcpy(newname,ChangeTheInitalvaluebyTabvarsName
-                        (dim.last,List_Global_Var,whichone));
-                        
-        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
-                       (newname, List_Common_Var,whichone));   
-                       
-        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
-                       (newname, List_ModuleUsed_Var,whichone));                                            
-                        
-     Save_Length(tmpvargridname,46);
-     strcat (tmpvargridname, newname);
-     newdim = newdim->suiv;
-     if (newdim) strcat (tmpvargridname, ",");
-  }
-  strcat (tmpvargridname, ")");
-  strcat (tmpvargridname, "\0");
-  Save_Length(tmpvargridname,40);
-  return tmpvargridname;
+const char * vargridparam(const variable *var)
+{
+    typedim dim;
+    listdim *newdim;
+    char newname[LONG_M];
+
+    newdim = var->v_dimension;
+    if (!newdim) return "";
+
+    strcpy (tmpvargridname, "(");
+    while (newdim)
+    {
+        dim = newdim->dim;
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.first,List_Global_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_Common_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_ModuleUsed_Var));
+        strcat(tmpvargridname, newname);
+        strcat(tmpvargridname, " : ");
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.last,List_Global_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_Common_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_ModuleUsed_Var));
+        strcat(tmpvargridname, newname);
+        newdim = newdim->suiv;
+        if (newdim) strcat(tmpvargridname, ",");
+    }
+    strcat(tmpvargridname, ")\0");
+    Save_Length(tmpvargridname,40);
+    return tmpvargridname;
 }
 
@@ -396,7 +313,7 @@
 {
   FILE *probdim;
-  char ligne[LONG_C];
-
-  probdim = associate("probdim_agrif.h");
+  char ligne[LONG_M];
+
+  probdim = open_for_write("probdim_agrif.h");
   sprintf (ligne, "Agrif_Probdim = %d", dimprob);
   tofich (probdim, ligne,1);
@@ -421,11 +338,7 @@
   FILE *keys;
 
-  keys = associate ("keys_agrif.h");
-  fprintf(keys,"      AGRIF_USE_FIXED_GRIDS = 0\n");
-  fprintf(keys,"      AGRIF_USE_ONLY_FIXED_GRIDS = 0\n");
-  if (fixedgrids     == 1) fprintf(keys,"      AGRIF_USE_FIXED_GRIDS = 1\n");
-  if (onlyfixedgrids == 1)
-                         fprintf(keys,"      AGRIF_USE_ONLY_FIXED_GRIDS = 1\n");
-
+  keys = open_for_write("keys_agrif.h");
+  fprintf(keys,"      AGRIF_USE_FIXED_GRIDS = %d\n", fixedgrids);
+  fprintf(keys,"      AGRIF_USE_ONLY_FIXED_GRIDS = %d\n", onlyfixedgrids);
   fclose(keys);
 }
@@ -444,11 +357,15 @@
 void write_modtypeagrif_file()
 {
-  char ligne[LONG_C];
+  char ligne[LONG_M];
   FILE *typedata;
-
-  typedata = associate ("modtype_agrif.h");
+  int i;
+
+  typedata = open_for_write("modtype_agrif.h");
   /* AGRIF_NbVariables : number of variables                                  */
-  sprintf (ligne, "AGRIF_NbVariables = %d",indicemaxtabvars);
-  tofich(typedata,ligne,1);
+  for (i=0;i<NB_CAT_VARIABLES;i++)
+   {
+    sprintf (ligne, "Agrif_NbVariables(%d) = %d",i,indicemaxtabvars[i]);
+    tofich(typedata,ligne,1);
+   }
   fclose (typedata);
 }
@@ -460,21 +377,14 @@
 /******************************************************************************/
 /*                                                                            */
-/*    Agrif_Gr % tabvars (i) % var % namevar = "variable"                     */
-/*                                                                            */
-/******************************************************************************/
-void write_createvarnameagrif_file(variable *v,FILE *createvarname,
-                                                       int *InitEmpty)
-{
-  char ligne[LONG_C];
-  char *tmp;
-  char temp1[LONG_C];
-
-  tmp =  variablenametabvars(v,0);
-  strcpy (temp1, tmp);
-  if ( todebugfree == 1 ) free(tmp);
-
-  *InitEmpty = 0 ;
-  sprintf(ligne, "%s %% namevar = \"%s\"",temp1,v->v_nomvar);
-  tofich(createvarname,ligne,1);
+/*    Agrif_Gr % tabvars (i) % namevar = "variable"                           */
+/*                                                                            */
+/******************************************************************************/
+void write_createvarnameagrif_file(variable *v,FILE *createvarname, int *InitEmpty)
+{
+    char ligne[LONG_M];
+
+    *InitEmpty = 0 ;
+    sprintf(ligne, "Agrif_Gr %% %s(%d) %% namevar = \"%s\"",tabvarsname(v),v->v_indicetabvars,v->v_nomvar);
+    tofich(createvarname,ligne,1);
 }
 
@@ -488,62 +398,33 @@
 /*                                                                            */
 /******************************************************************************/
-void write_Setnumberofcells_file(char *name)
-{
-  char ligne[LONG_C];
-  FILE *setnumberofcells;
-
-  if ( IndicenbmaillesX != 0 )
-  {
-  setnumberofcells=associate(name);
-
-  if (onlyfixedgrids != 1 )
-  {
-  sprintf (ligne,
-           "Agrif_Gr %% nb(1) = Agrif_Gr %% tabvars(%d) %% var %% iarray0",
-           IndicenbmaillesX);
-  }
-  else
-  {
-  sprintf (ligne,
-           "Agrif_Gr %% nb(1) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0",
-           IndicenbmaillesX);
-  }
-  tofich (setnumberofcells, ligne,1);
-  if (dimprob > 1)
-  {
-     if (onlyfixedgrids != 1 )
-     {
-     sprintf (ligne,
-           "Agrif_Gr %% nb(2) = Agrif_Gr %% tabvars(%d) %% var %% iarray0",
-           IndicenbmaillesY);
-     }
-     else
-     {
-     sprintf (ligne,
-           "Agrif_Gr %% nb(2) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0",
-           IndicenbmaillesY);
-     }
-
-     tofich (setnumberofcells, ligne,1);
-  }
-  if (dimprob > 2)
-  {
-     if (onlyfixedgrids != 1 )
-     {
-     sprintf (ligne,
-           "Agrif_Gr %% nb(3) = Agrif_Gr %% tabvars(%d) %% var %% iarray0",
-           IndicenbmaillesZ);
-     }
-     else
-     {
-     sprintf (ligne,
-           "Agrif_Gr %% nb(3) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0",
-           IndicenbmaillesZ);
-     }
-     tofich (setnumberofcells, ligne,1);
-  }
-
-  fclose (setnumberofcells);
-  }
+void write_Setnumberofcells_file()
+{
+    char ligne[LONG_VNAME];
+    char cformat[LONG_VNAME];
+    FILE *setnumberofcells;
+
+    if ( IndicenbmaillesX == 0 )  return;
+
+    setnumberofcells = open_for_write("SetNumberofcells.h");
+
+    if ( onlyfixedgrids == 1 )
+        strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Curgrid %% tabvars_i(%d) %% iarray0");
+    else
+        strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Gr %% tabvars_i(%d) %% iarray0");
+
+    sprintf(ligne, cformat, 1, IndicenbmaillesX);
+    tofich(setnumberofcells, ligne, 1);
+
+    if ( dimprob > 1 )
+    {
+        sprintf(ligne, cformat, 2, IndicenbmaillesY);
+        tofich(setnumberofcells, ligne, 1);
+    }
+    if ( dimprob > 2 )
+    {
+        sprintf(ligne, cformat, 3, IndicenbmaillesZ);
+        tofich(setnumberofcells, ligne, 1);
+    }
+    fclose(setnumberofcells);
 }
 
@@ -557,32 +438,30 @@
 /*                                                                            */
 /******************************************************************************/
-void write_Getnumberofcells_file(char *name)
-{
-  char ligne[LONG_C];
-  FILE *getnumberofcells;
-
-  if ( IndicenbmaillesX != 0 )
-  {
-  getnumberofcells=associate(name);
-  sprintf (ligne,
-           "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(1)",
-           IndicenbmaillesX);
-  tofich (getnumberofcells, ligne,1);
-  if (dimprob > 1)
-    {
-      sprintf (ligne,
-           "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(2)",
-           IndicenbmaillesY);
-      tofich (getnumberofcells, ligne,1);
-    }
-  if (dimprob > 2)
-    {
-      sprintf (ligne,
-           "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(3)",
-           IndicenbmaillesZ);
-      tofich (getnumberofcells, ligne,1);
-    }
-  fclose (getnumberofcells);
-  }
+void write_Getnumberofcells_file()
+{
+    char ligne[LONG_VNAME];
+    char cformat[LONG_VNAME];
+    FILE *getnumberofcells;
+
+    if ( IndicenbmaillesX == 0 )    return;
+
+    strcpy(cformat, "Agrif_Curgrid %% tabvars_i(%d) %% iarray0 = Agrif_Gr %% nb(%d)");
+
+    getnumberofcells = open_for_write("GetNumberofcells.h");
+
+    sprintf(ligne, cformat, IndicenbmaillesX, 1);
+    tofich(getnumberofcells, ligne, 1);
+
+    if (dimprob > 1)
+    {
+        sprintf(ligne, cformat, IndicenbmaillesY, 2);
+        tofich(getnumberofcells, ligne,1);
+    }
+    if (dimprob > 2)
+    {
+        sprintf(ligne, cformat, IndicenbmaillesZ, 3);
+        tofich(getnumberofcells, ligne,1);
+    }
+    fclose(getnumberofcells);
 }
 
@@ -595,24 +474,17 @@
 /*                                                                            */
 /*              ! variable                                                    */
-/*              Agrif_Gr % tabvars(i) % var % nbdim = 1                       */
-/*                                                                            */
-/******************************************************************************/
-void write_initialisationsagrif_file(variable *v,FILE *initproc,
-                                     int *VarnameEmpty)
-{
-  char ligne[LONG_C];
-  char temp1[LONG_C];
-  char *tmp;
-
-  tmp = variablenameroottabvars (v);
-  strcpy (temp1, tmp);
-  if ( todebugfree == 1 ) free(tmp);
-
-  if ( v->v_nbdim != 0 )
-  {
-     *VarnameEmpty = 0 ;
-     sprintf (ligne, "%s %% nbdim = %d", temp1, v->v_nbdim);
-     tofich (initproc, ligne,1);
-  }
+/*              Agrif_Gr % tabvars(i) % nbdim = 1                             */
+/*                                                                            */
+/******************************************************************************/
+void write_initialisationsagrif_file(variable *v,FILE *initproc,int *VarnameEmpty)
+{
+    char ligne[LONG_M];
+
+    if ( v->v_nbdim != 0 )
+    {
+        *VarnameEmpty = 0 ;
+        sprintf(ligne,"Agrif_Mygrid %% %s(%d) %% nbdim = %d", tabvarsname(v), v->v_indicetabvars, v->v_nbdim);
+        tofich (initproc, ligne,1);
+    }
 }
 
@@ -624,13 +496,12 @@
    FILE *AllocUSE;
 
-   AllocUSE= associate("include_use_Alloc_agrif.h");
-   alloccalls = associate("allocations_calls_agrif.h");
+   AllocUSE= open_for_write("include_use_Alloc_agrif.h");
+   alloccalls = open_for_write("allocations_calls_agrif.h");
 
    parcours = List_Subroutine_For_Alloc;
    while ( parcours )
    {
-      fprintf(AllocUSE,"      USE %s\n", parcours -> o_nom );
-      fprintf (alloccalls,"      Call Alloc_agrif_%s(Agrif_Gr)\n",
-                                                            parcours -> o_nom );
+      fprintf(AllocUSE,"      use %s, only: Alloc_agrif_%s\n", parcours -> o_nom, parcours -> o_nom );
+      fprintf (alloccalls,"      call Alloc_agrif_%s(Agrif_Gr)\n", parcours -> o_nom );
       parcours = parcours -> suiv;
    }
@@ -656,421 +527,338 @@
    return out;
 }
+
 void write_allocation_Common_0()
 {
-   listnom *parcours_nom;
-   listnom *neededparameter;
-   listvar *parcours;
-   listvar *parcoursprec;
-   listvar *parcours1;
-   FILE *allocationagrif;
-   FILE *paramtoamr;
-   char ligne[LONGNOM];
-   char ligne2[LONGNOM];   
-   variable *v;
-   int IndiceMax;
-   int IndiceMin;
-   int compteur;
-   int out;
-   int indiceprec;
-   int ValeurMax;
-   char initialvalue[LONG_4C];
-   listindice *list_indic;
-   listindice *parcoursindic;
-   int i;
-
-   parcoursprec = (listvar *)NULL;
-   parcours_nom = List_NameOfCommon;
-   ValeurMax = 2;
-   while ( parcours_nom  )
-   {
-      /*                                                                      */
-      if ( parcours_nom->o_val == 1 )
-      {
-         /* Open the file to create the Alloc_agrif subroutine                */
-         sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
-         allocationagrif = associate (ligne);
-         /*                                                                   */
-         fprintf(allocationagrif,"#include \"Param_toamr_%s.h\" \n",
-                                                           parcours_nom->o_nom);
-         /*                                                                   */
-         sprintf(ligne,"Param_toamr_%s.h",parcours_nom->o_nom);
-         paramtoamr = associate (ligne);
-         neededparameter = (listnom * )NULL;
-         /*                                                                   */
-         list_indic = (listindice *)NULL;
-         /*                                                                   */
-         shouldincludempif = 1 ;
-         parcours = List_Common_Var;
-         while ( parcours )
-         {
-            if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom) &&
-                  IndiceInlist(parcours->var->v_indicetabvars,list_indic) == 0
-               )
+    listnom *parcours_nom;
+    listnom *neededparameter;
+    listvar *parcours;
+    listvar *parcoursprec;
+    listvar *parcours1;
+    FILE *allocationagrif;
+    FILE *paramtoamr;
+    char ligne[LONG_M];
+    char ligne2[LONG_M];
+    variable *v;
+    int IndiceMax;
+    int IndiceMin;
+    int compteur;
+    int out;
+    int indiceprec;
+    int ValeurMax;
+    char initialvalue[LONG_M];
+    listindice **list_indic;
+    listindice *parcoursindic;
+    int i;
+
+    parcoursprec = (listvar *) NULL;
+    parcours_nom = List_NameOfCommon;
+    ValeurMax = 2;
+    while ( parcours_nom  )
+    {
+        if ( parcours_nom->o_val == 1 )
+        {
+            /* Open the file to create the Alloc_agrif subroutine                */
+            sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
+            allocationagrif = open_for_write(ligne);
+            fprintf(allocationagrif,"#include \"Param_toamr_%s.h\" \n", parcours_nom->o_nom);
+
+            sprintf(ligne,"Param_toamr_%s.h",parcours_nom->o_nom);
+            paramtoamr = open_for_write(ligne);
+            neededparameter = (listnom *) NULL;
+            list_indic = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+
+//             shouldincludempif = 1 ;
+            parcours = List_Common_Var;
+            while ( parcours )
             {
-               /***************************************************************/
-               /***************************************************************/
-               /***************************************************************/
-               v = parcours->var;
-               IndiceMax = 0;
-               IndiceMin = indicemaxtabvars;
-  /* body of the file                                                         */
-  if ( !strcasecmp(v->v_commoninfile,mainfile) )
-  {
-     if (onlyfixedgrids != 1 && v->v_nbdim!=0)
-     {
-        strcpy (ligne, "If (.not. associated(");
-        strcat (ligne, vargridnametabvars(v,0));
-        strcat (ligne, "))                       then");
-        Save_Length(ligne,48);
-        tofich (allocationagrif, ligne,1);
-     }
-     if ( v->v_allocatable != 1 && ( v->v_dimsempty != 1) )
-     {
-        /*                ALLOCATION                                          */
-        if ( v->v_dimension != 0  )
-        {
-           if ( v->v_indicetabvars < IndiceMin ||
-                v->v_indicetabvars > IndiceMax )
-           {
-              parcours1 = parcours;
-              compteur = -1;
-              out = 0;
-              indiceprec = parcours->var->v_indicetabvars -1 ;
-              while ( parcours1 && out == 0 &&
-                      !strcasecmp(  parcours->var->v_readedlistdimension,
-                                  parcours1->var->v_readedlistdimension) &&
-                      !strcasecmp(  parcours->var->v_typevar,
-                                  parcours1->var->v_typevar) &&
-                            ( parcours1->var->v_indicetabvars == indiceprec+1 )
-                     )
-              {
-
-               if ( !strcasecmp(parcours1->var->v_modulename,
-                                parcours_nom->o_nom) ||
-                    !strcasecmp(parcours1->var->v_commonname,
-                                parcours_nom->o_nom) )
-                 {
-                      compteur = compteur +1 ;
-                      indiceprec = parcours1->var->v_indicetabvars;
-                      parcoursprec = parcours1;
-                      parcours1 = parcours1->suiv;
-                 }
-                 else out = 1;
-              }
-
-              if ( compteur > ValeurMax )
-              {
-                 fprintf(allocationagrif,"      DO i = %d , %d\n",
-                                         parcours->var->v_indicetabvars,
-                                       parcours->var->v_indicetabvars+compteur);
-                 IndiceMin = parcours->var->v_indicetabvars;
-                 IndiceMax = parcours->var->v_indicetabvars+compteur;
-                 strcpy (ligne, "allocate ");
-                 strcat (ligne, "(");
-                 strcat (ligne, vargridnametabvars(v,1));
-                 strcat (ligne, vargridparam(v,0));
-                 strcat (ligne, ")");
-                 Save_Length(ligne,48);
-                 tofich (allocationagrif, ligne,1);
-                 fprintf(allocationagrif,"      end do\n");
-                 i=parcours->var->v_indicetabvars;
-                 do
-                 {
-                    parcoursindic =  (listindice *)malloc(sizeof(listindice));
-                    parcoursindic -> i_indice = i;
-                    parcoursindic -> suiv = list_indic;
-                    list_indic = parcoursindic;
-                    i = i + 1;
-                 } while ( i <= parcours->var->v_indicetabvars+compteur );
-                 parcours = parcoursprec;
-                 /*                                                           */
-              }
-              else
-              {
-                 strcpy (ligne, "allocate ");
-                 strcat (ligne, "(");
-                 strcat (ligne, vargridnametabvars(v,0));
-                 strcat (ligne, vargridparam(v,0));
-                 strcat (ligne, ")");
-                 Save_Length(ligne,48);
-                 tofich (allocationagrif, ligne,1);
-                 /*                                                           */
-                 parcoursindic =  (listindice *)malloc(sizeof(listindice));
-                 parcoursindic -> i_indice = parcours->var->v_indicetabvars;
-                 parcoursindic -> suiv = list_indic;
-                 list_indic = parcoursindic;
-              }
-                neededparameter = writedeclarationintoamr(List_Parameter_Var,
-                              paramtoamr,v,parcours_nom->o_nom,neededparameter,
-                                                               v->v_commonname);
-              /*                                                              */
-           }
-        } /* end of the allocation part                                       */
-        /*                INITIALISATION                                      */
-        if ( strcasecmp(v->v_initialvalue,"") )
-        {
-           strcpy (ligne, "");
-           strcat (ligne, vargridnametabvars(v,0));
-           /* We should modify the initialvalue in the case of variable has   */
-           /*    been defined with others variables                           */
-                      
-           strcpy(initialvalue,
-                  ChangeTheInitalvaluebyTabvarsName
-                                      (v->v_initialvalue,List_Global_Var,0));
-           if ( !strcasecmp(initialvalue,v->v_initialvalue) )
-           {
-              strcpy(initialvalue,"");
-              strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
-                                      (v->v_initialvalue,List_Common_Var,0));
-           }
-           if ( !strcasecmp(initialvalue,v->v_initialvalue) )
-           {
-              strcpy(initialvalue,"");
-              strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
-                                     (v->v_initialvalue,List_ModuleUsed_Var,0));
-           }
-           strcat (ligne," = ");
-
-           if (v->v_nbdim == 0)
-           {
-           strcpy(ligne2,initialvalue);
-           }
-           else
-           {
-           sprintf(ligne2,"RESHAPE(%s,SHAPE(%s))",initialvalue,vargridnametabvars(v,0));
-           }
-           strcat (ligne,ligne2);
-           /*                                                                 */
-           Save_Length(ligne,48);
-           tofich (allocationagrif, ligne,1);
-        }
-     }
-     if (onlyfixedgrids != 1 && v->v_nbdim!=0)
-     {
-        strcpy (ligne, "   End if");
-        tofich (allocationagrif, ligne,1);
-     }
-  }
-               /***************************************************************/
-               /***************************************************************/
-               /***************************************************************/
+                if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom) &&
+                    IndiceInlist(parcours->var->v_indicetabvars,list_indic[parcours->var->v_catvar]) == 0 )
+                {
+                    v = parcours->var;
+                    IndiceMax = 0;
+                    IndiceMin = indicemaxtabvars[v->v_catvar];
+                    /* body of the file */
+                    if ( !strcasecmp(v->v_commoninfile,cur_filename) )
+                    {
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0));
+                            tofich(allocationagrif,ligne,1);
+                        }
+                        if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) )
+                        {
+                            /*                ALLOCATION                                          */
+                            if ( v->v_dimension != 0 )
+                            {
+                                if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax )
+                                {
+                                    parcours1 = parcours;
+                                    compteur = -1;
+                                    out = 0;
+                                    indiceprec = parcours->var->v_indicetabvars -1 ;
+                                    while ( parcours1 && out == 0
+                                        && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension)
+                                        && !strcasecmp(parcours->var->v_typevar,            parcours1->var->v_typevar)
+                                        && (parcours1->var->v_indicetabvars == indiceprec+1) )
+                                    {
+                                        if ( !strcasecmp(parcours1->var->v_modulename,parcours_nom->o_nom) ||
+                                             !strcasecmp(parcours1->var->v_commonname,parcours_nom->o_nom) )
+                                        {
+                                            compteur = compteur +1 ;
+                                            indiceprec = parcours1->var->v_indicetabvars;
+                                            parcoursprec = parcours1;
+                                            parcours1 = parcours1->suiv;
+                                        }
+                                        else out = 1;
+                                    }
+                                    sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar);
+                                    tofich(allocationagrif,ligne,1);
+                                    if ( compteur > ValeurMax )
+                                    {
+                                        sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars,
+                                                                      parcours->var->v_indicetabvars+compteur);
+                                        tofich(allocationagrif,ligne,1);
+                                        IndiceMin = parcours->var->v_indicetabvars;
+                                        IndiceMax = parcours->var->v_indicetabvars+compteur;
+                                        sprintf(ligne,"    allocate(%s", vargridnametabvars(v,1));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                        tofich(allocationagrif,"enddo",1);
+                                        i = parcours->var->v_indicetabvars;
+                                        do
+                                        {
+                                            parcoursindic =  (listindice *)calloc(1,sizeof(listindice));
+                                            parcoursindic -> i_indice = i;
+                                            parcoursindic -> suiv = list_indic[parcours->var->v_catvar];
+                                            list_indic[parcours->var->v_catvar] = parcoursindic;
+                                            i = i + 1;
+                                        } while ( i <= parcours->var->v_indicetabvars+compteur );
+                                        parcours = parcoursprec;
+                                    }
+                                    else
+                                    {
+                                        sprintf(ligne,"allocate(%s", vargridnametabvars(v,0));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                        parcoursindic =  (listindice *) calloc(1,sizeof(listindice));
+                                        parcoursindic -> i_indice = parcours->var->v_indicetabvars;
+                                        parcoursindic -> suiv = list_indic[parcours->var->v_catvar];
+                                        list_indic[parcours->var->v_catvar] = parcoursindic;
+                                    }
+                                    neededparameter = writedeclarationintoamr(List_Parameter_Var,
+                                                        paramtoamr,v,parcours_nom->o_nom,neededparameter,v->v_commonname);
+                                }
+                            } /* end of the allocation part                                       */
+                            /*                INITIALISATION                                      */
+                            if ( strcasecmp(v->v_initialvalue,"") )
+                            {
+                                strcpy(ligne, vargridnametabvars(v,0));
+                                /* We should modify the initialvalue in the case of variable has been defined with others variables */
+                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var));
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var));
+                                }
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var));
+                                }
+                                strcat (ligne," = ");
+
+                                if (v->v_nbdim == 0)
+                                {
+                                    strcpy(ligne2,initialvalue);
+                                }
+                                else
+                                {
+                                    sprintf(ligne2,"reshape(%s,shape(%s))",initialvalue,vargridnametabvars(v,0));
+                                }
+                                strcat(ligne,ligne2);
+                                tofich(allocationagrif,ligne,1);
+                            }
+                        }
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            tofich(allocationagrif,"endif",1);
+                        }
+                    }
+                }
+                parcours = parcours -> suiv;
             }
-            parcours = parcours -> suiv;
-         }
-         /* Close the file Alloc_agrif                                        */
-         fclose(allocationagrif);
-         fclose(paramtoamr);
-      }
-      /*                                                                      */
-      parcours_nom = parcours_nom -> suiv;
-   }
-
-}
-
-
+            /* Close the file Alloc_agrif                                        */
+            fclose(allocationagrif);
+            fclose(paramtoamr);
+        }
+        parcours_nom = parcours_nom -> suiv;
+    }
+}
 
 void write_allocation_Global_0()
 {
-   listnom *parcours_nom;
-   listvar *parcours;
-   listvar *parcoursprec;
-   listvar *parcours1;
-   FILE *allocationagrif;
-   char ligne[LONGNOM];
-   variable *v;
-   int IndiceMax;
-   int IndiceMin;
-   int compteur;
-   int out;
-   int indiceprec;
-   int ValeurMax;
-   char initialvalue[LONG_4C];
-   int typeiswritten ;
-
-   parcoursprec = (listvar *)NULL;
-   parcours_nom = List_NameOfModule;
-   ValeurMax = 2;
-   while ( parcours_nom  )
-   {
-      /*                                                                      */
-      if ( parcours_nom->o_val == 1 )
-      {
-         IndiceMax = 0;
-         IndiceMin = indicemaxtabvars;
-         /* Open the file to create the Alloc_agrif subroutine                */
-         sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
-         allocationagrif = associate (ligne);
-         /*                                                                   */
-         if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
-         {
-             /* add the call to initworkspace                                 */
-            tofich(allocationagrif,"if ( .NOT. Agrif_Root() ) then ",1);
-            fprintf(allocationagrif,"#include \"GetNumberofcells.h\" \n");
-            tofich(allocationagrif,"else ",1);
-            fprintf(allocationagrif,"#include \"SetNumberofcells.h\" \n");
-            tofich(allocationagrif,"endif ",1);
-            tofich(allocationagrif,"Call Agrif_InitWorkspace ",1);
-         }
-
-         typeiswritten = 0;
-
-         parcours = List_Global_Var;
-         while ( parcours )
-         {
-            if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) &&
-                 parcours->var->v_VariableIsParameter == 0                  &&
-                 parcours->var->v_notgrid == 0                              &&
-                 !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom)  )
+    listnom *parcours_nom;
+    listvar *parcours;
+    listvar *parcoursprec;
+    listvar *parcours1;
+    FILE *allocationagrif;
+    char ligne[LONG_M];
+    char ligne2[LONG_M];
+    variable *v;
+    int IndiceMax;
+    int IndiceMin;
+    int compteur;
+    int out;
+    int indiceprec;
+    int ValeurMax;
+    char initialvalue[LONG_M];
+    int typeiswritten ;
+
+    parcoursprec = (listvar *) NULL;
+    parcours_nom = List_NameOfModule;
+    ValeurMax = 2;
+
+    while ( parcours_nom  )
+    {
+        if ( parcours_nom->o_val == 1 )
+        {
+            IndiceMax = 0;
+            IndiceMin = indicemaxtabvars[0];
+            /* Open the file to create the Alloc_agrif subroutine                */
+            sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
+            allocationagrif = open_for_write(ligne);
+
+//             if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
+//             {
+//                 /* add the call to initworkspace         */
+//                 tofich(allocationagrif,"if (.not. Agrif_Root() ) then",1);
+//                 tofich(allocationagrif,"#include \"GetNumberofcells.h\"\n",0);
+//                 tofich(allocationagrif,"else",1);
+//                 tofich(allocationagrif,"#include \"SetNumberofcells.h\"\n",0);
+//                 tofich(allocationagrif,"endif",1);
+//                 tofich(allocationagrif,"call Agrif_InitWorkspace",1);
+//             }
+
+            typeiswritten = 0;
+            parcours = List_Global_Var;
+            while ( parcours )
             {
-               /***************************************************************/
-               /***************************************************************/
-               /***************************************************************/
-               v = parcours->var;
-               IndiceMax = 0;
-               IndiceMin = indicemaxtabvars;
-  /* body of the file                                                         */
-  if ( !strcasecmp(v->v_commoninfile,mainfile) )
-  {
-     if (onlyfixedgrids != 1 && v->v_nbdim!=0)
-     {
-        strcpy (ligne, "If (.not. associated(");
-        strcat (ligne, vargridnametabvars(v,0));
-        strcat (ligne, "))                       then");
-        Save_Length(ligne,48);
-        tofich (allocationagrif, ligne,1);
-     }
-     if ( v->v_allocatable != 1 && ( v->v_dimsempty != 1) )
-     {
-        /*                ALLOCATION                                          */
-        if ( v->v_dimension != 0  )
-        {
-           if ( v->v_indicetabvars < IndiceMin ||
-                v->v_indicetabvars > IndiceMax )
-           {
-              parcours1 = parcours;
-              compteur = -1;
-              out = 0;
-              indiceprec = parcours->var->v_indicetabvars -1 ;
-              while ( parcours1 && out == 0 &&
-                      !strcasecmp(  parcours->var->v_readedlistdimension,
-                                  parcours1->var->v_readedlistdimension) &&
-                      !strcasecmp(  parcours->var->v_typevar,
-                                  parcours1->var->v_typevar) &&
-                             ( parcours1->var->v_indicetabvars == indiceprec+1 )
-                     )
-              {
-
-               if ( !strcasecmp(parcours1->var->v_modulename,
-                                parcours_nom->o_nom) ||
-                    !strcasecmp(parcours1->var->v_commonname,
-                                parcours_nom->o_nom) )
-                 {
-                      compteur = compteur +1 ;
-                      indiceprec = parcours1->var->v_indicetabvars;
-                      parcoursprec = parcours1;
-                      parcours1 = parcours1->suiv;
-                 }
-                 else out = 1;
-              }
-              if ( compteur > ValeurMax )
-              {
-                 fprintf(allocationagrif,"      DO i = %d , %d\n",
-                                          parcours->var->v_indicetabvars,
-                                       parcours->var->v_indicetabvars+compteur);
-                 IndiceMin = parcours->var->v_indicetabvars;
-                 IndiceMax = parcours->var->v_indicetabvars+compteur;
-                 strcpy (ligne, "allocate ");
-                 strcat (ligne, "(");
-                 strcat (ligne, vargridnametabvars(v,1));
-                 strcat (ligne, vargridparam(v,0));
-                 strcat (ligne, ")");
-                 Save_Length(ligne,48);
-                 tofich (allocationagrif, ligne,1);
-                 fprintf(allocationagrif,"      end do\n");
-                 parcours = parcoursprec;
-              }
-              else
-              {
-                 strcpy (ligne, "allocate ");
-                 strcat (ligne, "(");
-                 strcat (ligne, vargridnametabvars(v,0));
-                 strcat (ligne, vargridparam(v,0));
-                 strcat (ligne, ")");
-                 Save_Length(ligne,48);
-                 tofich (allocationagrif, ligne,1);
-              }
-           }
-        } /* end of the allocation part                                       */
-
-        /*                INITIALISATION                                      */
-        if ( strcasecmp(v->v_initialvalue,"") )
-        {
-           strcpy (ligne, "");
-           strcat (ligne, vargridnametabvars(v,0));
-           /* We should modify the initialvalue in the case of variable has   */
-           /*    been defined with others variables                           */
-
-           strcpy(initialvalue,
-                  ChangeTheInitalvaluebyTabvarsName
-                                      (v->v_initialvalue,List_Global_Var,0));
-           if ( !strcasecmp(initialvalue,v->v_initialvalue) )
-           {
-              strcpy(initialvalue,"");
-              strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
-                                      (v->v_initialvalue,List_Common_Var,0));
-           }
-           if ( !strcasecmp(initialvalue,v->v_initialvalue) )
-           {
-              strcpy(initialvalue,"");
-              strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
-                                     (v->v_initialvalue,List_ModuleUsed_Var,0));
-           }
-           strcat (ligne," = ");
-           strcat (ligne,initialvalue);
-           /*                                                                 */
-           Save_Length(ligne,48);
-           tofich (allocationagrif, ligne,1);
-        }
-     }
-/* Case of structure types */
-        if ((typeiswritten == 0) && !strcasecmp(v->v_typevar,"type"))
-        {
-        sprintf(ligne,"If (.Not.Allocated(Agrif_%s_var)) Then",v->v_modulename);
-        tofich(allocationagrif, ligne, 1);
-        sprintf(ligne,"Allocate(Agrif_%s_var(0:Agrif_NbMaxGrids))",v->v_modulename);
-        tofich(allocationagrif, ligne, 1);
-        strcpy(ligne,"End If");
-        tofich(allocationagrif, ligne, 1);
-        typeiswritten = 1;
-        }
-     if (onlyfixedgrids != 1 && v->v_nbdim!=0)
-     {
-        strcpy (ligne, "   End if");
-        tofich (allocationagrif, ligne,1);
-     }
-  }
-               /***************************************************************/
-               /***************************************************************/
-               /***************************************************************/
+                if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) &&
+                       parcours->var->v_VariableIsParameter == 0                  &&
+                       parcours->var->v_notgrid == 0  )
+                {
+                    v = parcours->var;
+                    IndiceMax = 0;
+                    IndiceMin = indicemaxtabvars[v->v_catvar];
+                    /* body of the file */
+                    if ( !strcasecmp(v->v_commoninfile,cur_filename) )
+                    {
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0));
+                            tofich(allocationagrif,ligne,1);
+                        }
+                        if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) )
+                        {
+                            /*                ALLOCATION                                          */
+                            if ( v->v_dimension != 0 )
+                            {
+                                if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax )
+                                {
+                                    parcours1 = parcours;
+                                    compteur = -1;
+                                    out = 0;
+                                    indiceprec = parcours->var->v_indicetabvars -1 ;
+                                    while ( parcours1 && out == 0
+                                        && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension)
+                                        && !strcasecmp(parcours->var->v_typevar,            parcours1->var->v_typevar)
+                                        && (parcours1->var->v_indicetabvars == indiceprec+1) )
+                                    {
+                                        if ( !strcasecmp(parcours1->var->v_modulename, parcours_nom->o_nom) ||
+                                             !strcasecmp(parcours1->var->v_commonname, parcours_nom->o_nom) )
+                                        {
+                                            compteur = compteur +1 ;
+                                            indiceprec = parcours1->var->v_indicetabvars;
+                                            parcoursprec = parcours1;
+                                            parcours1 = parcours1->suiv;
+                                        }
+                                        else out = 1;
+                                    }
+                                    sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar);
+                                    tofich(allocationagrif,ligne,1);
+                                    if ( compteur > ValeurMax )
+                                    {
+                                        sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars,
+                                                                      parcours->var->v_indicetabvars+compteur);
+                                        tofich(allocationagrif,ligne,1);
+                                        IndiceMin = parcours->var->v_indicetabvars;
+                                        IndiceMax = parcours->var->v_indicetabvars+compteur;
+                                        sprintf(ligne,"    allocate(%s", vargridnametabvars(v,1));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                        tofich(allocationagrif,"enddo",1);
+                                        parcours = parcoursprec;
+                                    }
+                                    else
+                                    {
+                                        sprintf(ligne,"allocate(%s", vargridnametabvars(v,0));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                    }
+                                }
+                            } /* end of the allocation part                                       */
+                            /*                INITIALISATION                                      */
+                            if ( strcasecmp(v->v_initialvalue,"") )
+                            {
+                                strcpy(ligne, vargridnametabvars(v,0));
+                                /* We should modify the initialvalue in the case of variable has been defined with others variables */
+                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var));
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var));
+                                }
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var));
+                                }
+                                strcat (ligne," = ");
+                                strcat (ligne,initialvalue);
+                                Save_Length(ligne,48);
+                                tofich(allocationagrif,ligne,1);
+                            }
+                        }
+                        /* Case of structure types */
+                        if ( (typeiswritten == 0) && !strcasecmp(v->v_typevar,"type") )
+                        {
+                            sprintf(ligne,"if (.not. allocated(Agrif_%s_var)) then",v->v_modulename);
+                            tofich(allocationagrif, ligne, 1);
+                            sprintf(ligne,"    allocate(Agrif_%s_var(0:Agrif_NbMaxGrids))",v->v_modulename);
+                            tofich(allocationagrif, ligne, 1);
+                            tofich(allocationagrif, "endif", 1);
+                            typeiswritten = 1;
+                        }
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            tofich(allocationagrif,"endif",1);
+                        }
+                    }
+                }
+                parcours = parcours -> suiv;
             }
-            parcours = parcours -> suiv;
-         }
-         /*                                                                   */
-         if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
-         {
-            /* add the call to initworkspace                                  */
-            tofich(allocationagrif,"if ( .NOT. Agrif_Root() ) then ",1);
-            fprintf(allocationagrif,"#include \"GetNumberofcells.h\" \n");
-            tofich(allocationagrif,"else ",1);
-            fprintf(allocationagrif,"#include \"SetNumberofcells.h\" \n");
-            tofich(allocationagrif,"endif ",1);
-            tofich(allocationagrif,"Call Agrif_InitWorkspace ",1);
-         }
-         /* Close the file Alloc_agrif                                        */
-         fclose(allocationagrif);
-      } /* end parcours_nom == 1                                              */
-      /*                                                                      */
-      parcours_nom = parcours_nom -> suiv;
-   }
+            if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
+            {
+                fprintf(allocationagrif, "      if ( .not.Agrif_Root() ) then\n");
+                fprintf(allocationagrif, "#include \"GetNumberofcells.h\"\n");
+                fprintf(allocationagrif, "      else\n");
+                fprintf(allocationagrif, "#include \"SetNumberofcells.h\"\n");
+                fprintf(allocationagrif, "      endif\n");
+                fprintf(allocationagrif, "      call Agrif_InitWorkspace\n");
+            }
+            fclose(allocationagrif);
+        }
+        parcours_nom = parcours_nom -> suiv;
+    }
 }
 
@@ -1082,33 +870,30 @@
 /*                                                                            */
 /******************************************************************************/
-void creefichieramr (char *NameTampon)
-{
-  listvar *newvar;
-  variable *v;
-  int erreur;
-  char filefich[LONG_C];
-  char ligne[LONG_C];
-  int IndiceMax;
-  int IndiceMin;
-  int InitEmpty;
-  int VarnameEmpty;
-  int donotwrite;
-
-  FILE *initproc;
-  FILE *initglobal;
-  FILE *createvarname;
-  FILE *createvarnameglobal;
-
-  if ( todebug == 1 ) printf("Enter in creefichieramr\n");
-  strcpy (filefich, "cd ");
-  strcat (filefich, nomdir);
-  erreur = system (filefich);
-  if (erreur)
-  {
-     strcpy (filefich, "mkdir ");
-     strcat (filefich, nomdir);
-     system (filefich);
-     printf ("%s: Directory created\n", nomdir);
-  }
+void creefichieramr ()
+{
+    listvar *newvar;
+    variable *v;
+    int erreur;
+    char filefich[LONG_M];
+
+    int InitEmpty;
+    int VarnameEmpty;
+    int donotwrite;
+
+    FILE *initproc;
+    FILE *initglobal;
+    FILE *createvarname;
+    FILE *createvarnameglobal;
+
+    if ( todebug == 1 ) printf("Enter in creefichieramr\n");
+
+    sprintf(filefich, "cd %s", include_dir);
+    erreur = system (filefich);
+    if (erreur)
+    {
+        sprintf(filefich, "mkdir -p %s", include_dir);
+        system(filefich);
+        printf("%s: Directory created\n", include_dir);
+    }
 
 /******************************************************************************/
@@ -1116,89 +901,62 @@
 /******************************************************************************/
 
-/*----------------------------------------------------------------------------*/
-  if ( todebug == 1 )
-  {
-     strcpy(ligne,"initialisations_agrif_");
-     strcat(ligne,NameTampon);
-     strcat(ligne,".h");
-     initproc = associate (ligne);
-/*----------------------------------------------------------------------------*/
-     strcpy(ligne,"createvarname_agrif_");
-     strcat(ligne,NameTampon);
-     strcat(ligne,".h");
-     createvarname = associate (ligne);
-/*----------------------------------------------------------------------------*/
-     InitEmpty = 1 ;
-     VarnameEmpty = 1 ;
-
-     newvar = List_Global_Var;
-     while ( newvar && todebug == 1 )
-     {
-        donotwrite = 0;
-        v = newvar->var;
-
-        if ( ( v->v_common == 1 || v->v_module == 1 ) && donotwrite == 0 )
-        {
-          write_createvarnameagrif_file(v,createvarname,&VarnameEmpty);
-          write_initialisationsagrif_file(v,initproc,&InitEmpty);
-        }
-        newvar = newvar->suiv;
-     }
-  /*                                                                          */
-     fclose (createvarname);
-     fclose (initproc);
-  /*--------------------------------------------------------------------------*/
-     if ( Did_filetoparse_readed(curmodulename) == 0 )
-     {
-        if ( InitEmpty != 1  )
-        {
-           initglobal = associateaplus("initialisations_agrif.h");
-           strcpy(ligne,"#include \"initialisations_agrif_");
-           strcat(ligne,NameTampon);
-           strcat(ligne,".h\"\n");
-           fprintf(initglobal,ligne);
-           fclose(initglobal);
-        }
-  /*--------------------------------------------------------------------------*/
-        if ( VarnameEmpty != 1 )
-        {
-           createvarnameglobal= associateaplus("createvarname_agrif.h");
-           strcpy(ligne,"#include \"createvarname_agrif_");
-           strcat(ligne,NameTampon);
-           strcat(ligne,".h\"\n");
-           fprintf(createvarnameglobal,ligne);
-           fclose(createvarnameglobal);
-        }
-     }
-  }
-/*----------------------------------------------------------------------------*/
-/*----------------------------------------------------------------------------*/
-/*----------------------------------------------------------------------------*/
-/*----------------------------------------------------------------------------*/
-/*----------------------------------------------------------------------------*/
-  IndiceMax = 0;
-  IndiceMin = 0;
-
-  write_allocation_Common_0();
-  write_allocation_Global_0();
-
-  Write_Alloc_Agrif_Files();
-  write_probdimagrif_file();
-  write_keysagrif_file();
-  write_modtypeagrif_file();
-  if ( NbMailleXDefined == 1 )
-                             write_Setnumberofcells_file("SetNumberofcells.h");
-  if ( NbMailleXDefined == 1 )
-                             write_Getnumberofcells_file("GetNumberofcells.h");
-  retour77 = 0;
-  if ( NbMailleXDefined == 1 )
-                          write_Setnumberofcells_file("SetNumberofcellsFree.h");
-  if ( NbMailleXDefined == 1 )
-                          write_Getnumberofcells_file("GetNumberofcellsFree.h");
-  retour77 = 1;
-  if ( NbMailleXDefined == 1 )
-                         write_Setnumberofcells_file("SetNumberofcellsFixed.h");
-  if ( NbMailleXDefined == 1 )
-                         write_Getnumberofcells_file("GetNumberofcellsFixed.h");
-  if ( todebug == 1 ) printf("Out of creefichieramr\n");
-}
+    if ( todebug == 1 )
+    {
+        const char *NameTampon = "toto";
+        sprintf(filefich,"initialisations_agrif_%s.h", NameTampon);
+        initproc = open_for_write(filefich);
+
+        sprintf(filefich,"createvarname_agrif_%s.h", NameTampon);
+        createvarname = open_for_write(filefich);
+
+        InitEmpty = 1 ;
+        VarnameEmpty = 1 ;
+
+        newvar = List_Global_Var;
+        while ( newvar )
+        {
+            donotwrite = 0;
+            v = newvar->var;
+
+            if ( ( v->v_common == 1 || v->v_module == 1 ) && donotwrite == 0 )
+            {
+                write_createvarnameagrif_file(v,createvarname,&VarnameEmpty);
+                write_initialisationsagrif_file(v,initproc,&InitEmpty);
+            }
+            newvar = newvar->suiv;
+        }
+        fclose (createvarname);
+        fclose (initproc);
+
+        if ( is_dependfile_created(curmodulename) == 0 )
+        {
+            if ( InitEmpty != 1  )
+            {
+                initglobal = open_for_append("initialisations_agrif.h");
+                fprintf(initglobal,"#include \"initialisations_agrif_%s.h\"\n", NameTampon);
+                fclose(initglobal);
+            }
+            if ( VarnameEmpty != 1 )
+            {
+                createvarnameglobal= open_for_append("createvarname_agrif.h");
+                fprintf(createvarnameglobal,"#include \"createvarname_agrif_%s.h\"\n", NameTampon);
+                fclose(createvarnameglobal);
+            }
+        }
+    }
+    write_allocation_Common_0();
+    write_allocation_Global_0();
+
+    Write_Alloc_Agrif_Files();
+    write_probdimagrif_file();
+    write_keysagrif_file();
+    write_modtypeagrif_file();
+
+    if ( NbMailleXDefined == 1 )
+    {
+        write_Setnumberofcells_file();
+        write_Getnumberofcells_file();
+    }
+
+    if ( todebug == 1 ) printf("Out of creefichieramr\n");
+}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90	(revision 5682)
@@ -24,5 +24,7 @@
    !                                                   !!* namicerun read in iceini  *
    CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in     !: suffix of ice restart name (input)
+   CHARACTER(len=256)    , PUBLIC ::   cn_icerst_indir  !: ice restart in directory
    CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out    !: suffix of ice restart name (output)
+   CHARACTER(len=256)    , PUBLIC ::   cn_icerst_outdir !: ice restart out directory
    LOGICAL               , PUBLIC ::   ln_limdyn        !: flag for ice dynamics (T) or not (F)
    LOGICAL               , PUBLIC ::   ln_limdmp        !: Ice damping
@@ -35,5 +37,5 @@
    INTEGER , PUBLIC ::   nbiter      !: number of sub-time steps for relaxation
    INTEGER , PUBLIC ::   nbitdr      !: maximum number of iterations for relaxation
-   INTEGER , PUBLIC ::   nevp        !: number of EVP subcycling iterations
+   INTEGER , PUBLIC ::   nn_nevp     !: number of EVP subcycling iterations
    INTEGER , PUBLIC ::   telast      !: timescale for EVP elastic waves
    REAL(wp), PUBLIC ::   epsd        !: tolerance parameter for dynamic
@@ -47,11 +49,10 @@
    REAL(wp), PUBLIC ::   c_rhg       !: second bulk-rhelogy parameter
    REAL(wp), PUBLIC ::   etamn       !: minimun value for viscosity
-   REAL(wp), PUBLIC ::   creepl      !: creep limit
-   REAL(wp), PUBLIC ::   ecc         !: eccentricity of the elliptical yield curve
+   REAL(wp), PUBLIC ::   rn_creepl   !: creep limit
+   REAL(wp), PUBLIC ::   rn_ecc      !: eccentricity of the elliptical yield curve
    REAL(wp), PUBLIC ::   ahi0        !: sea-ice hor. eddy diffusivity coeff. (m2/s)
    REAL(wp), PUBLIC ::   alphaevp    !: coefficient for the solution of EVP int. stresses
-   REAL(wp), PUBLIC ::   hminrhg = 0.001_wp    !: clem : ice volume (a*h in m) below which ice velocity is set to ocean velocity
-
-   REAL(wp), PUBLIC ::   usecc2                !:  = 1.0 / ( ecc * ecc )
+
+   REAL(wp), PUBLIC ::   usecc2                !:  = 1.0 / ( rn_ecc * rn_ecc )
    REAL(wp), PUBLIC ::   rhoco                 !: = rau0 * cw
    REAL(wp), PUBLIC ::   sangvg, cangvg        !: sin and cos of the turning angle for ocean stress
@@ -66,7 +67,4 @@
 
    !!* Ice Rheology
-
-   LOGICAL , PUBLIC::  ltrcdm2dc_ice = .FALSE.              !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux
-
 # if defined key_lim2_vp
    !                                                      !!* VP rheology *
@@ -114,5 +112,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qdtcn         !: energy from the ice to the ocean point (at a factor 2)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   thcm          !: part of the solar energy used in the lead heat budget
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric_daymean!: Solar flux transmitted trough the ice, for day mean of qsr ( PISCES, with dirunal cycle )
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric_mean   !: Solar flux transmitted trough the ice, for day mean of qsr ( PISCES, with dirunal cycle )
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric        !: Solar flux transmitted trough the ice
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ffltbif       !: linked with the max heat contained in brine pockets (?)
@@ -174,6 +172,4 @@
          &     tbif  (jpi,jpj,jplayersp1)                           , STAT=ierr(5))
 
-      IF( ltrcdm2dc_ice ) ALLOCATE(fstric_daymean(jpi,jpj), STAT=ierr(6) )
-
       !* moment used in the advection scheme
       ALLOCATE(sxice (jpi,jpj) , syice (jpi,jpj) , sxxice(jpi,jpj) ,     &
@@ -202,5 +198,4 @@
    !!   Default option         Empty module        NO LIM 2.0 sea-ice model
    !!----------------------------------------------------------------------
-   LOGICAL , PUBLIC::  ltrcdm2dc_ice = .FALSE.              !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux
 #endif
    !!-----------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90	(revision 5682)
@@ -40,5 +40,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -60,9 +60,4 @@
       ENDIF
       !                                
-      ! When Diurnal cycle, core bulk and LIM2  are activated, 
-      ! a daily mean qsr is computed for tracer/biogeochemistery model                                 !
-      IF( ltrcdm2dc )THEN  ; ltrcdm2dc_ice = .TRUE.
-      ELSE                 ; ltrcdm2dc_ice = .FALSE.
-      ENDIF
       !                                ! Allocate the ice arrays
       ierr =        ice_alloc_2    ()       ! ice variables
@@ -123,5 +118,6 @@
       !! ** input   :   Namelist namicerun
       !!-------------------------------------------------------------------
-      NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, ln_limdmp, acrit, hsndif, hicdif
+      NAMELIST/namicerun/ cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, &
+                          ln_limdyn, ln_limdmp, acrit, hsndif, hicdif
       INTEGER  ::   ios                 ! Local integer output status for namelist read
       !!-------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90	(revision 5682)
@@ -227,6 +227,6 @@
       NAMELIST/namicedyn/ epsd, alpha,     &
          &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   &
-         &                c_rhg, etamn, creepl, ecc, ahi0,                  &
-         &                nevp, telast, alphaevp, hminrhg
+         &                c_rhg, etamn, rn_creepl, rn_ecc, ahi0,                  &
+         &                nn_nevp, telast, alphaevp
       !!-------------------------------------------------------------------
                     
@@ -256,11 +256,10 @@
          WRITE(numout,*) '       second bulk-rhelogy parameter                    c_rhg  = ', c_rhg
          WRITE(numout,*) '       minimun value for viscosity                      etamn  = ', etamn
-         WRITE(numout,*) '       creep limit                                      creepl = ', creepl
-         WRITE(numout,*) '       eccentricity of the elliptical yield curve       ecc    = ', ecc
+         WRITE(numout,*) '       creep limit                                      rn_creepl = ', rn_creepl
+         WRITE(numout,*) '       eccentricity of the elliptical yield curve       rn_ecc = ', rn_ecc
          WRITE(numout,*) '       horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0
-         WRITE(numout,*) '       number of iterations for subcycling nevp   = ', nevp
+         WRITE(numout,*) '       number of iterations for subcycling              nn_nevp= ', nn_nevp
          WRITE(numout,*) '       timescale for elastic waves telast = ', telast
          WRITE(numout,*) '       coefficient for the solution of int. stresses alphaevp = ', alphaevp
-         WRITE(numout,*) '       min ice thickness for rheology calculations     hminrhg = ', hminrhg
       ENDIF
       !
@@ -272,5 +271,5 @@
 
       !  Initialization
-      usecc2 = 1.0 / ( ecc * ecc )
+      usecc2 = 1.0 / ( rn_ecc * rn_ecc )
       rhoco  = rau0 * cw
       angvg  = angvg * rad      ! convert angvg from degree to radian
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 5682)
@@ -69,5 +69,6 @@
       IF( .NOT. ln_limini ) THEN  
          
-         tfu(:,:) = eos_fzp( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius]
+         CALL eos_fzp( tsn(:,:,1,jp_sal), tfu(:,:) )       ! freezing/melting point of sea water [Celcius]
+         tfu(:,:) = tfu(:,:) *  tmask(:,:,1)
 
          DO jj = 1, jpj
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90	(revision 5682)
@@ -266,5 +266,5 @@
 
                !  Creep limit depends on the size of the grid.
-               zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ),  creepl)
+               zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ),  rn_creepl)
 
                !-  Computation of viscosities.
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90	(revision 5682)
@@ -50,4 +50,5 @@
       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
       CHARACTER(LEN=50)   ::   clname   ! ice output restart file name
+      CHARACTER(len=150)  ::   clpath   ! full path to ice output restart file
       !!----------------------------------------------------------------------
       !
@@ -58,24 +59,30 @@
       ! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1
       IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN
-         ! beware of the format used to write kt (default is i8.8, that should be large enough...)
-         IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
-         ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
+         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
+            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
+            ENDIF
+            ! create the file
+            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
+            clpath = TRIM(cn_icerst_outdir) 
+            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/' 
+            IF(lwp) THEN
+               WRITE(numout,*)
+               SELECT CASE ( jprstlib )
+               CASE ( jprstdimg )
+                  WRITE(numout,*) '             open ice restart binary file: ',TRIM(clpath)//clname
+               CASE DEFAULT
+                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname
+               END SELECT
+               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
+                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
+               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
+               ENDIF
+            ENDIF
+
+            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib )
+            lrst_ice = .TRUE.
          ENDIF
-         ! create the file
-         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
-         IF(lwp) THEN
-            WRITE(numout,*)
-            SELECT CASE ( jprstlib )
-            CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ice restart binary file: '//clname
-            CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname
-            END SELECT
-            IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
-               WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
-            ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
-            ENDIF
-         ENDIF
-
-         CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib )
-         lrst_ice = .TRUE.
       ENDIF
       !
@@ -188,9 +195,9 @@
         ! eventually read netcdf file (monobloc)  for restarting on different number of processors
         ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90
-        INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok )
+        INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok )
         IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
       ENDIF
 
-      CALL iom_open ( cn_icerst_in, numrir, kiolib = jlibalt )
+      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in), numrir, kiolib = jlibalt )
 
       CALL iom_get( numrir, 'kt_ice' , ziter )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90	(revision 5682)
@@ -46,5 +46,4 @@
    PUBLIC   lim_sbc_flx_2      ! called by sbc_ice_lim_2
    PUBLIC   lim_sbc_tau_2      ! called by sbc_ice_lim_2
-   PUBLIC   lim_bio_meanqsr_2  ! called by sbc_ice_lim_2
 
    REAL(wp)  ::   r1_rdtice            ! = 1. / rdt_ice 
@@ -97,5 +96,5 @@
       !!              - fr_i    : ice fraction
       !!              - tn_ice  : sea-ice surface temperature
-      !!              - alb_ice : sea-ice albedo (lk_cpl=T)
+      !!              - alb_ice : sea-ice albedo (ln_cpl=T)
       !!
       !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
@@ -179,5 +178,5 @@
 
             !   computation the solar flux at ocean surface
-            IF( lk_cpl ) THEN
+            IF( ln_cpl ) THEN
                zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) )
             ELSE
@@ -203,5 +202,5 @@
             ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area)
             !                                                  ! coupled mode: 
-            IF( lk_cpl ) THEN
+            IF( ln_cpl ) THEN
                zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area)
                   &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice
@@ -253,5 +252,5 @@
       !-----------------------------------------------!
 
-      IF( lk_cpl) THEN
+      IF( ln_cpl) THEN
          tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature       
          ht_i(:,:,1) = hicif(:,:)
@@ -430,18 +429,4 @@
    END SUBROUTINE lim_sbc_tau_2
 
-   SUBROUTINE lim_bio_meanqsr_2
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE lim_bio_meanqsr
-      !!
-      !! ** Purpose :   provide daily qsr_mean for PISCES when 
-      !!                analytic diurnal cycle is applied in physic
-      !!
-      !! ** Method  :   add part under ice
-      !!
-      !!---------------------------------------------------------------------
-
-      qsr_mean(:,:) =  pfrld(:,:) * qsr_mean(:,:) + ( 1. - pfrld(:,:) ) * fstric_daymean(:,:)
-
-   END SUBROUTINE lim_bio_meanqsr_2
 
    SUBROUTINE lim_sbc_init_2
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90	(revision 5682)
@@ -114,5 +114,5 @@
       CALL wrk_alloc( jpi, jpj, jpk, zmsk )
 
-      IF( kt == nit000 )   CALL lim_thd_init_2  ! Initialization (first time-step only)
+      IF( kt == nit000 )   CALL lim_thd_init_2   ! Initialization (first time-step only)
    
       !-------------------------------------------!
@@ -137,5 +137,4 @@
       rdq_ice(:,:) = 0.e0   ! heat content associated with rdm_ice
       zmsk (:,:,:) = 0.e0
-      IF( ltrcdm2dc_ice  ) fstric_daymean (:,:) = 0.e0   ! part of solar radiation absorbing inside the ice
 
       ! set to zero snow thickness smaller than epsi04
@@ -217,5 +216,5 @@
                         
             !  partial computation of the lead energy budget (qldif)
-            IF( lk_cpl ) THEN 
+            IF( ln_cpl ) THEN 
                qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                                  &
                   &    * (   ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) )   &
@@ -285,11 +284,9 @@
          CALL tab_2d_1d_2( nbpb, tbif_1d    (1:nbpb , 3 ), tbif(:,:,3)    , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, qsr_ice_1d (1:nbpb)     , qsr_ice(:,:,1) , jpi, jpj, npb(1:nbpb) )
-         IF( ltrcdm2dc_ice ) &
-         & CALL tab_2d_1d_2( nbpb, qsr_ice_mean_1d (1:nbpb), qsr_ice_mean(:,:,1), jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, fr1_i0_1d  (1:nbpb)     , fr1_i0         , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, fr2_i0_1d  (1:nbpb)     , fr2_i0         , jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb,  qns_ice_1d(1:nbpb)     ,  qns_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
          CALL tab_2d_1d_2( nbpb, dqns_ice_1d(1:nbpb)     , dqns_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
-         IF( .NOT. lk_cpl ) THEN 
+         IF( .NOT. ln_cpl ) THEN 
             CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb)     ,  qla_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
             CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb)     , dqla_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
@@ -336,9 +333,5 @@
          CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb)  , jpi, jpj )
          CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb)  , jpi, jpj )
-         IF( ltrcdm2dc_ice )THEN
-            CALL tab_1d_2d_2( nbpb, fstric_daymean     , npb, fstbif_daymean_1d (1:nbpb)  , jpi, jpj )
-            CALL tab_1d_2d_2( nbpb, qsr_ice_mean(:,:,1), npb,    qsr_ice_mean_1d(1:nbpb)  , jpi, jpj )
-         ENDIF
-         IF( .NOT. lk_cpl )   CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb)             , jpi, jpj )
+         IF( .NOT. ln_cpl )   CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj )
          !
       ENDIF
@@ -441,5 +434,5 @@
       IF( iom_use('qsr_ai_cea' ) )   CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) )   ! Solar flux over the ice     [W/m2]
       IF( iom_use('qns_ai_cea' ) )   CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) )   ! Non-solar flux over the ice [W/m2]
-      IF( iom_use('qla_ai_cea' ) .AND. .NOT. lk_cpl ) &
+      IF( iom_use('qla_ai_cea' ) .AND. .NOT. ln_cpl ) &
          &                           CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) )   ! Latent flux over the ice [W/m2]
       !
@@ -564,5 +557,5 @@
       IF(lwm) WRITE ( numoni, namicethd )
 
-      IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )
+      IF( ln_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )
       !
       IF(lwp) THEN                          ! control print
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90	(revision 5682)
@@ -18,5 +18,5 @@
    USE ice_2
    USE limistate_2
-   USE sbc_oce, ONLY : lk_cpl
+   USE sbc_oce, ONLY : ln_cpl
    USE in_out_manager
    USE lib_mpp          ! MPP library
@@ -273,16 +273,4 @@
        END DO
 
-       IF( ltrcdm2dc_ice )THEN
-
-          DO ji = kideb , kiut
-             zihsn  = MAX( zzero , SIGN (zone , -h_snow_1d(ji) ) )
-             zihic  = MAX( zzero , 1.0 - ( h_ice_1d(ji) / zhsu ) )
-             zi0(ji)  = zihsn * ( fr1_i0_1d(ji) + zihic * fr2_i0_1d(ji) )
-             zexp     = MIN( zone , EXP( -1.5 * ( h_ice_1d(ji) - zhsu ) ) )
-             fstbif_daymean_1d(ji) = zi0(ji) * qsr_ice_mean_1d(ji) * zexp
-          END DO
-
-       ENDIF
-
        !--------------------------------------------------------------------------------
        !  4. Computation of the surface temperature : determined by considering the 
@@ -337,5 +325,5 @@
        !----------------------------------------------------------------------  
                      
-       IF ( .NOT. lk_cpl ) THEN   ! duplicate the loop for performances issues
+       IF ( .NOT. ln_cpl ) THEN   ! duplicate the loop for performances issues
           DO ji = kideb, kiut
              sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90	(revision 5682)
@@ -55,8 +55,6 @@
       fstbif_1d   ,     &  !:    "                  "      fstric
       fltbif_1d   ,     &  !:    "                  "      ffltbif
-      fstbif_daymean_1d, & !:    "                  " fstric_daymean
       fscbq_1d    ,     &  !:    "                  "      fscmcbq
       qsr_ice_1d  ,     &  !:    "                  "      qsr_ice
-      qsr_ice_mean_1d , &  !:    "                  "      qsr_ice_mean
       fr1_i0_1d   ,     &  !:    "                  "      fr1_i0
       fr2_i0_1d   ,     &  !:    "                  "      fr2_i0
@@ -122,6 +120,4 @@
          &      tbif_1d(jpij, jplayersp1), Stat=ierr(4))
          !
-      IF( ltrcdm2dc_ice )ALLOCATE(fstbif_daymean_1d(jpij),qsr_ice_mean_1d(jpij),Stat=ierr(5))
-         !
       thd_ice_alloc_2 = MAXVAL(ierr)
       IF( thd_ice_alloc_2 /= 0 )   CALL ctl_warn('thd_ice_alloc_2: failed to allocate arrays')
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90	(revision 5682)
@@ -5,7 +5,6 @@
    !!======================================================================
    !! History :  3.0  ! 2003-08  (M. Vancoppenolle)  LIM-3 original code
-   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
+   !!            3.5  ! 2011-02  (G. Madec) dynamical allocation
    !!----------------------------------------------------------------------
-   USE par_ice        ! LIM-3 parameter
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
@@ -21,11 +20,5 @@
    INTEGER, PUBLIC ::   njeq , njeqm1        !: j-index of the equator if it is inside the domain
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fcor       !: coriolis coefficient
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   covrai     !: sine of geographic latitude
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   area       !: surface of grid cell 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tms, tmi   !: temperature mask, mask for stress
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmu, tmv   !: mask at u and v velocity points
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmf        !: mask at f-point
-
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   fcor   !: coriolis coefficient
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   wght   !: weight of the 4 neighbours to compute averages
 
@@ -44,10 +37,5 @@
       !!-------------------------------------------------------------------
       !
-      ALLOCATE( fcor(jpi,jpj)                   ,      &
-         &      covrai(jpi,jpj) , area(jpi,jpj) ,      &
-         &      tms   (jpi,jpj) , tmi (jpi,jpj) ,      &
-         &      tmu   (jpi,jpj) , tmv (jpi,jpj) ,      &
-         &      tmf   (jpi,jpj) ,                      &
-         &      wght(jpi,jpj,2,2)               , STAT = dom_ice_alloc )
+      ALLOCATE( fcor(jpi,jpj), wght(jpi,jpj,2,2), STAT = dom_ice_alloc )
       !
       IF( dom_ice_alloc /= 0 )   CALL ctl_warn( 'dom_ice_alloc: failed to allocate arrays.' )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 5682)
@@ -11,5 +11,4 @@
    !!   'key_lim3'                                      LIM-3 sea-ice model
    !!----------------------------------------------------------------------
-   USE par_ice        ! LIM sea-ice parameters
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
@@ -18,5 +17,5 @@
    PRIVATE
 
-   PUBLIC    ice_alloc  !  Called in iceini.F90
+   PUBLIC    ice_alloc  !  Called in sbc_lim_init
 
    !!======================================================================
@@ -110,7 +109,7 @@
    !! smv_i       |      -      |    Sea ice salt content         | ppt.m |
    !! oa_i        !      -      !    Sea ice areal age content    | day   |
-   !! e_i         !      -      !    Ice enthalpy                 | 10^9 J| 
+   !! e_i         !      -      !    Ice enthalpy                 | J/m2  | 
    !!      -      ! q_i_1d      !    Ice enthalpy per unit vol.   | J/m3  | 
-   !! e_s         !      -      !    Snow enthalpy                | 10^9 J| 
+   !! e_s         !      -      !    Snow enthalpy                | J/m2  | 
    !!      -      ! q_s_1d      !    Snow enthalpy per unit vol.  | J/m3  | 
    !!                                                                     |
@@ -148,6 +147,6 @@
    !! tm_i        |      -      |    Mean sea ice temperature     | K     |
    !! ot_i        !      -      !    Sea ice areal age content    | day   |
-   !! et_i        !      -      !    Total ice enthalpy           | 10^9 J| 
-   !! et_s        !      -      !    Total snow enthalpy          | 10^9 J| 
+   !! et_i        !      -      !    Total ice enthalpy           | J/m2  | 
+   !! et_s        !      -      !    Total snow enthalpy          | J/m2  | 
    !! bv_i        !      -      !    Mean relative brine volume   | ???   | 
    !!=====================================================================
@@ -165,67 +164,68 @@
    REAL(wp), PUBLIC ::   r1_rdtice        !: = 1. / rdt_ice
 
-   !                                     !!** ice-dynamic namelist (namicedyn) **
-   INTEGER , PUBLIC ::   nevp             !: number of iterations for subcycling
-   REAL(wp), PUBLIC ::   epsd             !: tolerance parameter for dynamic
-   REAL(wp), PUBLIC ::   om               !: relaxation constant
-   REAL(wp), PUBLIC ::   cw               !: drag coefficient for oceanic stress
-   REAL(wp), PUBLIC ::   pstar            !: determines ice strength (N/M), Hibler JPO79
-   REAL(wp), PUBLIC ::   c_rhg            !: determines changes in ice strength
-   REAL(wp), PUBLIC ::   creepl           !: creep limit : has to be under 1.0e-9
-   REAL(wp), PUBLIC ::   ecc              !: eccentricity of the elliptical yield curve
-   REAL(wp), PUBLIC ::   ahi0             !: sea-ice hor. eddy diffusivity coeff. (m2/s)
-   REAL(wp), PUBLIC ::   telast           !: timescale for elastic waves (s)
-   REAL(wp), PUBLIC ::   relast           !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 
-   REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses 
-   REAL(wp), PUBLIC ::   hminrhg          !: ice volume (a*h, in m) below which ice velocity is set to ocean velocity
+   !                                     !!** ice-thickness distribution namelist (namiceitd) **
+   INTEGER , PUBLIC ::   nn_catbnd        !: categories distribution following: tanh function (1), or h^(-alpha) function (2)
+   REAL(wp), PUBLIC ::   rn_himean        !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only)
+
+   !                                     !!** ice-dynamics namelist (namicedyn) **
+   LOGICAL , PUBLIC ::   ln_icestr_bvf    !: use brine volume to diminish ice strength
+   INTEGER , PUBLIC ::   nn_icestr        !: ice strength parameterization (0=Hibler79 1=Rothrock75)
+   INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling
+   INTEGER , PUBLIC ::   nn_ahi0          !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation)
+   REAL(wp), PUBLIC ::   rn_pe_rdg        !: ridging work divided by pot. energy change in ridging, nn_icestr = 1
+   REAL(wp), PUBLIC ::   rn_cio           !: drag coefficient for oceanic stress
+   REAL(wp), PUBLIC ::   rn_pstar         !: determines ice strength (N/M), Hibler JPO79
+   REAL(wp), PUBLIC ::   rn_crhg          !: determines changes in ice strength
+   REAL(wp), PUBLIC ::   rn_creepl        !: creep limit : has to be under 1.0e-9
+   REAL(wp), PUBLIC ::   rn_ecc           !: eccentricity of the elliptical yield curve
+   REAL(wp), PUBLIC ::   rn_ahi0_ref      !: sea-ice hor. eddy diffusivity coeff. (m2/s)
+   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 
 
    !                                     !!** ice-salinity namelist (namicesal) **
-   REAL(wp), PUBLIC ::   s_i_max          !: maximum ice salinity [PSU]
-   REAL(wp), PUBLIC ::   s_i_min          !: minimum ice salinity [PSU]
-   REAL(wp), PUBLIC ::   s_i_0            !: 1st sal. value for the computation of sal .prof. [PSU]
-   REAL(wp), PUBLIC ::   s_i_1            !: 2nd sal. value for the computation of sal .prof. [PSU]
-   REAL(wp), PUBLIC ::   sal_G            !: restoring salinity for gravity drainage [PSU]
-   REAL(wp), PUBLIC ::   sal_F            !: restoring salinity for flushing [PSU]
-   REAL(wp), PUBLIC ::   time_G           !: restoring time constant for gravity drainage (= 20 days) [s]
-   REAL(wp), PUBLIC ::   time_F           !: restoring time constant for gravity drainage (= 10 days) [s]
-   REAL(wp), PUBLIC ::   bulk_sal         !: bulk salinity (ppt) in case of constant salinity
+   REAL(wp), PUBLIC ::   rn_simax         !: maximum ice salinity [PSU]
+   REAL(wp), PUBLIC ::   rn_simin         !: minimum ice salinity [PSU]
+   REAL(wp), PUBLIC ::   rn_sal_gd        !: restoring salinity for gravity drainage [PSU]
+   REAL(wp), PUBLIC ::   rn_sal_fl        !: restoring salinity for flushing [PSU]
+   REAL(wp), PUBLIC ::   rn_time_gd       !: restoring time constant for gravity drainage (= 20 days) [s]
+   REAL(wp), PUBLIC ::   rn_time_fl       !: restoring time constant for gravity drainage (= 10 days) [s]
+   REAL(wp), PUBLIC ::   rn_icesal        !: bulk salinity (ppt) in case of constant salinity
 
    !                                     !!** ice-salinity namelist (namicesal) **
-   INTEGER , PUBLIC ::   num_sal             !: salinity configuration used in the model
+   INTEGER , PUBLIC ::   nn_icesal           !: salinity configuration used in the model
    !                                         ! 1 - constant salinity in both space and time
    !                                         ! 2 - prognostic salinity (s(z,t))
    !                                         ! 3 - salinity profile, constant in time
-   INTEGER , PUBLIC ::   thcon_i_swi         !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007)
+   INTEGER , PUBLIC ::   nn_ice_thcon        !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007)
+   INTEGER , PUBLIC ::   nn_monocat          !: virtual ITD mono-category parameterizations (1) or not (0)
+   LOGICAL , PUBLIC ::   ln_it_qnsice        !: iterate surface flux with changing surface temperature or not (F)
 
    !                                     !!** ice-mechanical redistribution namelist (namiceitdme)
-   REAL(wp), PUBLIC ::   Cs               !: fraction of shearing energy contributing to ridging            
-   REAL(wp), PUBLIC ::   Cf               !: ratio of ridging work to PE loss
-   REAL(wp), PUBLIC ::   fsnowrdg         !: fractional snow loss to the ocean during ridging
-   REAL(wp), PUBLIC ::   fsnowrft         !: fractional snow loss to the ocean during ridging
-   REAL(wp), PUBLIC ::   Gstar            !: fractional area of young ice contributing to ridging
-   REAL(wp), PUBLIC ::   astar            !: equivalent of G* for an exponential participation function
-   REAL(wp), PUBLIC ::   Hstar            !: thickness that determines the maximal thickness of ridged ice
-   REAL(wp), PUBLIC ::   hparmeter        !: threshold thickness (m) for rafting / ridging 
-   REAL(wp), PUBLIC ::   Craft            !: coefficient for smoothness of the hyperbolic tangent in rafting
-   REAL(wp), PUBLIC ::   ridge_por        !: initial porosity of ridges (0.3 regular value)
-   REAL(wp), PUBLIC ::   betas            !: coef. for partitioning of snowfall between leads and sea ice
-   REAL(wp), PUBLIC ::   kappa_i          !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m]
-   REAL(wp), PUBLIC ::   nconv_i_thd      !: maximal number of iterations for heat diffusion
-   REAL(wp), PUBLIC ::   maxer_i_thd      !: maximal tolerated error (C) for heat diffusion
+   REAL(wp), PUBLIC ::   rn_cs            !: fraction of shearing energy contributing to ridging            
+   REAL(wp), PUBLIC ::   rn_fsnowrdg      !: fractional snow loss to the ocean during ridging
+   REAL(wp), PUBLIC ::   rn_fsnowrft      !: fractional snow loss to the ocean during ridging
+   REAL(wp), PUBLIC ::   rn_gstar         !: fractional area of young ice contributing to ridging
+   REAL(wp), PUBLIC ::   rn_astar         !: equivalent of G* for an exponential participation function
+   REAL(wp), PUBLIC ::   rn_hstar         !: thickness that determines the maximal thickness of ridged ice
+   REAL(wp), PUBLIC ::   rn_hraft         !: threshold thickness (m) for rafting / ridging 
+   REAL(wp), PUBLIC ::   rn_craft         !: coefficient for smoothness of the hyperbolic tangent in rafting
+   REAL(wp), PUBLIC ::   rn_por_rdg       !: initial porosity of ridges (0.3 regular value)
+   REAL(wp), PUBLIC ::   rn_betas         !: coef. for partitioning of snowfall between leads and sea ice
+   REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m]
+   REAL(wp), PUBLIC ::   nn_conv_dif      !: maximal number of iterations for heat diffusion
+   REAL(wp), PUBLIC ::   rn_terr_dif      !: maximal tolerated error (C) for heat diffusion
 
    !                                     !!** ice-mechanical redistribution namelist (namiceitdme)
-   INTEGER , PUBLIC ::   ridge_scheme_swi !: scheme used for ice ridging
-   INTEGER , PUBLIC ::   raft_swi         !: rafting of ice or not                        
-   INTEGER , PUBLIC ::   partfun_swi      !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007)
-   INTEGER , PUBLIC ::   brinstren_swi    !: use brine volume to diminish ice strength
-
-   REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( ecc * ecc )
-   REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cw
-
+   LOGICAL , PUBLIC ::   ln_rafting      !: rafting of ice or not                        
+   INTEGER , PUBLIC ::   nn_partfun      !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007)
+
+   REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( rn_ecc * rn_ecc )
+   REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cio
+   REAL(wp), PUBLIC ::   r1_nlay_i        !: 1 / nlay_i
+   REAL(wp), PUBLIC ::   r1_nlay_s        !: 1 / nlay_s 
+   !
    !                                     !!** switch for presence of ice or not 
    REAL(wp), PUBLIC ::   rswitch
-
+   !
    !                                     !!** define some parameters 
-   REAL(wp), PUBLIC, PARAMETER ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy
    REAL(wp), PUBLIC, PARAMETER ::   epsi06   = 1.e-06_wp  !: small number 
    REAL(wp), PUBLIC, PARAMETER ::   epsi10   = 1.e-10_wp  !: small number 
@@ -266,4 +266,8 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice [kg/m2]
 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total) [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_thd     !: ice concentration tendency (thermodynamics) [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_dyn     !: ice concentration tendency (dynamics) [s-1]
+
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s]
@@ -282,4 +286,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations 
@@ -296,7 +301,4 @@
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice
-
-   ! temporary arrays for dummy version of the code
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dh_i_surf2D, dh_i_bott2D, q_s
 
    !!--------------------------------------------------------------------------
@@ -333,5 +335,5 @@
       
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i        !: ice temperatures          [K]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i        !: ice thermal contents [Giga J]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i        !: ice thermal contents    [J/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   s_i        !: ice salinities          [PSU]
 
@@ -356,57 +358,47 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity
-      
-
-   !!--------------------------------------------------------------------------
-   !! * Increment of global variables
-   !!--------------------------------------------------------------------------
+            
+   !!--------------------------------------------------------------------------
+   !! * Ice thickness distribution variables
+   !!--------------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories 
+
+   !!--------------------------------------------------------------------------
+   !! * Ice Run
+   !!--------------------------------------------------------------------------
+   !                                                  !!: ** Namelist namicerun read in sbc_lim_init **
+   INTEGER          , PUBLIC ::   jpl             !: number of ice  categories 
+   INTEGER          , PUBLIC ::   nlay_i          !: number of ice  layers 
+   INTEGER          , PUBLIC ::   nlay_s          !: number of snow layers 
+   CHARACTER(len=32), PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input)
+   CHARACTER(len=256), PUBLIC ::   cn_icerst_indir !: ice restart input directory
+   CHARACTER(len=32), PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output)
+   CHARACTER(len=256), PUBLIC ::   cn_icerst_outdir!: ice restart output directory
+   LOGICAL          , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F)
+   LOGICAL          , PUBLIC ::   ln_icectl       !: flag for sea-ice points output (T) or not (F)
+   REAL(wp)         , PUBLIC ::   rn_amax         !: maximum ice concentration
+   INTEGER          , PUBLIC ::   iiceprt         !: debug i-point
+   INTEGER          , PUBLIC ::   jiceprt         !: debug j-point
+   !
+   !!--------------------------------------------------------------------------
+   !! * Ice diagnostics
+   !!--------------------------------------------------------------------------
+   ! Increment of global variables
    ! thd refers to changes induced by thermodynamics
    ! trp   ''         ''     ''       advection (transport of ice)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_a_i_thd  , d_a_i_trp                 !: icefractions                  
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_s_thd  , d_v_s_trp                 !: snow volume
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_i_thd  , d_v_i_trp                 !: ice  volume
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_smv_i_thd, d_smv_i_trp               !:     
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_fl  , d_sm_i_gd                 !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_se  , d_sm_i_si  , d_sm_i_la    !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_oa_i_thd , d_oa_i_trp                !:
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_s_thd  , d_e_s_trp     !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_i_thd  , d_e_i_trp     !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   d_u_ice_dyn, d_v_ice_dyn   !: ice velocity 
-      
-   !!--------------------------------------------------------------------------
-   !! * Ice thickness distribution variables
-   !!--------------------------------------------------------------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories 
-
-   !!--------------------------------------------------------------------------
-   !! * Ice Run
-   !!--------------------------------------------------------------------------
-   !                                                  !!: ** Namelist namicerun read in iceini **
-   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input)
-   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output)
-   LOGICAL               , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F)
-   LOGICAL               , PUBLIC ::   ln_nicep        !: flag for sea-ice points output (T) or not (F)
-   REAL(wp)              , PUBLIC ::   cai             !: atmospheric drag over sea ice
-   REAL(wp)              , PUBLIC ::   cao             !: atmospheric drag over ocean
-   REAL(wp)              , PUBLIC ::   amax            !: maximum ice concentration
+   LOGICAL , PUBLIC                                        ::   ln_limdiahsb  !: flag for ice diag (T) or not (F)
+   LOGICAL , PUBLIC                                        ::   ln_limdiaout  !: flag for ice diag (T) or not (F)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vi   !: transport of ice volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vs   !: transport of snw volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_ei   !: transport of ice enthalpy (W/m2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_es   !: transport of snw enthalpy (W/m2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_smv  !: transport of salt content
    !
-   !!--------------------------------------------------------------------------
-   !! * Ice diagnostics
-   !!--------------------------------------------------------------------------
-   !! Check if everything down here is necessary
-   LOGICAL , PUBLIC                                      ::   ln_limdiahsb  !: flag for ice diag (T) or not (F)
-   LOGICAL , PUBLIC                                      ::   ln_limdiaout  !: flag for ice diag (T) or not (F)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd     !: thermodynamic growth rates 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   !: transport of ice volume
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vs   !: transport of snw volume
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_ei   !: transport of ice enthalpy (W/m2)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_es   !: transport of snw enthalpy (W/m2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_heat     !: snw/ice heat content variation   [W/m2] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_smvi     !: ice salt content variation   [] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vice     !: ice volume variation   [m/s] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vsnw     !: snw volume variation   [m/s] 
    !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_heat_dhc !: snw/ice heat content variation   [W/m2] 
-   !
-   INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point
-
    !!----------------------------------------------------------------------
    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
@@ -422,5 +414,5 @@
       INTEGER :: ice_alloc
       !
-      INTEGER :: ierr(19), ii
+      INTEGER :: ierr(17), ii
       !!-----------------------------------------------------------------
 
@@ -439,15 +431,17 @@
 
       ii = ii + 1
-      ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,      &
-         &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,      &
-         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,    &
+      ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,                        &
+         &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,                        &
+         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,                        &
          &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     &
-         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,  qlead  (jpi,jpj) ,     &
-         &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl) ,      &
-         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,      &
-         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,   &
-         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), &
-         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,  &
-         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , &
+         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,     &
+         &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) ,                        &
+         &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl), qlead  (jpi,jpj) ,                     &
+         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,                        &
+         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,    &
+         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) ,     & 
+         &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) ,                                   &
+         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,                           &
+         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) ,    &
          &      hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,  STAT=ierr(ii) )
 
@@ -464,8 +458,7 @@
          &      bv_i (jpi,jpj) , smt_i(jpi,jpj)                                   , STAT=ierr(ii) )
       ii = ii + 1
-      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) ,                            &
-         &      e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) )
-      ii = ii + 1
-      ALLOCATE( t_i(jpi,jpj,nlay_i+1,jpl) , e_i(jpi,jpj,nlay_i+1,jpl) , s_i(jpi,jpj,nlay_i+1,jpl) , STAT=ierr(ii) )
+      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , s_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) )
 
       ! * Moments for advection
@@ -483,24 +476,12 @@
          &      STAT=ierr(ii) )
       ii = ii + 1
-      ALLOCATE( sxe (jpi,jpj,nlay_i+1,jpl) , sye (jpi,jpj,nlay_i+1,jpl) , sxxe(jpi,jpj,nlay_i+1,jpl) ,     &
-         &      syye(jpi,jpj,nlay_i+1,jpl) , sxye(jpi,jpj,nlay_i+1,jpl)                           , STAT=ierr(ii) )
+      ALLOCATE( sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe(jpi,jpj,nlay_i,jpl) ,     &
+         &      syye(jpi,jpj,nlay_i,jpl) , sxye(jpi,jpj,nlay_i,jpl)                            , STAT=ierr(ii) )
 
       ! * Old values of global variables
       ii = ii + 1
       ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     &
-         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i+1 ,jpl) ,     &
-         &      oa_i_b (jpi,jpj,jpl)                                                        ,     &
-         &      u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)                                   , STAT=ierr(ii) )
-
-      ! * Increment of global variables
-      ii = ii + 1
-      ALLOCATE( d_a_i_thd(jpi,jpj,jpl) , d_a_i_trp (jpi,jpj,jpl) , d_v_s_thd  (jpi,jpj,jpl) , d_v_s_trp  (jpi,jpj,jpl) ,   &
-         &      d_v_i_thd(jpi,jpj,jpl) , d_v_i_trp (jpi,jpj,jpl) , d_smv_i_thd(jpi,jpj,jpl) , d_smv_i_trp(jpi,jpj,jpl) ,   &     
-         &      d_sm_i_fl(jpi,jpj,jpl) , d_sm_i_gd (jpi,jpj,jpl) , d_sm_i_se  (jpi,jpj,jpl) , d_sm_i_si  (jpi,jpj,jpl) ,   &
-         &      d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) ,   &
-         &     STAT=ierr(ii) )
-      ii = ii + 1
-      ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,nlay_i,jpl) , d_u_ice_dyn(jpi,jpj) ,     &
-         &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,nlay_i,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) )
+         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) ,     &
+         &      oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)          , STAT=ierr(ii) )
       
       ! * Ice thickness distribution variables
@@ -510,7 +491,7 @@
       ! * Ice diagnostics
       ii = ii + 1
-      ALLOCATE( dv_dt_thd(jpi,jpj,jpl),    &
-         &      diag_trp_vi(jpi,jpj), diag_trp_vs  (jpi,jpj), diag_trp_ei(jpi,jpj),   & 
-         &      diag_trp_es(jpi,jpj), diag_heat_dhc(jpi,jpj),  STAT=ierr(ii) )
+      ALLOCATE( diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei(jpi,jpj),   & 
+         &      diag_trp_es(jpi,jpj), diag_trp_smv(jpi,jpj), diag_heat  (jpi,jpj),   &
+         &      diag_smvi  (jpi,jpj), diag_vice   (jpi,jpj), diag_vsnw  (jpi,jpj), STAT=ierr(ii) )
 
       ice_alloc = MAXVAL( ierr(:) )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90	(revision 5659)
+++ 	(revision )
@@ -1,225 +1,0 @@
-MODULE iceini
-   !!======================================================================
-   !!                       ***  MODULE iceini   ***
-   !!   Sea-ice model : LIM Sea ice model Initialization
-   !!======================================================================
-   !! History :  3.0  ! 2008-03  (M. Vancoppenolle) LIM-3 original code
-   !!            3.3  ! 2010-12  (G. Madec) add call to lim_thd_init and lim_thd_sal_init
-   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                     LIM sea-ice model
-   !!----------------------------------------------------------------------
-   !!   ice_init      : sea-ice model initialization
-   !!----------------------------------------------------------------------
-   USE phycst         ! physical constants
-   USE dom_oce        ! ocean domain
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE sbc_ice        ! Surface boundary condition: ice   fields
-   USE ice            ! LIM variables
-   USE par_ice        ! LIM parameters
-   USE dom_ice        ! LIM domain
-   USE thd_ice        ! LIM thermodynamical variables
-   USE limitd_me      ! LIM ice thickness distribution
-   USE limmsh         ! LIM mesh
-   USE limistate      ! LIM initial state
-   USE limrst         ! LIM restart
-   USE limthd         ! LIM ice thermodynamics
-   USE limthd_sal     ! LIM ice thermodynamics: salinity
-   USE limvar         ! LIM variables
-   USE limsbc         ! LIM surface boundary condition
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! MPP library
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   ice_init   ! called by sbcice_lim.F90
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE ice_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ice_init  ***
-      !!
-      !! ** purpose :   Allocate all the dynamic arrays of the LIM-3 modules
-      !!----------------------------------------------------------------------
-      INTEGER :: ierr
-      !!----------------------------------------------------------------------
-
-      !                                ! Allocate the ice arrays
-      ierr =        ice_alloc        ()      ! ice variables
-      ierr = ierr + dom_ice_alloc    ()      ! domain
-      ierr = ierr + sbc_ice_alloc    ()      ! surface forcing
-      ierr = ierr + thd_ice_alloc    ()      ! thermodynamics
-      ierr = ierr + lim_itd_me_alloc ()      ! ice thickness distribution - mechanics
-      !
-      IF( lk_mpp    )   CALL mpp_sum( ierr )
-      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays')
-      !
-      !                                ! adequation jpk versus ice/snow layers/categories
-      IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk )   &
-         &      CALL ctl_stop( 'STOP',                     &
-         &     'ice_init: the 3rd dimension of workspace arrays is too small.',   &
-         &     'use more ocean levels or less ice/snow layers/categories.' )
-
-                                       ! Open the reference and configuration namelist files and namelist output file 
-      CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
-      CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
-      IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 )
-      !
-      CALL ice_run                     ! set some ice run parameters
-      !
-      CALL lim_thd_init                ! set ice thermodynics parameters
-      !
-      CALL lim_thd_sal_init            ! set ice salinity parameters
-      !
-      rdt_ice   = nn_fsbc * rdttra(1)  ! sea-ice timestep
-      r1_rdtice = 1._wp / rdt_ice      ! sea-ice timestep inverse
-      !
-      CALL lim_msh                     ! ice mesh initialization
-      !
-      CALL lim_itd_ini                 ! ice thickness distribution initialization
-      !
-      CALL lim_itd_me_init             ! ice thickness distribution initialization
-      !                                ! Initial sea-ice state
-      IF( .NOT. ln_rstart ) THEN              ! start from rest
-         numit = 0
-         numit = nit000 - 1
-         CALL lim_istate                        ! start from rest: sea-ice deduced from sst
-         CALL lim_var_agg(1)                    ! aggregate category variables in bulk variables
-         CALL lim_var_glo2eqv                   ! convert global variables in equivalent variables
-      ELSE                                   ! start from a restart file
-         CALL lim_rst_read                      ! read the restart file
-         numit = nit000 - 1
-         CALL lim_var_agg(1)                    ! aggregate ice variables
-         CALL lim_var_glo2eqv                   ! convert global var in equivalent variables
-      ENDIF
-      !
-      hi_max(jpl) = 99._wp  ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl)
-      !
-      CALL lim_sbc_init                 ! ice surface boundary condition   
-      !
-      fr_i(:,:) = at_i(:,:)             ! initialisation of sea-ice fraction
-      tn_ice(:,:,:) = t_su(:,:,:)       ! initialisation of surface temp for coupled simu
-      !
-      nstart = numit  + nn_fsbc      
-      nitrun = nitend - nit000 + 1 
-      nlast  = numit  + nitrun 
-      !
-      IF( nstock == 0  )   nstock = nlast + 1
-      !
-   END SUBROUTINE ice_init
-
-
-   SUBROUTINE ice_run
-      !!-------------------------------------------------------------------
-      !!                  ***  ROUTINE ice_run ***
-      !!                 
-      !! ** Purpose :   Definition some run parameter for ice model
-      !!
-      !! ** Method  :   Read the namicerun namelist and check the parameter 
-      !!              values called at the first timestep (nit000)
-      !!
-      !! ** input   :   Namelist namicerun
-      !!-------------------------------------------------------------------
-      NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, amax, cai, cao, ln_nicep, ln_limdiahsb, ln_limdiaout
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      !!-------------------------------------------------------------------
-      !                    
-      REWIND( numnam_ice_ref )              ! Namelist namicerun in reference namelist : Parameters for ice
-      READ  ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )
-
-      REWIND( numnam_ice_cfg )              ! Namelist namicerun in configuration namelist : Parameters for ice
-      READ  ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp )
-      IF(lwm) WRITE ( numoni, namicerun )
-      !
-      !IF( lk_mpp .AND. ln_nicep ) THEN
-      !   ln_nicep = .FALSE.
-      !   CALL ctl_warn( 'ice_run : specific control print for LIM3 desactivated with MPI' )
-      !ENDIF
-      !
-      IF(lwp) THEN                        ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice'
-         WRITE(numout,*) ' ~~~~~~'
-         WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn
-         WRITE(numout,*) '   maximum ice concentration                               = ', amax 
-         WRITE(numout,*) '   atmospheric drag over sea ice                           = ', cai
-         WRITE(numout,*) '   atmospheric drag over ocean                             = ', cao
-         WRITE(numout,*) '   Several ice points in the ice or not in ocean.output    = ', ln_nicep
-         WRITE(numout,*) '   Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb
-         WRITE(numout,*) '   Output   heat/salt budget or not          ln_limdiaout  = ', ln_limdiaout
-      ENDIF
-      !
-   END SUBROUTINE ice_run
-
-
-   SUBROUTINE lim_itd_ini
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_ini ***
-      !!
-      !! ** Purpose :   Initializes the ice thickness distribution
-      !! ** Method  :   ...
-      !!    Note    : hi_max(jpl) is here set up to a value close to 7 m for
-      !!              limistate (only) and is changed to 99 m in ice_init
-      !!------------------------------------------------------------------
-      INTEGER  ::   jl                   ! dummy loop index
-      REAL(wp) ::   zc1, zc2, zc3, zx1   ! local scalars
-      !!------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'lim_itd_ini : Initialization of ice thickness distribution '
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-
-      !------------------------------------------------------------------------------!
-      ! 1) Ice thickness distribution parameters initialization    
-      !------------------------------------------------------------------------------!
-      IF(lwp) THEN  
-         WRITE(numout,*) ' Number of ice categories jpl = ', jpl
-      ENDIF
-
-      !- Thickness categories boundaries 
-      !----------------------------------
-      hi_max(:) = 0._wp
-
-      zc1 =  3._wp / REAL( jpl, wp )
-      zc2 = 10._wp * zc1
-      zc3 =  3._wp
-
-      DO jl = 1, jpl
-         zx1 = REAL( jl-1, wp ) / REAL( jpl, wp )
-         hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) )
-      END DO
-
-      IF(lwp) WRITE(numout,*) ' Thickness category boundaries '
-      IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl)
-
-      !
-      DO jl = 1, jpl
-         hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp
-      END DO
-      !
-      !
-   END SUBROUTINE lim_itd_ini
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :        Empty module           NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE ice_init        ! Empty routine
-   END SUBROUTINE ice_init
-#endif
-
-   !!======================================================================
-END MODULE iceini
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90	(revision 5682)
@@ -63,5 +63,5 @@
       !! 
       INTEGER  ::   ji, jj                               ! dummy loop indices
-      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! local scalars
+      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! local scalars
       REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      -
       REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !   -      -
@@ -85,17 +85,17 @@
             zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      &
                &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  )
-            zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask
+            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
 
             ps0 (ji,jj) = zslpmax  
-            psx (ji,jj) = zs1new      * zin0
-            psxx(ji,jj) = zs2new      * zin0
-            psy (ji,jj) = psy (ji,jj) * zin0
-            psyy(ji,jj) = psyy(ji,jj) * zin0
-            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0
+            psx (ji,jj) = zs1new      * rswitch
+            psxx(ji,jj) = zs2new      * rswitch
+            psy (ji,jj) = psy (ji,jj) * rswitch
+            psyy(ji,jj) = psyy(ji,jj) * rswitch
+            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch
          END DO
       END DO
 
       !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                     
-      psm (:,:)  = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
+      psm (:,:)  = MAX( pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
 
       !  Calculate fluxes and moments between boxes i<-->i+1              
@@ -207,8 +207,8 @@
 
       !-- Lateral boundary conditions
-      CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. )
-      CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes
-      CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. )
-      CALL lbc_lnk( psxy, 'T',  1. )
+      CALL lbc_lnk_multi( psm , 'T',  1., ps0 , 'T',  1.   &
+         &              , psx , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes
+         &              , psxx, 'T',  1., psyy, 'T',  1.   &
+         &              , psxy, 'T',  1. )
 
       IF(ln_ctl) THEN
@@ -248,5 +248,5 @@
       !!
       INTEGER  ::   ji, jj                               ! dummy loop indices
-      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! temporary scalars
+      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! temporary scalars
       REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         -
       REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         -
@@ -270,17 +270,17 @@
             zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   &
                &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  )
-            zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask
+            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
             !
             ps0 (ji,jj) = zslpmax  
-            psx (ji,jj) = psx (ji,jj) * zin0
-            psxx(ji,jj) = psxx(ji,jj) * zin0
-            psy (ji,jj) = zs1new * zin0
-            psyy(ji,jj) = zs2new * zin0
-            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0
+            psx (ji,jj) = psx (ji,jj) * rswitch
+            psxx(ji,jj) = psxx(ji,jj) * rswitch
+            psy (ji,jj) = zs1new * rswitch
+            psyy(ji,jj) = zs2new * rswitch
+            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch
          END DO
       END DO
 
       !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
-      psm(:,:)  = MAX(  pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  )
+      psm(:,:)  = MAX(  pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  )
 
       !  Calculate fluxes and moments between boxes j<-->j+1              
@@ -393,8 +393,8 @@
 
       !-- Lateral boundary conditions
-      CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. )
-      CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes
-      CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. )
-      CALL lbc_lnk( psxy, 'T',  1. )
+      CALL lbc_lnk_multi( psm , 'T',  1.,  ps0 , 'T',  1.   &
+         &              , psx , 'T', -1.,  psy , 'T', -1.   &   ! caution gradient ==> the sign changes
+         &              , psxx, 'T',  1.,  psyy, 'T',  1.   &
+         &              , psxy, 'T',  1. )
 
       IF(ln_ctl) THEN
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limcat_1D.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limcat_1D.F90	(revision 5659)
+++ 	(revision )
@@ -1,215 +1,0 @@
-MODULE limcat_1D
-   !!======================================================================
-   !!                     ***  MODULE  limcat_1D  ***
-   !!  Used for LIM3 to convert cell averages of ice thickness, snow thickness
-   !!  and ice cover into a prescribed distribution over the cell. 
-   !!  (Example of application: BDY forcings when input are cell averaged)  
-   !!======================================================================
-   !! History :   -   ! Original code from M. Vancoppenolle (?)
-   !!                 ! 2011-12 (C. Rousset) rewritten for clarity
-   !!----------------------------------------------------------------------
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3' :                                    LIM3 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   lim_cat_1D      :  main subroutine
-   !!----------------------------------------------------------------------
-   !! Modules used
-   USE phycst
-   USE oce             ! dynamics and tracers variables
-   USE dom_oce
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE par_ice         ! ice parameters
-   USE ice             ! ice variables
-   USE eosbn2          ! equation of state
-   USE in_out_manager
-   USE dom_ice
-   USE ice
-   USE lbclnk
-   USE timing          ! Timing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! Accessibility
-   PUBLIC lim_cat_1D      
-
-CONTAINS
-
-   SUBROUTINE lim_cat_1D(zhti,zhts,zai,zht_i,zht_s,za_i)
-      !! Local variables
-      INTEGER  :: ji, jk, jl             ! dummy loop indices
-      INTEGER  :: ijpij, i_fill, jl0, ztest_1, ztest_2, ztest_3, ztest_4, ztests  
-      REAL(wp) :: zarg, zV, zconv
-      REAL(wp), DIMENSION(:),   INTENT(in)    ::   zhti, zhts, zai    ! input ice/snow variables
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zht_i, zht_s, za_i ! output ice/snow variables
-      REAL(wp) :: epsi06 = 1.0e-6
-      REAL(wp) :: zc1, zc2, zc3, zx1, zdh   ! local scalars
-      REAL(wp), DIMENSION(0:jpl)   ::   zhi_max         !:Boundary of ice thickness categories in thickness space
- 
-      IF( nn_timing == 1 )  CALL timing_start('limcat_1D')
-      !--------------------------------------------------------------------
-      ! initialisation of variables
-      !--------------------------------------------------------------------
-      ijpij = SIZE(zhti,1)
-      zht_i(1:ijpij,1:jpl) = 0._wp
-      zht_s(1:ijpij,1:jpl) = 0._wp
-      za_i (1:ijpij,1:jpl) = 0._wp
-
-      !------------------------------------------------------------------------------------
-      ! Distribute ice concentration and thickness into the categories
-      !------------------------------------------------------------------------------------
-      ! Method: we first try to fill the jpl ice categories bounded by thicknesses
-      !         hmax(0:jpl) with a gaussian distribution, and check whether the distribution
-      !         fulfills volume and area conservation, positivity and ice categories bounds.
-      !         In other words, if ice input is too thin, the last category (jpl)
-      !         cannot be filled, so we try to fill jpl-1 categories...
-      !         And so forth iteratively until the number of categories filled
-      !         fulfills ice volume concervation between input and output (ztests=4) 
-      !--------------------------------------------------------------------------------------
-
-      !- Thickness categories boundaries
-      !    hi_max is calculated in iceini.F90 but since limcat_1D.F90 routine 
-      !    is called before (in bdydta.F90), one must recalculate it.   
-      !    Note clem: there may be a way of doing things cleaner
-      !----------------------------------
-      zhi_max(:) = 0._wp
-      zc1 =  3._wp / REAL( jpl , wp ) ; zc2 = 10._wp * zc1 ; zc3 =  3._wp
-      DO jl = 1, jpl
-         zx1 = REAL( jl-1 , wp ) / REAL( jpl , wp )
-         zhi_max(jl) = zhi_max(jl-1) + zc1 + zc2 * ( 1._wp + TANH( zc3 * ( zx1 - 1._wp ) ) )
-      END DO
- 
-      ! ----------------------------------------
-      ! distribution over the jpl ice categories
-      ! ----------------------------------------
-      DO ji = 1, ijpij
-         
-         IF( zhti(ji) > 0._wp ) THEN
-
-         ! initialisation of tests
-         ztest_1 = 0
-         ztest_2 = 0
-         ztest_3 = 0
-         ztest_4 = 0
-         ztests  = 0
-         
-         i_fill = jpl + 1                                    !====================================
-         DO WHILE ( ( ztests /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories  
-            ! iteration                                      !====================================
-            i_fill = i_fill - 1
-            
-            ! initialisation of ice variables for each try
-            zht_i(ji,1:jpl) = 0._wp
-            za_i (ji,1:jpl) = 0._wp
-            
-            ! *** case very thin ice: fill only category 1
-            IF ( i_fill == 1 ) THEN
-               zht_i(ji,1) = zhti(ji)
-               za_i (ji,1) = zai (ji)
-               ! *** case ice is thicker: fill categories >1
-            ELSE
-
-               ! Fill ice thicknesses except the last one (i_fill) by (hmax-hmin)/2 
-               DO jl = 1, i_fill - 1
-                  zht_i(ji,jl) = ( zhi_max(jl) + zhi_max(jl-1) ) * 0.5_wp
-               END DO
-               
-               ! find which category (jl0) the input ice thickness falls into
-               jl0 = i_fill
-               DO jl = 1, i_fill
-                  IF ( ( zhti(ji) >= zhi_max(jl-1) ) .AND. ( zhti(ji) < zhi_max(jl) ) ) THEN
-                     jl0 = jl
-		     CYCLE
-                  ENDIF
-               END DO
-               
-               ! Concentrations in the (i_fill-1) categories 
-               za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl))
-               DO jl = 1, i_fill - 1
-                  IF ( jl == jl0 ) CYCLE
-                  zarg           = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp )
-                  za_i(ji,jl) =   za_i (ji,jl0) * EXP(-zarg**2)
-               END DO
-               
-               ! Concentration in the last (i_fill) category
-               za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) )
-               
-               ! Ice thickness in the last (i_fill) category
-               zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) )
-               zht_i(ji,i_fill) = ( zhti(ji)*zai(ji) -  zV ) / za_i(ji,i_fill) 
-               
-            ENDIF ! case ice is thick or thin
-            
-            !---------------------
-            ! Compatibility tests
-            !--------------------- 
-            ! Test 1: area conservation
-            zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) )
-            IF ( zconv < epsi06 ) ztest_1 = 1
-            
-            ! Test 2: volume conservation
-            zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) )
-            IF ( zconv < epsi06 ) ztest_2 = 1
-            
-            ! Test 3: thickness of the last category is in-bounds ?
-            IF ( zht_i(ji,i_fill) >= zhi_max(i_fill-1) ) ztest_3 = 1
-            
-            ! Test 4: positivity of ice concentrations
-            ztest_4 = 1
-            DO jl = 1, i_fill
-               IF ( za_i(ji,jl) < 0._wp ) ztest_4 = 0
-            END DO
-            
-            ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4
-                                                           !============================
-         END DO                                            ! end iteration on categories
-                                                           !============================
-         ! Check if tests have passed (i.e. volume conservation...)
-         !IF ( ztests /= 4 ) THEN
-         !   WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '
-         !   WRITE(numout,*) ' !! ALERT categories distribution !!'
-         !   WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '
-         !   WRITE(numout,*) ' *** ztests is not equal to 4 '
-         !   WRITE(numout,*) ' *** ztest (1:4) = ', ztest_1, ztest_2, ztest_3, ztest_4
-         !   WRITE(numout,*) 'i_fill=',i_fill
-         !   WRITE(numout,*) 'zai(ji)=',zai(ji)
-         !   WRITE(numout,*) 'za_i(ji,jpl)=',za_i(ji,:)
-         !ENDIF
-         
-         ENDIF ! if zhti > 0
-
-      END DO ! i loop
-
-      ! ------------------------------------------------
-      ! Adding Snow in each category where za_i is not 0
-      ! ------------------------------------------------ 
-      DO jl = 1, jpl
-         DO ji = 1, ijpij
-            IF( za_i(ji,jl) > 0._wp ) THEN
-               zht_s(ji,jl) = zht_i(ji,jl) * ( zhts(ji) / zhti(ji) )
-               ! In case snow load is in excess that would lead to transformation from snow to ice
-               ! Then, transfer the snow excess into the ice (different from limthd_dh)
-               zdh = MAX( 0._wp, ( rhosn * zht_s(ji,jl) + ( rhoic - rau0 ) * zht_i(ji,jl) ) * r1_rau0 ) 
-               ! recompute ht_i, ht_s avoiding out of bounds values
-               zht_i(ji,jl) = MIN( zhi_max(jl), zht_i(ji,jl) + zdh )
-               zht_s(ji,jl) = MAX( 0._wp, zht_s(ji,jl) - zdh * rhoic / rhosn )
-            ENDIF
-         ENDDO
-      ENDDO
-
-      IF( nn_timing == 1 )  CALL timing_stop('limcat_1D')
-     
-    END SUBROUTINE lim_cat_1D
-    
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :         Empty module          NO LIM sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_cat_1D          ! Empty routine
-   END SUBROUTINE lim_cat_1D
-#endif
-
-   !!======================================================================
-END MODULE limcat_1D
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 5682)
@@ -6,6 +6,7 @@
    !! History :   -   ! Original code from William H. Lipscomb, LANL
    !!            3.0  ! 2004-06  (M. Vancoppenolle)   Energy Conservation 
-   !!            4.0  ! 2011-02  (G. Madec)  add mpp considerations
+   !!            3.5  ! 2011-02  (G. Madec)  add mpp considerations
    !!             -   ! 2014-05  (C. Rousset) add lim_cons_hsm
+   !!             -   ! 2015-03  (C. Rousset) add lim_cons_final
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -16,5 +17,4 @@
    !!----------------------------------------------------------------------
    USE phycst         ! physical constants
-   USE par_ice        ! LIM-3 parameter
    USE ice            ! LIM-3 variables
    USE dom_ice        ! LIM-3 domain
@@ -23,4 +23,5 @@
    USE lib_mpp        ! MPP library
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE sbc_oce , ONLY : sfx  ! Surface boundary condition: ocean fields
 
    IMPLICIT NONE
@@ -31,4 +32,5 @@
    PUBLIC   lim_cons_check
    PUBLIC   lim_cons_hsm
+   PUBLIC   lim_cons_final
 
    !!----------------------------------------------------------------------
@@ -73,8 +75,8 @@
       !! ** Method  : Arithmetics
       !!---------------------------------------------------------------------
-      INTEGER                                  , INTENT(in   ) ::   ksum   !: number of categories
-      INTEGER                                  , INTENT(in   ) ::   klay   !: number of vertical layers
-      REAL(wp), DIMENSION(jpi,jpj,nlay_i+1,jpl), INTENT(in   ) ::   pin   !: input field
-      REAL(wp), DIMENSION(jpi,jpj)             , INTENT(  out) ::   pout   !: output field
+      INTEGER                                , INTENT(in   ) ::   ksum   !: number of categories
+      INTEGER                                , INTENT(in   ) ::   klay   !: number of vertical layers
+      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl), INTENT(in   ) ::   pin    !: input field
+      REAL(wp), DIMENSION(jpi,jpj)           , INTENT(  out) ::   pout   !: output field
       !
       INTEGER ::   jk, jl   ! dummy loop indices
@@ -156,61 +158,106 @@
 
    SUBROUTINE lim_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b )
-      !!-------------------------------------------------------------------
-      !!               ***  ROUTINE lim_cons_hsm ***
-      !!
-      !! ** Purpose : Test the conservation of heat, salt and mass for each routine
-      !!
-      !! ** Method  :
-      !!---------------------------------------------------------------------
-      INTEGER         , INTENT(in)    :: icount      ! determine wether this is the beggining of the routine (0) or the end (1)
-      CHARACTER(len=*), INTENT(in)    :: cd_routine  ! name of the routine
+      !!--------------------------------------------------------------------------------------------------------
+      !!                                        ***  ROUTINE lim_cons_hsm ***
+      !!
+      !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine
+      !!                     + test if ice concentration and volume are > 0
+      !!
+      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiahsb=true
+      !!              It prints in ocean.output if there is a violation of conservation at each time-step
+      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine violations are set to
+      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years.
+      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
+      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
+      !!--------------------------------------------------------------------------------------------------------
+      INTEGER         , INTENT(in)    :: icount        ! determine wether this is the beggining of the routine (0) or the end (1)
+      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine
       REAL(wp)        , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
       REAL(wp)                        :: zvi,   zsmv,   zei,   zfs,   zfw,   zft
       REAL(wp)                        :: zvmin, zamin, zamax 
+      REAL(wp)                        :: zvtrp, zetrp
+      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill
+      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt
 
       IF( icount == 0 ) THEN
 
-         zvi_b  = glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) )
-         zsmv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )
-         zei_b  = glob_sum( SUM(   e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) )
-         zfw_b  = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  &
-            &                   wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    &
-            &             ) * area(:,:) * tms(:,:) )
-         zfs_b  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
-            &                   sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &
-            &                 ) * area(:,:) * tms(:,:) )
-         zft_b  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
-            &                 - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
-            &                  ) * area(:,:) / unit_fac * tms(:,:) )
+         ! salt flux
+         zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
+            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &
+            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv )
+
+         ! water flux
+         zfw_b  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  &
+            &                  wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    &
+            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv )
+
+         ! heat flux
+         zft_b  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
+            &                - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
+            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv )
+
+         zvi_b  = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e12t * tmask(:,:,1) * zconv )
+
+         zsmv_b = glob_sum( SUM( smv_i * rhoic            , dim=3 ) * e12t * tmask(:,:,1) * zconv )
+
+         zei_b  = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  &
+            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    &
+                            ) * e12t * tmask(:,:,1) * zconv )
 
       ELSEIF( icount == 1 ) THEN
 
-         zfs  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
-            &                 sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
-            &                ) * area(:,:) * tms(:,:) ) - zfs_b
-         zfw  = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  &
-            &                 wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    &
-            &                ) * area(:,:) * tms(:,:) ) - zfw_b
-         zft  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
-            &               - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
-            &                ) * area(:,:) / unit_fac * tms(:,:) ) - zft_b
+         ! salt flux
+         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
+            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
+            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfs_b
+
+         ! water flux
+         zfw  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  &
+            &                wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    &
+            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfw_b
+
+         ! heat flux
+         zft  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
+            &              - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
+            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zft_b
  
-         zvi  = ( glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zvi_b ) * r1_rdtice - zfw 
-         zsmv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zsmv_b ) * r1_rdtice + ( zfs / rhoic )
-         zei  =   glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zei_b * r1_rdtice + zft
-
-         zvmin = glob_min(v_i)
-         zamax = glob_max(SUM(a_i,dim=3))
-         zamin = glob_min(a_i)
-       
+         ! outputs
+         zvi  = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 )  &
+            &                    * e12t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday
+
+         zsmv = ( ( glob_sum( SUM( smv_i * rhoic            , dim=3 )  &
+            &                    * e12t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday
+
+         zei  =   glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  &
+            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    &
+            &                ) * e12t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft
+
+         ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative
+         zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e12t * tmask(:,:,1) * zconv ) * rday 
+         zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e12t * tmask(:,:,1) * zconv )
+
+         zvmin = glob_min( v_i )
+         zamax = glob_max( SUM( a_i, dim=3 ) )
+         zamin = glob_min( a_i )
+
+         ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 
+         zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2
+         zv_sill = zarea * 2.5e-5
+         zs_sill = zarea * 25.e-5
+         zh_sill = zarea * 10.e-5
+
          IF(lwp) THEN
-            IF ( ABS( zvi    ) >  1.e-4 ) WRITE(numout,*) 'violation volume [kg/day]     (',cd_routine,') = ',(zvi * rday)
-            IF ( ABS( zsmv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (',cd_routine,') = ',(zsmv * rday)
-            IF ( ABS( zei    ) >  1.    ) WRITE(numout,*) 'violation enthalpy [1e9 J]    (',cd_routine,') = ',(zei)
-            IF ( zvmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',(zvmin)
-            IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > amax+1.e-10 ) THEN
-                                          WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax
+            IF ( ABS( zvi  ) > zv_sill ) WRITE(numout,*) 'violation volume [Mt/day]     (',cd_routine,') = ',zvi
+            IF ( ABS( zsmv ) > zs_sill ) WRITE(numout,*) 'violation saline [psu*Mt/day] (',cd_routine,') = ',zsmv
+            IF ( ABS( zei  ) > zh_sill ) WRITE(numout,*) 'violation enthalpy [GW]       (',cd_routine,') = ',zei
+            IF ( ABS(zvtrp ) > zv_sill .AND. cd_routine == 'limtrp' ) THEN
+                                         WRITE(numout,*) 'violation vtrp [Mt/day]       (',cd_routine,') = ',zvtrp
+                                         WRITE(numout,*) 'violation etrp [GW]           (',cd_routine,') = ',zetrp
             ENDIF
-            IF ( zamin <  0.            ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin
+            IF (     zvmin   < -epsi10 ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',zvmin
+            IF (     zamax   > rn_amax+epsi10 .AND. cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN
+                                         WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax
+            ENDIF
+            IF (      zamin  < -epsi10 ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin
          ENDIF
 
@@ -218,4 +265,43 @@
 
    END SUBROUTINE lim_cons_hsm
+
+   SUBROUTINE lim_cons_final( cd_routine )
+      !!---------------------------------------------------------------------------------------------------------
+      !!                                   ***  ROUTINE lim_cons_final ***
+      !!
+      !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step
+      !!
+      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiahsb=true
+      !!              It prints in ocean.output if there is a violation of conservation at each time-step
+      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine the violation are set to
+      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years.
+      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
+      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
+      !!--------------------------------------------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine
+      REAL(wp)                        :: zhfx, zsfx, zvfx
+      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill
+      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt
+
+#if ! defined key_bdy
+      ! heat flux
+      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e12t * tmask(:,:,1) * zconv ) 
+      ! salt flux
+      zsfx  = glob_sum( ( sfx + diag_smvi ) * e12t * tmask(:,:,1) * zconv ) * rday
+      ! water flux
+      zvfx  = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e12t * tmask(:,:,1) * zconv ) * rday
+
+      ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 
+      zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2
+      zv_sill = zarea * 2.5e-5
+      zs_sill = zarea * 25.e-5
+      zh_sill = zarea * 10.e-5
+
+      IF( ABS( zvfx ) > zv_sill ) WRITE(numout,*) 'violation vfx    [Mt/day]       (',cd_routine,')  = ',(zvfx)
+      IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx    [psu*Mt/day]   (',cd_routine,')  = ',(zsfx)
+      IF( ABS( zhfx ) > zh_sill ) WRITE(numout,*) 'violation hfx    [GW]           (',cd_routine,')  = ',(zhfx)
+#endif
+
+   END SUBROUTINE lim_cons_final
 
 #else
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90	(revision 5682)
@@ -0,0 +1,458 @@
+MODULE limctl
+   !!======================================================================
+   !!                     ***  MODULE  limctl  ***
+   !!   LIM-3 : control and printing
+   !!======================================================================
+   !! History :  3.5  !  2015-01  (M. Vancoppenolle) Original code
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!    lim_ctl   : control prints in case of crash
+   !!    lim_prt   : ice control print at a given grid point
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ice             ! LIM-3: ice variables
+   USE thd_ice         ! LIM-3: thermodynamical variables
+   USE dom_ice         ! LIM-3: ice domain
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice   fields
+
+   USE phycst          ! Define parameters for the routines
+
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE lib_fortran     ! 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_ctl
+   PUBLIC   lim_prt
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id: limctl.F90 5043 2015-01-28 16:44:18Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_ctl( kt )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_ctl *** 
+      !!                 
+      !! ** Purpose :   Alerts in case of model crash
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! ocean time step
+      INTEGER  ::   ji, jj, jk,  jl   ! dummy loop indices
+      INTEGER  ::   inb_altests       ! number of alert tests (max 20)
+      INTEGER  ::   ialert_id         ! number of the current alert
+      REAL(wp) ::   ztmelts           ! ice layer melting point
+      CHARACTER (len=30), DIMENSION(20)      ::   cl_alname   ! name of alert
+      INTEGER           , DIMENSION(20)      ::   inb_alp     ! number of alerts positive
+      !!-------------------------------------------------------------------
+
+      inb_altests = 10
+      inb_alp(:)  =  0
+
+      ! Alert if incompatible volume and concentration
+      ialert_id = 2 ! reference number of this alert
+      cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert
+
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN
+                  !WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration '
+                  !WRITE(numout,*) ' at_i     ', at_i(ji,jj)
+                  !WRITE(numout,*) ' Point - category', ji, jj, jl
+                  !WRITE(numout,*) ' a_i *** a_i_b   ', a_i      (ji,jj,jl), a_i_b  (ji,jj,jl)
+                  !WRITE(numout,*) ' v_i *** v_i_b   ', v_i      (ji,jj,jl), v_i_b  (ji,jj,jl)
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Alerte if very thick ice
+      ialert_id = 3 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert
+      jl = jpl 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   ht_i(ji,jj,jl)  >  50._wp   ) THEN
+               !CALL lim_prt( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' )
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if very fast ice
+      ialert_id = 4 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very fast ice               ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5  .AND.  &
+               &  at_i(ji,jj) > 0._wp   ) THEN
+               !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' )
+               !WRITE(numout,*) ' ice strength             : ', strength(ji,jj)
+               !WRITE(numout,*) ' oceanic stress utau      : ', utau(ji,jj) 
+               !WRITE(numout,*) ' oceanic stress vtau      : ', vtau(ji,jj)
+               !WRITE(numout,*) ' sea-ice stress utau_ice  : ', utau_ice(ji,jj) 
+               !WRITE(numout,*) ' sea-ice stress vtau_ice  : ', vtau_ice(ji,jj)
+               !WRITE(numout,*) ' oceanic speed u          : ', u_oce(ji,jj)
+               !WRITE(numout,*) ' oceanic speed v          : ', v_oce(ji,jj)
+               !WRITE(numout,*) ' sst                      : ', sst_m(ji,jj)
+               !WRITE(numout,*) ' sss                      : ', sss_m(ji,jj)
+               !WRITE(numout,*) 
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if there is ice on continents
+      ialert_id = 6 ! reference number of this alert
+      cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   tmask(ji,jj,1) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN 
+               !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' )
+               !WRITE(numout,*) ' masks s, u, v        : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1) 
+               !WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
+               !WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
+               !WRITE(numout,*) ' at_i(ji,jj)          : ', at_i(ji,jj)
+               !WRITE(numout,*) ' v_ice(ji,jj)         : ', v_ice(ji,jj)
+               !WRITE(numout,*) ' v_ice(ji,jj-1)       : ', v_ice(ji,jj-1)
+               !WRITE(numout,*) ' u_ice(ji-1,jj)       : ', u_ice(ji-1,jj)
+               !WRITE(numout,*) ' u_ice(ji,jj)         : ', v_ice(ji,jj)
+               !
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+!
+!     ! Alert if very fresh ice
+      ialert_id = 7 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( sm_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+!                 CALL lim_prt(kt,ji,jj,1, ' ALERTE 7 :   Very fresh ice ' )
+!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
+!                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
+!                 WRITE(numout,*) 
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+!
+
+!     ! Alert if too old ice
+      ialert_id = 9 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very old   ice               ' ! name of the alert
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. &
+                      ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. &
+                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN
+                  !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ')
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+ 
+      ! Alert on salt flux
+      ialert_id = 5 ! reference number of this alert
+      cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth
+               !CALL lim_prt( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' )
+               !DO jl = 1, jpl
+                  !WRITE(numout,*) ' Category no: ', jl
+                  !WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' a_i_b      : ', a_i_b  (ji,jj,jl)   
+                  !WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' v_i_b      : ', v_i_b  (ji,jj,jl)   
+                  !WRITE(numout,*) ' '
+               !END DO
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if qns very big
+      ialert_id = 8 ! reference number of this alert
+      cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN
+               !
+               !WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux'
+               !WRITE(numout,*) ' ji, jj    : ', ji, jj
+               !WRITE(numout,*) ' qns       : ', qns(ji,jj)
+               !WRITE(numout,*) ' sst       : ', sst_m(ji,jj)
+               !WRITE(numout,*) ' sss       : ', sss_m(ji,jj)
+               !
+               !CALL lim_prt( kt, ji, jj, 2, '   ')
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               !
+            ENDIF
+         END DO
+      END DO
+      !+++++
+ 
+      ! Alert if very warm ice
+      ialert_id = 10 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very warm ice                ' ! name of the alert
+      inb_alp(ialert_id) = 0
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztmelts    =  -tmut * s_i(ji,jj,jk,jl) + rt0
+                  IF( t_i(ji,jj,jk,jl) >= ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   &
+                     &                             .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN
+                     !WRITE(numout,*) ' ALERTE 10 :   Very warm ice'
+                     !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl
+                     !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl)
+                     !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl)
+                     !WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl)
+                     !WRITE(numout,*) ' ztmelts : ', ztmelts
+                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! sum of the alerts on all processors
+      IF( lk_mpp ) THEN
+         DO ialert_id = 1, inb_altests
+            CALL mpp_sum(inb_alp(ialert_id))
+         END DO
+      ENDIF
+
+      ! print alerts
+      IF( lwp ) THEN
+         ialert_id = 1                                 ! reference number of this alert
+         cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert
+         WRITE(numout,*) ' time step ',kt
+         WRITE(numout,*) ' All alerts at the end of ice model '
+         DO ialert_id = 1, inb_altests
+            WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! '
+         END DO
+      ENDIF
+     !
+   END SUBROUTINE lim_ctl
+ 
+   
+   SUBROUTINE lim_prt( kt, ki, kj, kn, cd1 )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_prt *** 
+      !!                 
+      !! ** Purpose :   Writes global ice state on the (i,j) point 
+      !!                in ocean.ouput 
+      !!                3 possibilities exist 
+      !!                n = 1/-1 -> simple ice state (plus Mechanical Check if -1)
+      !!                n = 2    -> exhaustive state
+      !!                n = 3    -> ice/ocean salt fluxes
+      !!
+      !! ** input   :   point coordinates (i,j) 
+      !!                n : number of the option
+      !!-------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt            ! ocean time step
+      INTEGER         , INTENT(in) ::   ki, kj, kn    ! ocean gridpoint indices
+      CHARACTER(len=*), INTENT(in) ::   cd1           !
+      !!
+      INTEGER :: jl, ji, jj
+      !!-------------------------------------------------------------------
+
+      DO ji = mi0(ki), mi1(ki)
+         DO jj = mj0(kj), mj1(kj)
+
+            WRITE(numout,*) ' time step ',kt,' ',cd1             ! print title
+
+            !----------------
+            !  Simple state
+            !----------------
+            
+            IF ( kn == 1 .OR. kn == -1 ) THEN
+               WRITE(numout,*) ' lim_prt - Point : ',ji,jj
+               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' Simple state '
+               WRITE(numout,*) ' masks s,u,v   : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1)
+               WRITE(numout,*) ' lat - long    : ', gphit(ji,jj), glamt(ji,jj)
+               WRITE(numout,*) ' Time step     : ', numit
+               WRITE(numout,*) ' - Ice drift   '
+               WRITE(numout,*) '   ~~~~~~~~~~~ '
+               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
+               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
+               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
+               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
+               WRITE(numout,*) ' strength      : ', strength(ji,jj)
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Cell values '
+               WRITE(numout,*) '   ~~~~~~~~~~~ '
+               WRITE(numout,*) ' cell area     : ', e12t(ji,jj)
+               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
+               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
+               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
+               DO jl = 1, jpl
+                  WRITE(numout,*) ' - Category (', jl,')'
+                  WRITE(numout,*) ' a_i           : ', a_i(ji,jj,jl)
+                  WRITE(numout,*) ' ht_i          : ', ht_i(ji,jj,jl)
+                  WRITE(numout,*) ' ht_s          : ', ht_s(ji,jj,jl)
+                  WRITE(numout,*) ' v_i           : ', v_i(ji,jj,jl)
+                  WRITE(numout,*) ' v_s           : ', v_s(ji,jj,jl)
+                  WRITE(numout,*) ' e_s           : ', e_s(ji,jj,1,jl)
+                  WRITE(numout,*) ' e_i           : ', e_i(ji,jj,1:nlay_i,jl)
+                  WRITE(numout,*) ' t_su          : ', t_su(ji,jj,jl)
+                  WRITE(numout,*) ' t_snow        : ', t_s(ji,jj,1,jl)
+                  WRITE(numout,*) ' t_i           : ', t_i(ji,jj,1:nlay_i,jl)
+                  WRITE(numout,*) ' sm_i          : ', sm_i(ji,jj,jl)
+                  WRITE(numout,*) ' smv_i         : ', smv_i(ji,jj,jl)
+                  WRITE(numout,*)
+               END DO
+            ENDIF
+            IF( kn == -1 ) THEN
+               WRITE(numout,*) ' Mechanical Check ************** '
+               WRITE(numout,*) ' Check what means ice divergence '
+               WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj)
+               WRITE(numout,*) ' Total lead fraction     ', ato_i(ji,jj)
+               WRITE(numout,*) ' Sum of both             ', ato_i(ji,jj) + at_i(ji,jj)
+               WRITE(numout,*) ' Sum of both minus 1     ', ato_i(ji,jj) + at_i(ji,jj) - 1.00
+            ENDIF
+            
+
+            !--------------------
+            !  Exhaustive state
+            !--------------------
+            
+            IF ( kn .EQ. 2 ) THEN
+               WRITE(numout,*) ' lim_prt - Point : ',ji,jj
+               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' Exhaustive state '
+               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
+               WRITE(numout,*) ' Time step ', numit
+               WRITE(numout,*) 
+               WRITE(numout,*) ' - Cell values '
+               WRITE(numout,*) '   ~~~~~~~~~~~ '
+               WRITE(numout,*) ' cell area     : ', e12t(ji,jj)
+               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
+               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
+               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
+               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
+               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
+               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
+               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
+               WRITE(numout,*) ' strength      : ', strength(ji,jj)
+               WRITE(numout,*) ' u_ice_b       : ', u_ice_b(ji,jj)    , ' v_ice_b       : ', v_ice_b(ji,jj)  
+               WRITE(numout,*)
+               
+               DO jl = 1, jpl
+                  WRITE(numout,*) ' - Category (',jl,')'
+                  WRITE(numout,*) '   ~~~~~~~~         ' 
+                  WRITE(numout,*) ' ht_i       : ', ht_i(ji,jj,jl)             , ' ht_s       : ', ht_s(ji,jj,jl)
+                  WRITE(numout,*) ' t_i        : ', t_i(ji,jj,1:nlay_i,jl)
+                  WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)             , ' t_s        : ', t_s(ji,jj,1,jl)
+                  WRITE(numout,*) ' sm_i       : ', sm_i(ji,jj,jl)             , ' o_i        : ', o_i(ji,jj,jl)
+                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl)   
+                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl)   
+                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl)  
+                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)            , ' ei1        : ', e_i_b(ji,jj,1,jl) 
+                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)            , ' ei2_b      : ', e_i_b(ji,jj,2,jl)  
+                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl) 
+                  WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)            , ' smv_i_b    : ', smv_i_b(ji,jj,jl)   
+                  WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl)
+               END DO !jl
+               
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Heat / FW fluxes '
+               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' - Heat fluxes in and out the ice ***'
+               WRITE(numout,*) ' qsr_ini       : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) )
+               WRITE(numout,*) ' qns_ini       : ', pfrld(ji,jj) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) )
+               WRITE(numout,*)
+               WRITE(numout,*) 
+               WRITE(numout,*) ' sst        : ', sst_m(ji,jj)  
+               WRITE(numout,*) ' sss        : ', sss_m(ji,jj)  
+               WRITE(numout,*) 
+               WRITE(numout,*) ' - Stresses '
+               WRITE(numout,*) '   ~~~~~~~~ '
+               WRITE(numout,*) ' utau_ice   : ', utau_ice(ji,jj) 
+               WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ji,jj)
+               WRITE(numout,*) ' utau       : ', utau    (ji,jj) 
+               WRITE(numout,*) ' vtau       : ', vtau    (ji,jj)
+               WRITE(numout,*) ' oc. vel. u : ', u_oce   (ji,jj)
+               WRITE(numout,*) ' oc. vel. v : ', v_oce   (ji,jj)
+            ENDIF
+            
+            !---------------------
+            ! Salt / heat fluxes
+            !---------------------
+            
+            IF ( kn .EQ. 3 ) THEN
+               WRITE(numout,*) ' lim_prt - Point : ',ji,jj
+               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' - Salt / Heat Fluxes '
+               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
+               WRITE(numout,*) ' Time step ', numit
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
+               WRITE(numout,*) ' qsr       : ', qsr(ji,jj)
+               WRITE(numout,*) ' qns       : ', qns(ji,jj)
+               WRITE(numout,*)
+               WRITE(numout,*) ' hfx_mass     : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj)
+               WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj)
+               WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj)
+               WRITE(numout,*) ' dhc          : ', diag_heat(ji,jj)              
+               WRITE(numout,*)
+               WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj)
+               WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj)
+               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj)
+               WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj) 
+               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Salt fluxes at bottom interface ***'
+               WRITE(numout,*) ' emp       : ', emp    (ji,jj)
+               WRITE(numout,*) ' sfx       : ', sfx    (ji,jj)
+               WRITE(numout,*) ' sfx_res   : ', sfx_res(ji,jj)
+               WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj)
+               WRITE(numout,*) ' sfx_dyn   : ', sfx_dyn(ji,jj)
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Momentum fluxes '
+               WRITE(numout,*) ' utau      : ', utau(ji,jj) 
+               WRITE(numout,*) ' vtau      : ', vtau(ji,jj)
+            ENDIF 
+            WRITE(numout,*) ' '
+            !
+         END DO
+      END DO
+      !
+   END SUBROUTINE lim_prt
+
+#else
+   !!--------------------------------------------------------------------------
+   !!   Default option         Empty Module               No LIM3 sea-ice model
+   !!--------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_ctl     ! Empty routine
+   END SUBROUTINE lim_ctl
+   SUBROUTINE lim_prt     ! Empty routine
+   END SUBROUTINE lim_prt
+#endif
+   !!======================================================================
+END MODULE limctl
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90	(revision 5682)
@@ -14,5 +14,4 @@
    !!----------------------------------------------------------------------
    USE ice             ! LIM-3: sea-ice variable
-   USE par_ice         ! LIM-3: ice parameters
    USE dom_ice         ! LIM-3: sea-ice domain
    USE dom_oce         ! ocean domain
@@ -32,6 +31,4 @@
 
    PUBLIC   lim_diahsb        ! routine called by ice_step.F90
-   !!PUBLIC   lim_diahsb_init   ! routine called by ice_init.F90
-   !!PUBLIC   lim_diahsb_rst   ! routine called by ice_init.F90
 
    real(wp) ::   frc_sal, frc_vol   ! global forcing trends
@@ -43,5 +40,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.4 , NEMO Consortium (2012)
-   !! $Id: limdiahsb.F90 3294 2012-10-18 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -74,71 +71,72 @@
 
       ! 1/area
-      z1_area = 1._wp / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 )
-
-      rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) )
+      z1_area = 1._wp / MAX( glob_sum( e12t(:,:) * tmask(:,:,1) ), epsi06 )
+
+      rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e12t(:,:) * tmask(:,:,1) ) - epsi06 ) )
       ! ----------------------- !
       ! 1 -  Content variations !
       ! ----------------------- !
-      zbg_ivo = glob_sum( vt_i(:,:) * area(:,:) * tms(:,:) ) ! volume ice 
-      zbg_svo = glob_sum( vt_s(:,:) * area(:,:) * tms(:,:) ) ! volume snow
-      zbg_are = glob_sum( at_i(:,:) * area(:,:) * tms(:,:) ) ! area
-      zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )       ! mean salt content
-      zbg_tem = glob_sum( ( tm_i(:,:) - rtt ) * vt_i(:,:) * area(:,:) * tms(:,:) )  ! mean temp content
-
-      !zbg_ihc = glob_sum( et_i(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content
-      !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content
+      zbg_ivo = glob_sum( vt_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume ice 
+      zbg_svo = glob_sum( vt_s(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume snow
+      zbg_are = glob_sum( at_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! area
+      zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) )       ! mean salt content
+      zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e12t(:,:) * tmask(:,:,1) )  ! mean temp content
+
+      !zbg_ihc = glob_sum( et_i(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content
+      !zbg_shc = glob_sum( et_s(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content
 
       ! Volume
       ztmp = rswitch * z1_area * r1_rau0 * rday
-      zbg_vfx     = ztmp * glob_sum(     emp(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) )
-      zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) )
+      zbg_vfx     = ztmp * glob_sum(     emp(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) )
 
       ! Salt
-      zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) )
-
-      zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) )
-      zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) )
+      zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) )
+
+      zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) )
+      zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) )
 
       ! Heat budget
-      zbg_ihc      = glob_sum( et_i(:,:) * 1.e-20 ) ! ice heat content  [1.e-20 J]
-      zbg_shc      = glob_sum( et_s(:,:) * 1.e-20 ) ! snow heat content [1.e-20 J]
-      zbg_hfx_dhc  = glob_sum( diag_heat_dhc(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-
-      zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_res  = glob_sum( hfx_res(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_out  = glob_sum( hfx_out(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-      zbg_hfx_in   = glob_sum(  hfx_in(:,:) * area(:,:) * tms(:,:) ) ! [in W]
+      zbg_ihc      = glob_sum( et_i(:,:) * e12t(:,:) * 1.e-20 ) ! ice heat content  [1.e20 J]
+      zbg_shc      = glob_sum( et_s(:,:) * e12t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J]
+      zbg_hfx_dhc  = glob_sum( diag_heat(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+
+      zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_res  = glob_sum( hfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_out  = glob_sum( hfx_out(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+      zbg_hfx_in   = glob_sum(  hfx_in(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
     
       ! --------------------------------------------- !
       ! 2 - Trends due to forcing and ice growth/melt !
       ! --------------------------------------------- !
-      z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes
-      z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * area(:,:) * tms(:,:) ) ! salt fluxes
+      z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes
+      z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * e12t(:,:) * tmask(:,:,1) ) ! salt fluxes
       z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + &
-                          &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + wfx_sub(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes
+                          &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + &
+                          &     wfx_sub(:,:) ) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes
       !
       frc_vol  = frc_vol  + z_frc_vol  * rdt_ice
@@ -247,11 +245,4 @@
          WRITE(numout,*) '~~~~~~~~~~~~'
       ENDIF
-
-      ! ---------------------------------- !
-      ! 2 - initial conservation variables !
-      ! ---------------------------------- !
-      !frc_vol = 0._wp                                          ! volume       trend due to forcing
-      !frc_sal = 0._wp                                          ! salt content   -    -   -    -         
-      !bg_grme = 0._wp                                          ! ice growth + melt volume trend
       !
       CALL lim_diahsb_rst( nstart, 'READ' )  !* read or initialize all required files
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 5682)
@@ -6,5 +6,5 @@
    !! history :  1.0  ! 2002-08  (C. Ethe, G. Madec)  original VP code 
    !!            3.0  ! 2007-03  (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle)  LIM3: EVP-Cgrid
-   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
+   !!            3.5  ! 2011-02  (G. Madec) dynamical allocation
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -20,5 +20,4 @@
    USE sbc_ice          ! Surface boundary condition: ice   fields
    USE ice              ! LIM-3 variables
-   USE par_ice          ! LIM-3 parameters
    USE dom_ice          ! LIM-3 domain
    USE limrhg           ! LIM-3 rheology
@@ -31,4 +30,5 @@
    USE timing          ! Timing
    USE limcons        ! conservation tests
+   USE limvar
 
    IMPLICIT NONE
@@ -76,4 +76,6 @@
       CALL wrk_alloc( jpj, zswitch, zmsk )
 
+      CALL lim_var_agg(1)             ! aggregate ice categories
+
       IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only)
 
@@ -83,6 +85,6 @@
          IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
-         u_ice_b(:,:) = u_ice(:,:) * tmu(:,:)
-         v_ice_b(:,:) = v_ice(:,:) * tmv(:,:)
+         u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1)
+         v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1)
 
          ! Rheology (ice dynamics)
@@ -101,5 +103,5 @@
             DO jj = 1, jpj
                zswitch(jj) = SUM( 1.0 - at_i(:,jj) )   ! = REAL(jpj) if ocean everywhere on a j-line
-               zmsk(jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line
+               zmsk   (jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line
             END DO
 
@@ -157,9 +159,9 @@
          zv_io(:,:) = v_ice(:,:) - ssv_m(:,:)
          ! frictional velocity at T-point
-         zcoef = 0.5_wp * cw
+         zcoef = 0.5_wp * rn_cio
          DO jj = 2, jpjm1 
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ust2s(ji,jj) = zcoef * (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   &
-                  &                    + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1)   ) * tms(ji,jj)
+                  &                    + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) * tmask(ji,jj,1)
             END DO
          END DO
@@ -170,9 +172,9 @@
       ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean
          !
-         zcoef = SQRT( 0.5_wp ) / rau0
+         zcoef = SQRT( 0.5_wp ) * r1_rau0
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ust2s(ji,jj) = zcoef * SQRT(  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   &
-                  &                        + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1)   ) * tms(ji,jj)
+                  &                        + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) * tmask(ji,jj,1)
             END DO
          END DO
@@ -189,5 +191,5 @@
          CALL prt_ctl(tab2d_1=delta_i   , clinfo1=' lim_dyn  : delta_i   :')
          CALL prt_ctl(tab2d_1=strength  , clinfo1=' lim_dyn  : strength  :')
-         CALL prt_ctl(tab2d_1=area      , clinfo1=' lim_dyn  : cell area :')
+         CALL prt_ctl(tab2d_1=e12t      , clinfo1=' lim_dyn  : cell area :')
          CALL prt_ctl(tab2d_1=at_i      , clinfo1=' lim_dyn  : at_i      :')
          CALL prt_ctl(tab2d_1=vt_i      , clinfo1=' lim_dyn  : vt_i      :')
@@ -241,7 +243,8 @@
       !!-------------------------------------------------------------------
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namicedyn/ epsd, om, cw, pstar,   &
-         &                c_rhg, creepl, ecc, ahi0,     &
-         &                nevp, relast, alphaevp, hminrhg
+      NAMELIST/namicedyn/ nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio,  rn_creepl, rn_ecc, &
+         &                nn_nevp, rn_relast, nn_ahi0, rn_ahi0_ref
+      INTEGER  ::   ji, jj
+      REAL(wp) ::   za00, zd_max
       !!-------------------------------------------------------------------
 
@@ -259,28 +262,64 @@
          WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics '
          WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '   tolerance parameter                              epsd   = ', epsd
-         WRITE(numout,*) '   relaxation constant                              om     = ', om
-         WRITE(numout,*) '   drag coefficient for oceanic stress              cw     = ', cw
-         WRITE(numout,*) '   first bulk-rheology parameter                    pstar  = ', pstar
-         WRITE(numout,*) '   second bulk-rhelogy parameter                    c_rhg  = ', c_rhg
-         WRITE(numout,*) '   creep limit                                      creepl = ', creepl
-         WRITE(numout,*) '   eccentricity of the elliptical yield curve       ecc    = ', ecc
-         WRITE(numout,*) '   horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0
-         WRITE(numout,*) '   number of iterations for subcycling              nevp   = ', nevp
-         WRITE(numout,*) '   ratio of elastic timescale over ice time step    relast = ', relast
-         WRITE(numout,*) '   coefficient for the solution of int. stresses  alphaevp = ', alphaevp
-         WRITE(numout,*) '   min ice thickness for rheology calculations     hminrhg = ', hminrhg
+         WRITE(numout,*)'    ice strength parameterization (0=Hibler 1=Rothrock)  nn_icestr     = ', nn_icestr 
+         WRITE(numout,*)'    Including brine volume in ice strength comp.         ln_icestr_bvf = ', ln_icestr_bvf
+         WRITE(numout,*)'   Ratio of ridging work to PotEner change in ridging    rn_pe_rdg     = ', rn_pe_rdg 
+         WRITE(numout,*) '   drag coefficient for oceanic stress                  rn_cio        = ', rn_cio
+         WRITE(numout,*) '   first bulk-rheology parameter                        rn_pstar      = ', rn_pstar
+         WRITE(numout,*) '   second bulk-rhelogy parameter                        rn_crhg       = ', rn_crhg
+         WRITE(numout,*) '   creep limit                                          rn_creepl     = ', rn_creepl
+         WRITE(numout,*) '   eccentricity of the elliptical yield curve           rn_ecc        = ', rn_ecc
+         WRITE(numout,*) '   number of iterations for subcycling                  nn_nevp       = ', nn_nevp
+         WRITE(numout,*) '   ratio of elastic timescale over ice time step        rn_relast     = ', rn_relast
+         WRITE(numout,*) '   horizontal diffusivity calculation                   nn_ahi0       = ', nn_ahi0
+         WRITE(numout,*) '   horizontal diffusivity coeff. (orca2 grid)           rn_ahi0_ref   = ', rn_ahi0_ref
       ENDIF
       !
-      usecc2 = 1._wp / ( ecc * ecc )
-      rhoco  = rau0  * cw
-
-      ! elastic damping
-      telast = relast * rdt_ice
-
-      !  Diffusion coefficients.
-      ahiu(:,:) = ahi0 * umask(:,:,1)
-      ahiv(:,:) = ahi0 * vmask(:,:,1)
-      !
+      usecc2 = 1._wp / ( rn_ecc * rn_ecc )
+      rhoco  = rau0  * rn_cio
+      !
+      !  Diffusion coefficients
+      SELECT CASE( nn_ahi0 )
+
+      CASE( 0 )
+         ahiu(:,:) = rn_ahi0_ref
+         ahiv(:,:) = rn_ahi0_ref
+
+         IF(lwp) WRITE(numout,*) ''
+         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim constant = rn_ahi0_ref'
+
+      CASE( 1 ) 
+
+         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
+         IF( lk_mpp )   CALL mpp_max( zd_max )          ! max over the global domain
+         
+         ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp   ! 1.e05 = 100km = max grid space at 60° latitude in orca2
+                                                        !                    (60° = min latitude for ice cover)  
+         ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp
+
+         IF(lwp) WRITE(numout,*) ''
+         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')'
+         IF(lwp) WRITE(numout,*) '   value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp 
+         
+      CASE( 2 ) 
+
+         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
+         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
+         
+         za00 = rn_ahi0_ref * 1.e-05_wp          ! 1.e05 = 100km = max grid space at 60° latitude in orca2
+                                                 !                    (60° = min latitude for ice cover)  
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1)
+               ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1)
+            END DO
+         END DO
+         !
+         IF(lwp) WRITE(numout,*) ''
+         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to e1'
+         IF(lwp) WRITE(numout,*) '   maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max
+         
+      END SELECT
+
    END SUBROUTINE lim_dyn_init
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 5682)
@@ -13,4 +13,5 @@
    !!----------------------------------------------------------------------
    !!   lim_hdf       : diffusion trend on sea-ice variable
+   !!   lim_hdf_init  : initialisation of diffusion trend on sea-ice variable
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean domain
@@ -26,8 +27,9 @@
    PRIVATE
 
-   PUBLIC   lim_hdf     ! called by lim_tra
-
-   LOGICAL  ::   linit = .TRUE.              ! initialization flag (set to flase after the 1st call)
-   REAL(wp) ::   epsi04 = 1.e-04              ! constant
+   PUBLIC   lim_hdf         ! called by lim_trp
+   PUBLIC   lim_hdf_init    ! called by sbc_lim_init
+
+   LOGICAL  ::   linit = .TRUE.                             ! initialization flag (set to flase after the 1st call)
+   INTEGER  ::   nn_convfrq                                 !:  convergence check frequency of the Crant-Nicholson scheme
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   efact   ! metric coefficient
 
@@ -54,9 +56,12 @@
       REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   ptab    ! Field on which the diffusion is applied
       !
-      INTEGER  ::  ji, jj                   ! dummy loop indices
-      INTEGER  ::  its, iter, ierr          ! local integers
-      REAL(wp) ::   zalfa, zrlxint, zconv   ! local scalars
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zrlx, zflu, zflv, zdiv0, zdiv, ztab0
-      CHARACTER(lc) ::   charout   ! local character
+      INTEGER                           ::  ji, jj                    ! dummy loop indices
+      INTEGER                           ::  iter, ierr           ! local integers
+      REAL(wp)                          ::  zrlxint, zconv     ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zrlx, zflu, zflv, zdiv0, zdiv, ztab0
+      CHARACTER(lc)                     ::  charout                   ! local character
+      REAL(wp), PARAMETER               ::  zrelax = 0.5_wp           ! relaxation constant for iterative procedure
+      REAL(wp), PARAMETER               ::  zalfa  = 0.5_wp           ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit
+      INTEGER , PARAMETER               ::  its    = 100              ! Maximum number of iteration
       !!-------------------------------------------------------------------
       
@@ -71,5 +76,5 @@
          DO jj = 2, jpjm1  
             DO ji = fs_2 , fs_jpim1   ! vector opt.
-               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) / ( e1t(ji,jj) * e2t(ji,jj) )
+               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e12t(ji,jj)
             END DO
          END DO
@@ -77,6 +82,4 @@
       ENDIF
       !                             ! Time integration parameters
-      zalfa = 0.5_wp                      ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit
-      its   = 100                         ! Maximum number of iteration
       !
       ztab0(:, : ) = ptab(:,:)      ! Arrays initialization
@@ -91,5 +94,5 @@
       iter  = 0
       !
-      DO WHILE( zconv > ( 2._wp * epsi04 ) .AND. iter <= its )   ! Sub-time step loop
+      DO WHILE( zconv > ( 2._wp * 1.e-04 ) .AND. iter <= its )   ! Sub-time step loop
          !
          iter = iter + 1                                 ! incrementation of the sub-time step number
@@ -97,6 +100,6 @@
          DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction
             DO ji = 1 , fs_jpim1   ! vector opt.
-               zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
-               zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) / e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
+               zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
+               zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
             END DO
          END DO
@@ -104,6 +107,5 @@
          DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes
             DO ji = fs_2 , fs_jpim1   ! vector opt. 
-               zdiv (ji,jj) = (  zflu(ji,jj) - zflu(ji-1,jj  )   &
-                  &            + zflv(ji,jj) - zflv(ji  ,jj-1)  ) / ( e1t (ji,jj) * e2t (ji,jj) )
+               zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj)
             END DO
          END DO
@@ -115,18 +117,20 @@
                zrlxint = (   ztab0(ji,jj)    &
                   &       +  rdt_ice * (           zalfa   * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) )   &
-                  &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj) )  )                             & 
-                  &    / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) )
-               zrlx(ji,jj) = ptab(ji,jj) + om * ( zrlxint - ptab(ji,jj) )
+                  &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj) )                               & 
+                  &      ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) )
+               zrlx(ji,jj) = ptab(ji,jj) + zrelax * ( zrlxint - ptab(ji,jj) )
             END DO
          END DO
          CALL lbc_lnk( zrlx, 'T', 1. )                   ! lateral boundary condition
          !
-         zconv = 0._wp                                   ! convergence test
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) )  )
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_max( zconv )            ! max over the global domain
+         IF ( MOD( iter, nn_convfrq ) == 0 )  THEN    ! convergence test every nn_convfrq iterations (perf. optimization)
+            zconv = 0._wp
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) )  )
+               END DO
+            END DO
+            IF( lk_mpp )   CALL mpp_max( zconv )      ! max over the global domain
+         ENDIF
          !
          ptab(:,:) = zrlx(:,:)
@@ -138,6 +142,6 @@
       DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction
          DO ji = 1 , fs_jpim1   ! vector opt.
-            zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
-            zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) / e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
+            zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
+            zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
          END DO
       END DO
@@ -145,6 +149,5 @@
       DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes
          DO ji = fs_2 , fs_jpim1   ! vector opt. 
-            zdiv (ji,jj) = (  zflu(ji,jj) - zflu(ji-1,jj  )   &
-                 &            + zflv(ji,jj) - zflv(ji  ,jj-1)  ) / ( e1t (ji,jj) * e2t (ji,jj) )
+            zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj)
             ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) )
          END DO
@@ -164,11 +167,45 @@
    END SUBROUTINE lim_hdf
 
+   
+   SUBROUTINE lim_hdf_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_hdf_init  ***
+      !!
+      !! ** Purpose : Initialisation of horizontal diffusion of sea-ice 
+      !!
+      !! ** Method  : Read the namicehdf namelist
+      !!
+      !! ** input   : Namelist namicehdf
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namicehdf/ nn_convfrq
+      !!-------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_hdf : Ice horizontal diffusion'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namicehdf in reference namelist : Ice horizontal diffusion
+      READ  ( numnam_ice_ref, namicehdf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicehdf in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicehdf in configuration namelist : Ice horizontal diffusion
+      READ  ( numnam_ice_cfg, namicehdf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicehdf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicehdf )
+      !
+      IF(lwp) THEN                          ! control print
+         WRITE(numout,*)
+         WRITE(numout,*)'   Namelist of ice parameters for ice horizontal diffusion computation '
+         WRITE(numout,*)'      convergence check frequency of the Crant-Nicholson scheme   nn_convfrq   = ', nn_convfrq
+      ENDIF
+      !
+   END SUBROUTINE lim_hdf_init
 #else
    !!----------------------------------------------------------------------
    !!   Default option          Dummy module           NO LIM sea-ice model
    !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_hdf         ! Empty routine
-   END SUBROUTINE lim_hdf
 #endif
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 5682)
@@ -22,5 +22,4 @@
    USE eosbn2           ! equation of state
    USE ice              ! sea-ice variables
-   USE par_ice          ! ice parameters
    USE par_oce          ! ocean parameters
    USE dom_ice          ! sea-ice domain
@@ -36,17 +35,17 @@
 
    !                          !!** init namelist (namiceini) **
-   REAL(wp) ::   thres_sst   ! threshold water temperature for initial sea ice
-   REAL(wp) ::   hts_ini_n   ! initial snow thickness in the north
-   REAL(wp) ::   hts_ini_s   ! initial snow thickness in the south
-   REAL(wp) ::   hti_ini_n   ! initial ice thickness in the north
-   REAL(wp) ::   hti_ini_s   ! initial ice thickness in the south
-   REAL(wp) ::   ati_ini_n   ! initial leads area in the north
-   REAL(wp) ::   ati_ini_s   ! initial leads area in the south
-   REAL(wp) ::   smi_ini_n   ! initial salinity 
-   REAL(wp) ::   smi_ini_s   ! initial salinity
-   REAL(wp) ::   tmi_ini_n   ! initial temperature
-   REAL(wp) ::   tmi_ini_s   ! initial temperature
-
-   LOGICAL  ::  ln_limini    ! initialization or not
+   REAL(wp) ::   rn_thres_sst   ! threshold water temperature for initial sea ice
+   REAL(wp) ::   rn_hts_ini_n   ! initial snow thickness in the north
+   REAL(wp) ::   rn_hts_ini_s   ! initial snow thickness in the south
+   REAL(wp) ::   rn_hti_ini_n   ! initial ice thickness in the north
+   REAL(wp) ::   rn_hti_ini_s   ! initial ice thickness in the south
+   REAL(wp) ::   rn_ati_ini_n   ! initial leads area in the north
+   REAL(wp) ::   rn_ati_ini_s   ! initial leads area in the south
+   REAL(wp) ::   rn_smi_ini_n   ! initial salinity 
+   REAL(wp) ::   rn_smi_ini_s   ! initial salinity
+   REAL(wp) ::   rn_tmi_ini_n   ! initial temperature
+   REAL(wp) ::   rn_tmi_ini_s   ! initial temperature
+
+   LOGICAL  ::  ln_iceini    ! initialization or not
    !!----------------------------------------------------------------------
    !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008)
@@ -87,5 +86,5 @@
       !! * Local variables
       INTEGER    :: ji, jj, jk, jl             ! dummy loop indices
-      REAL(wp)   :: epsi20, ztmelts, zdh
+      REAL(wp)   :: ztmelts, zdh
       INTEGER    :: i_hemis, i_fill, jl0  
       REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv
@@ -101,6 +100,4 @@
       CALL wrk_alloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
 
-      epsi20   = 1.e-20_wp
-
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization '
@@ -115,12 +112,13 @@
       ! surface temperature
       DO jl = 1, jpl ! loop over categories
-         t_su  (:,:,jl) = rtt * tms(:,:)
-         tn_ice(:,:,jl) = rtt * tms(:,:)
+         t_su  (:,:,jl) = rt0 * tmask(:,:,1)
+         tn_ice(:,:,jl) = rt0 * tmask(:,:,1)
       END DO
 
       ! basal temperature (considered at freezing point)
-      t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:) 
-
-      IF( ln_limini ) THEN
+      CALL eos_fzp( sss_m(:,:), t_bo(:,:) )
+      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 
+
+      IF( ln_iceini ) THEN
 
       !--------------------------------------------------------------------
@@ -130,8 +128,8 @@
       DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest
          DO ji = 1, jpi
-            IF( ( tsn(ji,jj,1,jp_tem)  - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN 
-               zswitch(ji,jj) = 0._wp * tms(ji,jj)    ! no ice
+            IF( ( sst_m(ji,jj)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN 
+               zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice
             ELSE                                                                                   
-               zswitch(ji,jj) = 1._wp * tms(ji,jj)    !    ice
+               zswitch(ji,jj) = 1._wp * tmask(ji,jj,1)    !    ice
             ENDIF
          END DO
@@ -158,9 +156,9 @@
       !-----------------------------
       ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array
-      zht_i_ini(1) = hti_ini_n ; zht_i_ini(2) = hti_ini_s  ! ice thickness
-      zht_s_ini(1) = hts_ini_n ; zht_s_ini(2) = hts_ini_s  ! snow depth
-      zat_i_ini(1) = ati_ini_n ; zat_i_ini(2) = ati_ini_s  ! ice concentration
-      zsm_i_ini(1) = smi_ini_n ; zsm_i_ini(2) = smi_ini_s  ! bulk ice salinity
-      ztm_i_ini(1) = tmi_ini_n ; ztm_i_ini(2) = tmi_ini_s  ! temperature (ice and snow)
+      zht_i_ini(1) = rn_hti_ini_n ; zht_i_ini(2) = rn_hti_ini_s  ! ice thickness
+      zht_s_ini(1) = rn_hts_ini_n ; zht_s_ini(2) = rn_hts_ini_s  ! snow depth
+      zat_i_ini(1) = rn_ati_ini_n ; zat_i_ini(2) = rn_ati_ini_s  ! ice concentration
+      zsm_i_ini(1) = rn_smi_ini_n ; zsm_i_ini(2) = rn_smi_ini_s  ! bulk ice salinity
+      ztm_i_ini(1) = rn_tmi_ini_n ; ztm_i_ini(2) = rn_tmi_ini_s  ! temperature (ice and snow)
 
       zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:)   ! ice volume
@@ -197,11 +195,11 @@
                !--- Ice thicknesses in the i_fill - 1 first categories
                DO jl = 1, i_fill - 1
-                  zh_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) )
+                  zh_i_ini(jl,i_hemis) = hi_mean(jl)
                END DO
                
                !--- jl0: most likely index where cc will be maximum
                DO jl = 1, jpl
-                  IF ( ( zht_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. &
-                     ( zht_i_ini(i_hemis) .LE. hi_max(jl)   ) ) THEN
+                  IF ( ( zht_i_ini(i_hemis) >  hi_max(jl-1) ) .AND. &
+                     & ( zht_i_ini(i_hemis) <= hi_max(jl)   ) ) THEN
                      jl0 = jl
                   ENDIF
@@ -267,5 +265,5 @@
 
             ! Test 3: thickness of the last category is in-bounds ?
-            IF ( zh_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN
+            IF ( zh_i_ini(i_fill, i_hemis) > hi_max(i_fill-1) ) THEN
                ztest_3 = 1
             ELSE
@@ -317,9 +315,9 @@
             DO ji = 1, jpi
                a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration
-               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))  ! ice thickness
+               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))   ! ice thickness
                ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) )  ! snow depth
-               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min ! salinity
-               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age
-               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt ! surf temp
+               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj))     ! salinity
+               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                        ! age (1 day)
+               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp
 
                ! This case below should not be used if (ht_s/ht_i) is ok in namelist
@@ -329,5 +327,5 @@
                ! recompute ht_i, ht_s avoiding out of bounds values
                ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh )
-               ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic / rhosn )
+               ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn )
 
                ! ice volume, salt content, age content
@@ -336,7 +334,7 @@
                smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content
                oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content
-            END DO ! ji
-         END DO ! jj
-      END DO ! jl
+            END DO
+         END DO
+      END DO
 
       ! Snow temperature and heat content
@@ -345,15 +343,14 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt
+                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0
                    ! Snow energy of melting
-                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus )
-                   ! Change dimensions
-                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac
-                   ! Multiply by volume, so that heat content in Joules
-                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s
-               END DO ! ji
-            END DO ! jj
-         END DO ! jl
-      END DO ! jk
+                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
+
+                   ! Mutliply by volume, and divide by number of layers to get heat content in J/m2
+                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
+               END DO
+            END DO
+         END DO
+      END DO
 
       ! Ice salinity, temperature and heat content
@@ -362,27 +359,24 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 
-                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min
-                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K
+                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 
+                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin
+                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K
 
                    ! heat content per unit volume
                    e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
-                      +   lfus    * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) &
-                      -   rcp     * ( ztmelts - rtt ) )
-
-                   ! Correct dimensions to avoid big values
-                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac 
-
-                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J
-                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i
-               END DO ! ji
-            END DO ! jj
-         END DO ! jl
-      END DO ! jk
+                      +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &
+                      -   rcp     * ( ztmelts - rt0 ) )
+
+                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
+                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i
+               END DO
+            END DO
+         END DO
+      END DO
 
       tn_ice (:,:,:) = t_su (:,:,:)
 
       ELSE 
-         ! if ln_limini=false
+         ! if ln_iceini=false
          a_i  (:,:,:) = 0._wp
          v_i  (:,:,:) = 0._wp
@@ -400,12 +394,12 @@
          DO jl = 1, jpl
             DO jk = 1, nlay_i
-               t_i(:,:,jk,jl) = rtt * tms(:,:)
+               t_i(:,:,jk,jl) = rt0 * tmask(:,:,1)
             END DO
             DO jk = 1, nlay_s
-               t_s(:,:,jk,jl) = rtt * tms(:,:)
+               t_s(:,:,jk,jl) = rt0 * tmask(:,:,1)
             END DO
          END DO
       
-      ENDIF ! ln_limini
+      ENDIF ! ln_iceini
       
       at_i (:,:) = 0.0_wp
@@ -481,6 +475,6 @@
       !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization
       !!-----------------------------------------------------------------------------
-      NAMELIST/namiceini/ ln_limini, thres_sst, hts_ini_n, hts_ini_s, hti_ini_n, hti_ini_s,  &
-         &                                      ati_ini_n, ati_ini_s, smi_ini_n, smi_ini_s, tmi_ini_n, tmi_ini_s
+      NAMELIST/namiceini/ ln_iceini, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, rn_hti_ini_n, rn_hti_ini_s,  &
+         &                                      rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s
       INTEGER :: ios                 ! Local integer output status for namelist read
       !!-----------------------------------------------------------------------------
@@ -502,16 +496,16 @@
          WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation '
          WRITE(numout,*) '~~~~~~~~~~~~~~~'
-         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini   = ', ln_limini
-         WRITE(numout,*) '   threshold water temp. for initial sea-ice    thres_sst  = ', thres_sst
-         WRITE(numout,*) '   initial snow thickness in the north          hts_ini_n  = ', hts_ini_n
-         WRITE(numout,*) '   initial snow thickness in the south          hts_ini_s  = ', hts_ini_s 
-         WRITE(numout,*) '   initial ice thickness  in the north          hti_ini_n  = ', hti_ini_n
-         WRITE(numout,*) '   initial ice thickness  in the south          hti_ini_s  = ', hti_ini_s
-         WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_n  = ', ati_ini_n
-         WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_s  = ', ati_ini_s
-         WRITE(numout,*) '   initial  ice salinity  in the north          smi_ini_n  = ', smi_ini_n
-         WRITE(numout,*) '   initial  ice salinity  in the south          smi_ini_s  = ', smi_ini_s
-         WRITE(numout,*) '   initial  ice/snw temp  in the north          tmi_ini_n  = ', tmi_ini_n
-         WRITE(numout,*) '   initial  ice/snw temp  in the south          tmi_ini_s  = ', tmi_ini_s
+         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_iceini     = ', ln_iceini
+         WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst
+         WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n
+         WRITE(numout,*) '   initial snow thickness in the south          rn_hts_ini_s  = ', rn_hts_ini_s 
+         WRITE(numout,*) '   initial ice thickness  in the north          rn_hti_ini_n  = ', rn_hti_ini_n
+         WRITE(numout,*) '   initial ice thickness  in the south          rn_hti_ini_s  = ', rn_hti_ini_s
+         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_n  = ', rn_ati_ini_n
+         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_s  = ', rn_ati_ini_s
+         WRITE(numout,*) '   initial  ice salinity  in the north          rn_smi_ini_n  = ', rn_smi_ini_n
+         WRITE(numout,*) '   initial  ice salinity  in the south          rn_smi_ini_s  = ', rn_smi_ini_s
+         WRITE(numout,*) '   initial  ice/snw temp  in the north          rn_tmi_ini_n  = ', rn_tmi_ini_n
+         WRITE(numout,*) '   initial  ice/snw temp  in the south          rn_tmi_ini_s  = ', rn_tmi_ini_s
       ENDIF
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 5682)
@@ -18,14 +18,12 @@
    USE thd_ice          ! LIM thermodynamics
    USE ice              ! LIM variables
-   USE par_ice          ! LIM parameters
    USE dom_ice          ! LIM domain
-   USE limthd_lac       ! LIM
    USE limvar           ! LIM
-   USE in_out_manager   ! I/O manager
    USE lbclnk           ! lateral boundary condition - MPP exchanges
    USE lib_mpp          ! MPP library
    USE wrk_nemo         ! work arrays
    USE prtctl           ! Print control
-  ! Check budget (Rousset)
+
+   USE in_out_manager   ! I/O manager
    USE iom              ! I/O manager
    USE lib_fortran      ! glob_sum
@@ -40,6 +38,5 @@
    PUBLIC   lim_itd_me_icestrength
    PUBLIC   lim_itd_me_init
-   PUBLIC   lim_itd_me_zapsmall
-   PUBLIC   lim_itd_me_alloc        ! called by iceini.F90
+   PUBLIC   lim_itd_me_alloc        ! called by sbc_lim_init 
 
    !-----------------------------------------------------------------------
@@ -125,18 +122,19 @@
       !!  and Elizabeth C. Hunke, LANL are gratefully acknowledged
       !!--------------------------------------------------------------------!
-      INTEGER ::   ji, jj, jk, jl   ! dummy loop index
-      INTEGER ::   niter, nitermax = 20   ! local integer 
-      LOGICAL  ::   asum_error            ! flag for asum .ne. 1
+      INTEGER  ::   ji, jj, jk, jl        ! dummy loop index
+      INTEGER  ::   niter                 ! local integer 
       INTEGER  ::   iterate_ridging       ! if true, repeat the ridging
-      REAL(wp) ::   w1, tmpfac            ! local scalar
+      REAL(wp) ::   za, zfac              ! local scalar
       CHARACTER (len = 15) ::   fieldid
-      REAL(wp), POINTER, DIMENSION(:,:) ::   closing_net     ! net rate at which area is removed    (1/s)
-                                                             ! (ridging ice area - area of new ridges) / dt
-      REAL(wp), POINTER, DIMENSION(:,:) ::   divu_adv        ! divu as implied by transport scheme  (1/s)
-      REAL(wp), POINTER, DIMENSION(:,:) ::   opning          ! rate of opening due to divergence/shear
-      REAL(wp), POINTER, DIMENSION(:,:) ::   closing_gross   ! rate at which area removed, not counting area of new ridges
-      REAL(wp), POINTER, DIMENSION(:,:) ::   msnow_mlt       ! mass of snow added to ocean (kg m-2)
-      REAL(wp), POINTER, DIMENSION(:,:) ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2)
-      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final  !  ice volume summed over categories
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_net     ! net rate at which area is removed    (1/s)
+                                                               ! (ridging ice area - area of new ridges) / dt
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   divu_adv        ! divu as implied by transport scheme  (1/s)
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   opning          ! rate of opening due to divergence/shear
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_gross   ! rate at which area removed, not counting area of new ridges
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   msnow_mlt       ! mass of snow added to ocean (kg m-2)
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2)
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   vt_i_init, vt_i_final  !  ice volume summed over categories
+      !
+      INTEGER, PARAMETER ::   nitermax = 20    
       !
       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
@@ -144,5 +142,5 @@
       IF( nn_timing == 1 )  CALL timing_start('limitd_me')
 
-      CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final )
+      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final )
 
       IF(ln_ctl) THEN
@@ -156,8 +154,11 @@
       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
+      CALL lim_var_zapsmall
+      CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting
+
       !-----------------------------------------------------------------------------!
       ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons
       !-----------------------------------------------------------------------------!
-      Cp = 0.5 * grav * (rau0-rhoic) * rhoic / rau0                ! proport const for PE
+      Cp = 0.5 * grav * (rau0-rhoic) * rhoic * r1_rau0             ! proport const for PE
       !
       CALL lim_itd_me_ridgeprep                                    ! prepare ridging
@@ -193,5 +194,5 @@
             !  (thick, newly ridged ice).
 
-            closing_net(ji,jj) = Cs * 0.5 * ( Delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp )
+            closing_net(ji,jj) = rn_cs * 0.5 * ( delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp )
 
             ! 2.2 divu_adv
@@ -237,15 +238,13 @@
                ! Reduce the closing rate if more than 100% of the open water 
                ! would be removed.  Reduce the opening rate proportionately.
-               IF ( ato_i(ji,jj) .GT. epsi10 .AND. athorn(ji,jj,0) .GT. 0.0 ) THEN
-                  w1 = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice
-                  IF ( w1 .GT. ato_i(ji,jj)) THEN
-                     tmpfac = ato_i(ji,jj) / w1
-                     closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac
-                     opning(ji,jj) = opning(ji,jj) * tmpfac
-                  ENDIF !w1
-               ENDIF !at0i and athorn
-
-            END DO ! ji
-         END DO ! jj
+               za   = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice
+               IF( za > epsi20 ) THEN
+                  zfac = MIN( 1._wp, ato_i(ji,jj) / za )
+                  closing_gross(ji,jj) = closing_gross(ji,jj) * zfac
+                  opning       (ji,jj) = opning       (ji,jj) * zfac
+               ENDIF
+
+            END DO
+         END DO
 
          ! correction to closing rate / opening if excessive ice removal
@@ -253,19 +252,16 @@
          ! Reduce the closing rate if more than 100% of any ice category 
          ! would be removed.  Reduce the opening rate proportionately.
-
          DO jl = 1, jpl
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  IF ( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp )THEN
-                     w1 = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice
-                     IF ( w1  >  a_i(ji,jj,jl) ) THEN
-                        tmpfac = a_i(ji,jj,jl) / w1
-                        closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac
-                        opning       (ji,jj) = opning       (ji,jj) * tmpfac
-                     ENDIF
+                  za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice
+                  IF( za  >  epsi20 ) THEN
+                     zfac = MIN( 1._wp, a_i(ji,jj,jl) / za )
+                     closing_gross(ji,jj) = closing_gross(ji,jj) * zfac
+                     opning       (ji,jj) = opning       (ji,jj) * zfac
                   ENDIF
-               END DO !ji
-            END DO ! jj
-         END DO !jl
+               END DO
+            END DO
+         END DO
 
          ! 3.3 Redistribute area, volume, and energy.
@@ -276,6 +272,9 @@
          ! 3.4 Compute total area of ice plus open water after ridging.
          !-----------------------------------------------------------------------------!
-
-         CALL lim_itd_me_asumr
+         ! This is in general not equal to one because of divergence during transport
+         asum(:,:) = ato_i(:,:)
+         DO jl = 1, jpl
+            asum(:,:) = asum(:,:) + a_i(:,:,jl)
+         END DO
 
          ! 3.5 Do we keep on iterating ???
@@ -288,5 +287,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF (ABS(asum(ji,jj) - kamax ) .LT. epsi10) THEN
+               IF (ABS(asum(ji,jj) - kamax ) < epsi10) THEN
                   closing_net(ji,jj) = 0._wp
                   opning     (ji,jj) = 0._wp
@@ -324,11 +323,6 @@
       ! Convert ridging rate diagnostics to correct units.
       ! Update fresh water and heat fluxes due to snow melt.
-
-      asum_error = .false. 
-
       DO jj = 1, jpj
          DO ji = 1, jpi
-
-            IF(ABS(asum(ji,jj) - kamax) > epsi10 ) asum_error = .true.
 
             dardg1dt(ji,jj) = dardg1dt(ji,jj) * r1_rdtice
@@ -341,5 +335,5 @@
             !-----------------------------------------------------------------------------!
             wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean
-            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * unit_fac / area(ji,jj) * r1_rdtice  ! heat sink for ocean (<0, W.m-2)
+            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice     ! heat sink for ocean (<0, W.m-2)
 
          END DO
@@ -347,20 +341,21 @@
 
       ! Check if there is a ridging error
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ABS( asum(ji,jj) - kamax)  >  epsi10 ) THEN   ! there is a bug
-               WRITE(numout,*) ' '
-               WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj)
-               WRITE(numout,*) ' limitd_me '
-               WRITE(numout,*) ' POINT : ', ji, jj
-               WRITE(numout,*) ' jpl, a_i, athorn '
-               WRITE(numout,*) 0, ato_i(ji,jj), athorn(ji,jj,0)
-               DO jl = 1, jpl
-                  WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl)
-               END DO
-            ENDIF  ! asum
-
-         END DO !ji
-      END DO !jj
+      IF( lwp ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( ABS( asum(ji,jj) - kamax)  >  epsi10 ) THEN   ! there is a bug
+                  WRITE(numout,*) ' '
+                  WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj)
+                  WRITE(numout,*) ' limitd_me '
+                  WRITE(numout,*) ' POINT : ', ji, jj
+                  WRITE(numout,*) ' jpl, a_i, athorn '
+                  WRITE(numout,*) 0, ato_i(ji,jj), athorn(ji,jj,0)
+                  DO jl = 1, jpl
+                     WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl)
+                  END DO
+               ENDIF
+            END DO
+         END DO
+      END IF
 
       ! Conservation check
@@ -371,16 +366,16 @@
       ENDIF
 
+      CALL lim_var_agg( 1 ) 
+
       !-----------------------------------------------------------------------------!
-      ! 6) Updating state variables and trend terms (done in limupdate)
+      ! control prints
       !-----------------------------------------------------------------------------!
-      CALL lim_var_glo2eqv
-      CALL lim_itd_me_zapsmall
-
-
-      IF(ln_ctl) THEN     ! Control print
+      IF(ln_ctl) THEN 
+         CALL lim_var_glo2eqv
+
          CALL prt_ctl_info(' ')
          CALL prt_ctl_info(' - Cell values : ')
          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_me  : cell area :')
+         CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_me  : cell area :')
          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me  : at_i      :')
          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me  : vt_i      :')
@@ -436,9 +431,8 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kstrngth    ! = 1 for Rothrock formulation, 0 for Hibler (1979)
-
-      INTEGER ::   ji,jj, jl   ! dummy loop indices
-      INTEGER ::   ksmooth     ! smoothing the resistance to deformation
-      INTEGER ::   numts_rm    ! number of time steps for the P smoothing
-      REAL(wp) ::   hi, zw1, zp, zdummy, zzc, z1_3   ! local scalars
+      INTEGER             ::   ji,jj, jl   ! dummy loop indices
+      INTEGER             ::   ksmooth     ! smoothing the resistance to deformation
+      INTEGER             ::   numts_rm    ! number of time steps for the P smoothing
+      REAL(wp)            ::   zhi, zp, z1_3  ! local scalars
       REAL(wp), POINTER, DIMENSION(:,:) ::   zworka   ! temporary array used here
       !!----------------------------------------------------------------------
@@ -466,30 +460,29 @@
                   !
                   IF( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp ) THEN
-                     hi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+                     zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
                      !----------------------------
                      ! PE loss from deforming ice
                      !----------------------------
-                     strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * hi * hi
+                     strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * zhi * zhi
 
                      !--------------------------
                      ! PE gain from rafting ice
                      !--------------------------
-                     strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * hi * hi
+                     strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * zhi * zhi
 
                      !----------------------------
                      ! PE gain from ridging ice
                      !----------------------------
-                     strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl)/krdg(ji,jj,jl)     &
-                        * z1_3 * (hrmax(ji,jj,jl)**3 - hrmin(ji,jj,jl)**3) / ( hrmax(ji,jj,jl)-hrmin(ji,jj,jl) )   
-!!gm Optimization:  (a**3-b**3)/(a-b) = a*a+ab+b*b   ==> less costly operations even if a**3 is replaced by a*a*a...                    
-                  ENDIF            ! aicen > epsi10
+                     strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl) / krdg(ji,jj,jl)     &
+                        * z1_3 * ( hrmax(ji,jj,jl)**2 + hrmin(ji,jj,jl)**2 +  hrmax(ji,jj,jl) * hrmin(ji,jj,jl) )  
+                        !!(a**3-b**3)/(a-b) = a*a+ab+b*b                      
+                  ENDIF
                   !
-               END DO ! ji
-            END DO !jj
-         END DO !jl
-
-         zzc = Cf * Cp     ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and Cf accounts for frictional dissipation
-         strength(:,:) = zzc * strength(:,:) / aksum(:,:)
-
+               END DO
+            END DO
+         END DO
+   
+         strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:)
+                         ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation
          ksmooth = 1
 
@@ -499,5 +492,5 @@
       ELSE                      ! kstrngth ne 1:  Hibler (1979) form
          !
-         strength(:,:) = Pstar * vt_i(:,:) * EXP( - C_rhg * ( 1._wp - at_i(:,:) )  )
+         strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) )  )
          !
          ksmooth = 1
@@ -511,16 +504,11 @@
       ! CAN BE REMOVED
       !
-      IF ( brinstren_swi == 1 ) THEN
+      IF( ln_icestr_bvf ) THEN
 
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF ( bv_i(ji,jj) .GT. 0.0 ) THEN
-                  zdummy = MIN ( bv_i(ji,jj), 0.10 ) * MIN( bv_i(ji,jj), 0.10 )
-               ELSE
-                  zdummy = 0.0
-               ENDIF
                strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bv_i(ji,jj),0.0)))
-            END DO              ! j
-         END DO                 ! i
+            END DO
+         END DO
 
       ENDIF
@@ -538,16 +526,11 @@
          CALL lbc_lnk( strength, 'T', 1. )
 
-         DO jj = 2, jpj - 1
-            DO ji = 2, jpi - 1
-               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi10) THEN ! ice is
-                  ! present
-                  zworka(ji,jj) = 4.0 * strength(ji,jj)              &
-                     &          + strength(ji-1,jj) * tms(ji-1,jj) &  
-                     &          + strength(ji+1,jj) * tms(ji+1,jj) &  
-                     &          + strength(ji,jj-1) * tms(ji,jj-1) &  
-                     &          + strength(ji,jj+1) * tms(ji,jj+1)    
-
-                  zw1 = 4.0 + tms(ji-1,jj) + tms(ji+1,jj) + tms(ji,jj-1) + tms(ji,jj+1)
-                  zworka(ji,jj) = zworka(ji,jj) / zw1
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN 
+                  zworka(ji,jj) = ( 4.0 * strength(ji,jj)              &
+                     &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &  
+                     &                  + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) &
+                     &            ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) )
                ELSE
                   zworka(ji,jj) = 0._wp
@@ -556,6 +539,6 @@
          END DO
 
-         DO jj = 2, jpj - 1
-            DO ji = 2, jpi - 1
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
                strength(ji,jj) = zworka(ji,jj)
             END DO
@@ -563,5 +546,5 @@
          CALL lbc_lnk( strength, 'T', 1. )
 
-      ENDIF ! ksmooth
+      ENDIF
 
       !--------------------
@@ -580,8 +563,8 @@
          DO jj = 1, jpj - 1
             DO ji = 1, jpi - 1
-               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi10) THEN       ! ice is present
+               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN 
                   numts_rm = 1 ! number of time steps for the running mean
-                  IF ( strp1(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1
-                  IF ( strp2(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1
+                  IF ( strp1(ji,jj) > 0.0 ) numts_rm = numts_rm + 1
+                  IF ( strp2(ji,jj) > 0.0 ) numts_rm = numts_rm + 1
                   zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / numts_rm
                   strp2(ji,jj) = strp1(ji,jj)
@@ -612,5 +595,5 @@
       !!---------------------------------------------------------------------!
       INTEGER ::   ji,jj, jl    ! dummy loop indices
-      REAL(wp) ::   Gstari, astari, hi, hrmean, zdummy   ! local scalar
+      REAL(wp) ::   Gstari, astari, zhi, hrmean, zdummy   ! local scalar
       REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka    ! temporary array used here
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n
@@ -620,6 +603,6 @@
       CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
 
-      Gstari     = 1.0/Gstar    
-      astari     = 1.0/astar    
+      Gstari     = 1.0/rn_gstar    
+      astari     = 1.0/rn_astar    
       aksum(:,:)    = 0.0
       athorn(:,:,:) = 0.0
@@ -632,5 +615,5 @@
 
       !     ! Zero out categories with very small areas
-      CALL lim_itd_me_zapsmall
+      CALL lim_var_zapsmall
 
       !------------------------------------------------------------------------------!
@@ -639,7 +622,9 @@
 
       ! Compute total area of ice plus open water.
-      CALL lim_itd_me_asumr
-      ! This is in general not equal to one 
-      ! because of divergence during transport
+      ! This is in general not equal to one because of divergence during transport
+      asum(:,:) = ato_i(:,:)
+      DO jl = 1, jpl
+         asum(:,:) = asum(:,:) + a_i(:,:,jl)
+      END DO
 
       ! Compute cumulative thickness distribution function
@@ -649,22 +634,9 @@
 
       Gsum(:,:,-1) = 0._wp
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ato_i(ji,jj) > epsi10 ) THEN   ;   Gsum(ji,jj,0) = ato_i(ji,jj)
-            ELSE                               ;   Gsum(ji,jj,0) = 0._wp
-            ENDIF
-         END DO
-      END DO
+      Gsum(:,:,0 ) = ato_i(:,:)
 
       ! for each value of h, you have to add ice concentration then
       DO jl = 1, jpl
-         DO jj = 1, jpj 
-            DO ji = 1, jpi
-               IF( a_i(ji,jj,jl) .GT. epsi10 ) THEN   ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl)
-               ELSE                                   ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1)
-               ENDIF
-            END DO
-         END DO
+         Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl)
       END DO
 
@@ -687,51 +659,50 @@
       !-----------------------------------------------------------------
 
-      IF( partfun_swi == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975)
+      IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975)
          DO jl = 0, jpl    
             DO jj = 1, jpj 
                DO ji = 1, jpi
-                  IF( Gsum(ji,jj,jl) < Gstar) THEN
-                     athorn(ji,jj,jl) = Gstari * (Gsum(ji,jj,jl)-Gsum(ji,jj,jl-1)) * &
-                        (2.0 - (Gsum(ji,jj,jl-1)+Gsum(ji,jj,jl))*Gstari)
-                  ELSEIF (Gsum(ji,jj,jl-1) < Gstar) THEN
-                     athorn(ji,jj,jl) = Gstari * (Gstar-Gsum(ji,jj,jl-1)) *  &
-                        (2.0 - (Gsum(ji,jj,jl-1)+Gstar)*Gstari)
+                  IF( Gsum(ji,jj,jl) < rn_gstar) THEN
+                     athorn(ji,jj,jl) = Gstari * ( Gsum(ji,jj,jl) - Gsum(ji,jj,jl-1) ) * &
+                        &                        ( 2.0 - (Gsum(ji,jj,jl-1) + Gsum(ji,jj,jl) ) * Gstari )
+                  ELSEIF (Gsum(ji,jj,jl-1) < rn_gstar) THEN
+                     athorn(ji,jj,jl) = Gstari * ( rn_gstar - Gsum(ji,jj,jl-1) ) *  &
+                        &                        ( 2.0 - ( Gsum(ji,jj,jl-1) + rn_gstar ) * Gstari )
                   ELSE
                      athorn(ji,jj,jl) = 0.0
                   ENDIF
-               END DO ! ji
-            END DO ! jj
-         END DO ! jl 
+               END DO
+            END DO
+         END DO
 
       ELSE                             !--- Exponential, more stable formulation (Lipscomb et al, 2007)
          !                        
          zdummy = 1._wp / ( 1._wp - EXP(-astari) )        ! precompute exponential terms using Gsum as a work array
-
          DO jl = -1, jpl
             Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy
-         END DO !jl
+         END DO
          DO jl = 0, jpl
              athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl)
          END DO
          !
-      ENDIF ! partfun_swi
-
-      IF( raft_swi == 1 ) THEN      ! Ridging and rafting ice participation functions
+      ENDIF
+
+      IF( ln_rafting ) THEN      ! Ridging and rafting ice participation functions
          !
          DO jl = 1, jpl
             DO jj = 1, jpj 
                DO ji = 1, jpi
-                  IF ( athorn(ji,jj,jl) .GT. 0._wp ) THEN
+                  IF ( athorn(ji,jj,jl) > 0._wp ) THEN
 !!gm  TANH( -X ) = - TANH( X )  so can be computed only 1 time....
-                     aridge(ji,jj,jl) = ( TANH (  Craft * ( ht_i(ji,jj,jl) - hparmeter ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
-                     araft (ji,jj,jl) = ( TANH ( -Craft * ( ht_i(ji,jj,jl) - hparmeter ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
+                     aridge(ji,jj,jl) = ( TANH (  rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
+                     araft (ji,jj,jl) = ( TANH ( -rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
                      IF ( araft(ji,jj,jl) < epsi06 )   araft(ji,jj,jl)  = 0._wp
                      aridge(ji,jj,jl) = MAX( athorn(ji,jj,jl) - araft(ji,jj,jl), 0.0 )
-                  ENDIF ! athorn
-               END DO ! ji
-            END DO ! jj
-         END DO ! jl
-
-      ELSE  ! raft_swi = 0
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ELSE
          !
          DO jl = 1, jpl
@@ -741,11 +712,11 @@
       ENDIF
 
-      IF ( raft_swi == 1 ) THEN
-
-         IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi10 ) THEN
+      IF( ln_rafting ) THEN
+
+         IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) > epsi10 .AND. lwp ) THEN
             DO jl = 1, jpl
                DO jj = 1, jpj
                   DO ji = 1, jpi
-                     IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) .GT. epsi10 ) THEN
+                     IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) > epsi10 ) THEN
                         WRITE(numout,*) ' ALERTE 96 : wrong participation function ... '
                         WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl
@@ -793,11 +764,11 @@
             DO ji = 1, jpi
 
-               IF (a_i(ji,jj,jl) .GT. epsi10 .AND. athorn(ji,jj,jl) .GT. 0.0 ) THEN
-                  hi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
-                  hrmean          = MAX(SQRT(Hstar*hi), hi*krdgmin)
-                  hrmin(ji,jj,jl) = MIN(2.0*hi, 0.5*(hrmean + hi))
+               IF (a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0.0 ) THEN
+                  zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+                  hrmean          = MAX(SQRT(rn_hstar*zhi), zhi*krdgmin)
+                  hrmin(ji,jj,jl) = MIN(2.0*zhi, 0.5*(hrmean + zhi))
                   hrmax(ji,jj,jl) = 2.0*hrmean - hrmin(ji,jj,jl)
-                  hraft(ji,jj,jl) = kraft*hi
-                  krdg(ji,jj,jl)  = hrmean / hi
+                  hraft(ji,jj,jl) = kraft*zhi
+                  krdg(ji,jj,jl)  = hrmean / zhi
                ELSE
                   hraft(ji,jj,jl) = 0.0
@@ -807,7 +778,7 @@
                ENDIF
 
-            END DO ! ji
-         END DO ! jj
-      END DO ! jl
+            END DO
+         END DO
+      END DO
 
       ! Normalization factor : aksum, ensures mass conservation
@@ -841,12 +812,8 @@
       LOGICAL, PARAMETER ::   l_conservation_check = .true.  ! if true, check conservation (useful for debugging)
       !
-      LOGICAL ::   neg_ato_i      ! flag for ato_i(i,j) < -puny
-      LOGICAL ::   large_afrac    ! flag for afrac > 1
-      LOGICAL ::   large_afrft    ! flag for afrac > 1
       INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices
       INTEGER ::   ij                ! horizontal index, combines i and j loops
       INTEGER ::   icells            ! number of cells with aicen > puny
-      REAL(wp) ::   hL, hR, farea, zdummy, zdummy0, ztmelts    ! left and right limits of integration
-      REAL(wp) ::   zsstK            ! SST in Kelvin
+      REAL(wp) ::   hL, hR, farea, ztmelts    ! left and right limits of integration
 
       INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices
@@ -864,5 +831,4 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges
       REAL(wp), POINTER, DIMENSION(:,:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! areal age content of ridged & rifging ice
       REAL(wp), POINTER, DIMENSION(:,:) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2
 
@@ -873,4 +839,5 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   srdg2   ! sal*volume of new ridges
       REAL(wp), POINTER, DIMENSION(:,:) ::   smsw    ! sal*volume of water trapped into ridges
+      REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! ice age of ice ridged
 
       REAL(wp), POINTER, DIMENSION(:,:) ::   afrft            ! fraction of category area rafted
@@ -878,5 +845,5 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   virft , vsrft    ! ice & snow volume of rafting ice
       REAL(wp), POINTER, DIMENSION(:,:) ::   esrft , smrft    ! snow energy & salinity of rafting ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   oirft1, oirft2   ! areal age content of rafted ice & rafting ice
+      REAL(wp), POINTER, DIMENSION(:,:) ::   oirft1, oirft2   ! ice age of ice rafted
 
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   eirft      ! ice energy of rafting ice
@@ -886,12 +853,12 @@
       !!----------------------------------------------------------------------
 
-      CALL wrk_alloc( (jpi+1)*(jpj+1),      indxi, indxj )
-      CALL wrk_alloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final )
-      CALL wrk_alloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 )
-      CALL wrk_alloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw )
-      CALL wrk_alloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
-      CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
-      CALL wrk_alloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw )
-      CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, eicen_init )
+      CALL wrk_alloc( (jpi+1)*(jpj+1),       indxi, indxj )
+      CALL wrk_alloc( jpi, jpj,              vice_init, vice_final, eice_init, eice_final )
+      CALL wrk_alloc( jpi, jpj,              afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
+      CALL wrk_alloc( jpi, jpj,              vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 )
+      CALL wrk_alloc( jpi, jpj,              afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
+      CALL wrk_alloc( jpi, jpj, jpl,         aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
+      CALL wrk_alloc( jpi, jpj, nlay_i,      eirft, erdg1, erdg2, ersw )
+      CALL wrk_alloc( jpi, jpj, nlay_i, jpl, eicen_init )
 
       ! Conservation check
@@ -901,6 +868,6 @@
          CALL lim_column_sum        (jpl,    v_i,       vice_init )
          CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_init )
-         DO ji = mi0(jiindx), mi1(jiindx)
-            DO jj = mj0(jjindx), mj1(jjindx)
+         DO ji = mi0(iiceprt), mi1(iiceprt)
+            DO jj = mj0(jiceprt), mj1(jiceprt)
                WRITE(numout,*) ' vice_init  : ', vice_init(ji,jj)
                WRITE(numout,*) ' eice_init  : ', eice_init(ji,jj)
@@ -912,52 +879,26 @@
       ! 1) Compute change in open water area due to closing and opening.
       !-------------------------------------------------------------------------------
-
-      neg_ato_i = .false.
-
       DO jj = 1, jpj
          DO ji = 1, jpi
             ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice        &
                &                        + opning(ji,jj)                          * rdt_ice
-            IF( ato_i(ji,jj) < -epsi10 ) THEN
-               neg_ato_i = .TRUE.
-            ELSEIF( ato_i(ji,jj) < 0._wp ) THEN    ! roundoff error
+            IF    ( ato_i(ji,jj) < -epsi10 ) THEN    ! there is a bug
+               IF(lwp)   WRITE(numout,*) 'Ridging error: ato_i < 0 -- ato_i : ',ato_i(ji,jj)
+            ELSEIF( ato_i(ji,jj) < 0._wp   ) THEN    ! roundoff error
                ato_i(ji,jj) = 0._wp
             ENDIF
-         END DO !jj
-      END DO !ji
-
-      ! if negative open water area alert it
-      IF( neg_ato_i ) THEN       ! there is a bug
-         DO jj = 1, jpj 
-            DO ji = 1, jpi
-               IF( ato_i(ji,jj) < -epsi10 ) THEN 
-                  WRITE(numout,*) ''  
-                  WRITE(numout,*) 'Ridging error: ato_i < 0'
-                  WRITE(numout,*) 'ato_i : ', ato_i(ji,jj)
-               ENDIF               ! ato_i < -epsi10
-            END DO
-         END DO
-      ENDIF
+         END DO
+      END DO
 
       !-----------------------------------------------------------------
       ! 2) Save initial state variables
       !-----------------------------------------------------------------
-
-      DO jl = 1, jpl
-         aicen_init(:,:,jl) = a_i(:,:,jl)
-         vicen_init(:,:,jl) = v_i(:,:,jl)
-         vsnwn_init(:,:,jl) = v_s(:,:,jl)
-         !
-         smv_i_init(:,:,jl) = smv_i(:,:,jl)
-         oa_i_init (:,:,jl) = oa_i (:,:,jl)
-      END DO !jl
-
-      esnwn_init(:,:,:) = e_s(:,:,1,:)
-
-      DO jl = 1, jpl  
-         DO jk = 1, nlay_i
-            eicen_init(:,:,jk,jl) = e_i(:,:,jk,jl)
-         END DO
-      END DO
+      aicen_init(:,:,:)   = a_i  (:,:,:)
+      vicen_init(:,:,:)   = v_i  (:,:,:)
+      vsnwn_init(:,:,:)   = v_s  (:,:,:)
+      smv_i_init(:,:,:)   = smv_i(:,:,:)
+      esnwn_init(:,:,:)   = e_s  (:,:,1,:)
+      eicen_init(:,:,:,:) = e_i  (:,:,:,:)
+      oa_i_init (:,:,:)   = oa_i (:,:,:)
 
       !
@@ -982,12 +923,8 @@
                   indxi(icells) = ji
                   indxj(icells) = jj
-               ENDIF ! test on a_icen_init 
-            END DO ! ji
-         END DO ! jj
-
-         large_afrac = .false.
-         large_afrft = .false.
-
-!CDIR NODEP
+               ENDIF
+            END DO
+         END DO
+
          DO ij = 1, icells
             ji = indxi(ij)
@@ -1003,9 +940,4 @@
             arft2(ji,jj) = arft1(ji,jj) / kraft
 
-            oirdg1(ji,jj)= aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice
-            oirft1(ji,jj)= araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice
-            oirdg2(ji,jj)= oirdg1(ji,jj) / krdg(ji,jj,jl1)
-            oirft2(ji,jj)= oirft1(ji,jj) / kraft
-
             !---------------------------------------------------------------
             ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1 
@@ -1015,12 +947,13 @@
             afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting
 
-            IF (afrac(ji,jj) > kamax + epsi10) THEN  !riging
-               large_afrac = .true.
-            ELSEIF (afrac(ji,jj) > kamax) THEN  ! roundoff error
+            IF( afrac(ji,jj) > kamax + epsi10 ) THEN  ! there is a bug
+               IF(lwp)   WRITE(numout,*) ' ardg > a_i -- ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1)
+            ELSEIF( afrac(ji,jj) > kamax ) THEN       ! roundoff error
                afrac(ji,jj) = kamax
             ENDIF
-            IF (afrft(ji,jj) > kamax + epsi10) THEN !rafting
-               large_afrft = .true.
-            ELSEIF (afrft(ji,jj) > kamax) THEN  ! roundoff error
+
+            IF( afrft(ji,jj) > kamax + epsi10 ) THEN ! there is a bug
+               IF(lwp)   WRITE(numout,*) ' arft > a_i -- arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1) 
+            ELSEIF( afrft(ji,jj) > kamax) THEN       ! roundoff error
                afrft(ji,jj) = kamax
             ENDIF
@@ -1031,39 +964,42 @@
             !--------------------------------------------------------------------------
             vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj)
-            vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por )
-            vsw  (ji,jj) = vrdg1(ji,jj) * ridge_por
-
-            vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj)
-            esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj)
-            srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj)
-            srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless
+            vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + rn_por_rdg )
+            vsw  (ji,jj) = vrdg1(ji,jj) * rn_por_rdg
+
+            vsrdg (ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj)
+            esrdg (ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj)
+            srdg1 (ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj)
+            oirdg1(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj)
+            oirdg2(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) / krdg(ji,jj,jl1) 
 
             ! rafting volumes, heat contents ...
-            virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj)
-            vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj)
-            esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj)
-            smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj) 
+            virft (ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj)
+            vsrft (ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj)
+            esrft (ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj)
+            smrft (ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj) 
+            oirft1(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) 
+            oirft2(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) / kraft 
 
             ! substract everything
-            a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1(ji,jj)  - arft1(ji,jj)
-            v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1(ji,jj)  - virft(ji,jj)
-            v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg(ji,jj)  - vsrft(ji,jj)
-            e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg(ji,jj)  - esrft(ji,jj)
+            a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1 (ji,jj) - arft1 (ji,jj)
+            v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1 (ji,jj) - virft (ji,jj)
+            v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg (ji,jj) - vsrft (ji,jj)
+            e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg (ji,jj) - esrft (ji,jj)
+            smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1 (ji,jj) - smrft (ji,jj)
             oa_i(ji,jj,jl1)  = oa_i(ji,jj,jl1)  - oirdg1(ji,jj) - oirft1(ji,jj)
-            smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1(ji,jj)  - smrft(ji,jj)
 
             !-----------------------------------------------------------------
             ! 3.5) Compute properties of new ridges
             !-----------------------------------------------------------------
-            !-------------
+            !---------
             ! Salinity
-            !-------------
+            !---------
             smsw(ji,jj)  = vsw(ji,jj) * sss_m(ji,jj)                      ! salt content of seawater frozen in voids !! MV HC2014
             srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge
 
-            !srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity
+            !srdg2(ji,jj) = MIN( rn_simax * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity
             
             sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice
-            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! gurvan: increase in ice volume du to seawater frozen in voids             
+            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! increase in ice volume du to seawater frozen in voids             
 
             !------------------------------------            
@@ -1091,10 +1027,10 @@
             !           ij looping 1-icells
 
-            msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-fsnowrdg)   &   ! rafting included
-               &                                + rhosn*vsrft(ji,jj)*(1.0-fsnowrft)
-
-            ! in 1e-9 Joules (same as e_s)
-            esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-fsnowrdg)         &   !rafting included
-               &                                - esrft(ji,jj)*(1.0-fsnowrft)          
+            msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-rn_fsnowrdg)   &   ! rafting included
+               &                                + rhosn*vsrft(ji,jj)*(1.0-rn_fsnowrft)
+
+            ! in J/m2 (same as e_s)
+            esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-rn_fsnowrdg)         &   !rafting included
+               &                                - esrft(ji,jj)*(1.0-rn_fsnowrft)          
 
             !-----------------------------------------------------------------
@@ -1109,5 +1045,5 @@
             dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1)
 
-         END DO                 ! ij
+         END DO
 
          !--------------------------------------------------------------------
@@ -1116,5 +1052,4 @@
          !--------------------------------------------------------------------
          DO jk = 1, nlay_i
-!CDIR NODEP
             DO ij = 1, icells
                ji = indxi(ij)
@@ -1128,57 +1063,23 @@
                ! enthalpy of the trapped seawater (J/m2, >0)
                ! clem: if sst>0, then ersw <0 (is that possible?)
-               zsstK  = sst_m(ji,jj) + rt0
-               ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) / REAL( nlay_i )
+               ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * sst_m(ji,jj) * r1_nlay_i
 
                ! heat flux to the ocean
                hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux 
 
-               ! Correct dimensions to avoid big values
-               ersw(ji,jj,jk)   = ersw(ji,jj,jk) / unit_fac
-
-               ! Mutliply by ice volume, and divide by number of layers to get heat content in 1.e9 J
-               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean 
-               !! MV HC 2014
-               ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj)
-
+               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean
                erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk)
 
-            END DO ! ij
-         END DO !jk
+            END DO
+         END DO
 
 
          IF( con_i ) THEN
             DO jk = 1, nlay_i
-!CDIR NODEP
                DO ij = 1, icells
                   ji = indxi(ij)
                   jj = indxj(ij)
                   eice_init(ji,jj) = eice_init(ji,jj) + erdg2(ji,jj,jk) - erdg1(ji,jj,jk)
-               END DO ! ij
-            END DO !jk
-         ENDIF
-
-         IF( large_afrac ) THEN   ! there is a bug
-!CDIR NODEP
-            DO ij = 1, icells
-               ji = indxi(ij)
-               jj = indxj(ij)
-               IF( afrac(ji,jj) > kamax + epsi10 ) THEN 
-                  WRITE(numout,*) ''
-                  WRITE(numout,*) ' ardg > a_i'
-                  WRITE(numout,*) ' ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1)
-               ENDIF
-            END DO
-         ENDIF
-         IF( large_afrft ) THEN  ! there is a bug
-!CDIR NODEP
-            DO ij = 1, icells
-               ji = indxi(ij)
-               jj = indxj(ij)
-               IF( afrft(ji,jj) > kamax + epsi10 ) THEN 
-                  WRITE(numout,*) ''
-                  WRITE(numout,*) ' arft > a_i'
-                  WRITE(numout,*) ' arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1)
-               ENDIF
+               END DO
             END DO
          ENDIF
@@ -1190,5 +1091,4 @@
          DO jl2  = 1, jpl 
             ! over categories to which ridged ice is transferred
-!CDIR NODEP
             DO ij = 1, icells
                ji = indxi(ij)
@@ -1199,6 +1099,5 @@
                ! Transfer area, volume, and energy accordingly.
 
-               IF( hrmin(ji,jj,jl1) >= hi_max(jl2)  .OR.        &
-                   hrmax(ji,jj,jl1) <= hi_max(jl2-1) ) THEN
+               IF( hrmin(ji,jj,jl1) >= hi_max(jl2) .OR. hrmax(ji,jj,jl1) <= hi_max(jl2-1) ) THEN
                   hL = 0._wp
                   hR = 0._wp
@@ -1214,18 +1113,17 @@
                a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + ardg2 (ji,jj) * farea
                v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + vrdg2 (ji,jj) * fvol(ji,jj)
-               v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * fsnowrdg
-               e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * fsnowrdg
+               v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg
+               e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg
                smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + srdg2 (ji,jj) * fvol(ji,jj)
                oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirdg2(ji,jj) * farea
 
-            END DO ! ij
+            END DO
 
             ! Transfer ice energy to category jl2 by ridging
             DO jk = 1, nlay_i
-!CDIR NODEP
                DO ij = 1, icells
                   ji = indxi(ij)
                   jj = indxj(ij)
-                  e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + fvol(ji,jj)*erdg2(ji,jj,jk)
+                  e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + fvol(ji,jj) * erdg2(ji,jj,jk)
                END DO
             END DO
@@ -1235,5 +1133,4 @@
          DO jl2 = 1, jpl 
 
-!CDIR NODEP
             DO ij = 1, icells
                ji = indxi(ij)
@@ -1242,30 +1139,27 @@
                ! thickness category jl2, transfer area, volume, and energy accordingly.
                !
-               IF( hraft(ji,jj,jl1) <= hi_max(jl2)  .AND.        &
-                   hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN
+               IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN
                   a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + arft2 (ji,jj)
                   v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + virft (ji,jj)
-                  v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrft (ji,jj) * fsnowrft
-                  e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrft (ji,jj) * fsnowrft
+                  v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrft (ji,jj) * rn_fsnowrft
+                  e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrft (ji,jj) * rn_fsnowrft
                   smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + smrft (ji,jj)    
-                  oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj)    
-               ENDIF ! hraft
+                  oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj)
+               ENDIF
                !
-            END DO ! ij
+            END DO
 
             ! Transfer rafted ice energy to category jl2 
             DO jk = 1, nlay_i
-!CDIR NODEP
                DO ij = 1, icells
                   ji = indxi(ij)
                   jj = indxj(ij)
-                  IF(  hraft(ji,jj,jl1)  <=  hi_max(jl2)   .AND.        &
-                       hraft(ji,jj,jl1)  >   hi_max(jl2-1)  ) THEN
+                  IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) > hi_max(jl2-1)  ) THEN
                      e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk)
                   ENDIF
-               END DO           ! ij
-            END DO !jk
-
-         END DO ! jl2
+               END DO
+            END DO
+
+         END DO
 
       END DO ! jl1 (deforming categories)
@@ -1281,6 +1175,6 @@
          CALL lim_cons_check (eice_init, eice_final, 1.0e-2, fieldid) 
 
-         DO ji = mi0(jiindx), mi1(jiindx)
-            DO jj = mj0(jjindx), mj1(jjindx)
+         DO ji = mi0(iiceprt), mi1(iiceprt)
+            DO jj = mj0(jiceprt), mj1(jiceprt)
                WRITE(numout,*) ' vice_init  : ', vice_init (ji,jj)
                WRITE(numout,*) ' vice_final : ', vice_final(ji,jj)
@@ -1291,37 +1185,14 @@
       ENDIF
       !
-      CALL wrk_dealloc( (jpi+1)*(jpj+1),      indxi, indxj )
-      CALL wrk_dealloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final )
-      CALL wrk_dealloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 )
-      CALL wrk_dealloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw )
-      CALL wrk_dealloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
-      CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
-      CALL wrk_dealloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw )
-      CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, eicen_init )
+      CALL wrk_dealloc( (jpi+1)*(jpj+1),        indxi, indxj )
+      CALL wrk_dealloc( jpi, jpj,               vice_init, vice_final, eice_init, eice_final )
+      CALL wrk_dealloc( jpi, jpj,               afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
+      CALL wrk_dealloc( jpi, jpj,               vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 )
+      CALL wrk_dealloc( jpi, jpj,               afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
+      CALL wrk_dealloc( jpi, jpj, jpl,          aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
+      CALL wrk_dealloc( jpi, jpj, nlay_i,       eirft, erdg1, erdg2, ersw )
+      CALL wrk_dealloc( jpi, jpj, nlay_i, jpl,  eicen_init )
       !
    END SUBROUTINE lim_itd_me_ridgeshift
-
-
-   SUBROUTINE lim_itd_me_asumr
-      !!-----------------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_me_asumr ***
-      !!
-      !! ** Purpose :   finds total fractional area
-      !!
-      !! ** Method  :   Find the total area of ice plus open water in each grid cell.
-      !!              This is similar to the aggregate_area subroutine except that the
-      !!              total area can be greater than 1, so the open water area is 
-      !!              included in the sum instead of being computed as a residual. 
-      !!-----------------------------------------------------------------------------
-      INTEGER ::   jl   ! dummy loop index
-      !!-----------------------------------------------------------------------------
-      !
-      asum(:,:) = ato_i(:,:)                    ! open water
-      DO jl = 1, jpl                            ! ice categories
-         asum(:,:) = asum(:,:) + a_i(:,:,jl)
-      END DO
-      !
-   END SUBROUTINE lim_itd_me_asumr
-
 
    SUBROUTINE lim_itd_me_init
@@ -1339,7 +1210,7 @@
       !!-------------------------------------------------------------------
       INTEGER :: ios                 ! Local integer output status for namelist read
-      NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft,              & 
-        &                   Gstar, astar, Hstar, raft_swi, hparmeter, Craft, ridge_por, &
-        &                   partfun_swi, brinstren_swi
+      NAMELIST/namiceitdme/ rn_cs, rn_fsnowrdg, rn_fsnowrft,              & 
+        &                   rn_gstar, rn_astar, rn_hstar, ln_rafting, rn_hraft, rn_craft, rn_por_rdg, &
+        &                   nn_partfun
       !!-------------------------------------------------------------------
       !
@@ -1357,130 +1228,18 @@
          WRITE(numout,*)' lim_itd_me_init : ice parameters for mechanical ice redistribution '
          WRITE(numout,*)' ~~~~~~~~~~~~~~~'
-         WRITE(numout,*)'   Switch choosing the ice redistribution scheme           ridge_scheme_swi', ridge_scheme_swi 
-         WRITE(numout,*)'   Fraction of shear energy contributing to ridging        Cs              ', Cs 
-         WRITE(numout,*)'   Ratio of ridging work to PotEner change in ridging      Cf              ', Cf 
-         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        fsnowrdg        ', fsnowrdg 
-         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        fsnowrft        ', fsnowrft 
-         WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  Gstar           ', Gstar
-         WRITE(numout,*)'   Equivalent to G* for an exponential part function       astar           ', astar
-         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     Hstar           ', Hstar
-         WRITE(numout,*)'   Rafting of ice sheets or not                            raft_swi        ', raft_swi
-         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       hparmeter       ', hparmeter
-         WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  Craft           ', Craft  
-         WRITE(numout,*)'   Initial porosity of ridges                              ridge_por       ', ridge_por
-         WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    partfun_swi     ', partfun_swi
-         WRITE(numout,*)'   Switch for including brine volume in ice strength comp. brinstren_swi   ', brinstren_swi
+         WRITE(numout,*)'   Fraction of shear energy contributing to ridging        rn_cs       = ', rn_cs 
+         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrdg = ', rn_fsnowrdg 
+         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrft = ', rn_fsnowrft 
+         WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  rn_gstar    = ', rn_gstar
+         WRITE(numout,*)'   Equivalent to G* for an exponential part function       rn_astar    = ', rn_astar
+         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     rn_hstar    = ', rn_hstar
+         WRITE(numout,*)'   Rafting of ice sheets or not                            ln_rafting  = ', ln_rafting
+         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       rn_hraft    = ', rn_hraft
+         WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  rn_craft    = ', rn_craft  
+         WRITE(numout,*)'   Initial porosity of ridges                              rn_por_rdg  = ', rn_por_rdg
+         WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    nn_partfun  = ', nn_partfun
       ENDIF
       !
    END SUBROUTINE lim_itd_me_init
-
-
-   SUBROUTINE lim_itd_me_zapsmall
-      !!-------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_itd_me_zapsmall ***
-      !!
-      !! ** Purpose :   Remove too small sea ice areas and correct salt fluxes
-      !!
-      !! history :
-      !! author: William H. Lipscomb, LANL
-      !! Nov 2003:  Modified by Julie Schramm to conserve volume and energy
-      !! Sept 2004: Modified by William Lipscomb; replaced normalize_state with
-      !!            additions to local freshwater, salt, and heat fluxes
-      !!  9.0, LIM3.0 - 02-2006 (M. Vancoppenolle) original code
-      !!-------------------------------------------------------------------
-      INTEGER ::   ji, jj, jl, jk   ! dummy loop indices
-      INTEGER ::   icells           ! number of cells with ice to zap
-
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask   ! 2D workspace
-      REAL(wp)                          ::   zmask_glo, zsal, zvi, zvs, zei, zes
-!!gm      REAL(wp) ::   xtmp      ! temporary variable
-      !!-------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi, jpj, zmask )
-
-      ! to be sure that at_i is the sum of a_i(jl)
-      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
-
-      DO jl = 1, jpl
-         !-----------------------------------------------------------------
-         ! Count categories to be zapped.
-         !-----------------------------------------------------------------
-         icells = 0
-         zmask(:,:)  = 0._wp
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( a_i(ji,jj,jl) <= epsi10 .OR. v_i(ji,jj,jl) <= epsi10 .OR. at_i(ji,jj) <= epsi10 ) THEN
-                  zmask(ji,jj) = 1._wp
-               ENDIF
-            END DO
-         END DO
-         !zmask_glo = glob_sum(zmask)
-         !IF( ln_nicep .AND. lwp ) WRITE(numout,*) zmask_glo, ' cells of ice zapped in the ocean '
-
-         !-----------------------------------------------------------------
-         ! Zap ice energy and use ocean heat to melt ice
-         !-----------------------------------------------------------------
-
-         DO jk = 1, nlay_i
-            DO jj = 1 , jpj
-               DO ji = 1 , jpi
-                  zei  = e_i(ji,jj,jk,jl)
-                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) )
-                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) + rtt * zmask(ji,jj)
-                  ! update exchanges with ocean
-                  hfx_res(ji,jj)   = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
-               END DO
-            END DO
-         END DO
-
-         DO jj = 1 , jpj
-            DO ji = 1 , jpi
-               
-               zsal = smv_i(ji,jj,jl)
-               zvi  = v_i(ji,jj,jl)
-               zvs  = v_s(ji,jj,jl)
-               zes  = e_s(ji,jj,1,jl)
-               !-----------------------------------------------------------------
-               ! Zap snow energy and use ocean heat to melt snow
-               !-----------------------------------------------------------------
-               !           xtmp = esnon(i,j,n) / dt ! < 0
-               !           fhnet(i,j)      = fhnet(i,j)      + xtmp
-               !           fhnet_hist(i,j) = fhnet_hist(i,j) + xtmp
-               ! xtmp is greater than 0
-               ! fluxes are positive to the ocean
-               ! here the flux has to be negative for the ocean
-               t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) )
-
-               !-----------------------------------------------------------------
-               ! zap ice and snow volume, add water and salt to ocean
-               !-----------------------------------------------------------------
-               ato_i(ji,jj)    = a_i  (ji,jj,jl) *           zmask(ji,jj)   + ato_i(ji,jj)
-               a_i  (ji,jj,jl) = a_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
-               v_i  (ji,jj,jl) = v_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
-               v_s  (ji,jj,jl) = v_s  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
-               t_su (ji,jj,jl) = t_su (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj)
-               oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
-               smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
-               e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) )
-               ! additional condition
-               IF( v_s(ji,jj,jl) <= epsi10 ) THEN
-                  v_s(ji,jj,jl)   = 0._wp
-                  e_s(ji,jj,1,jl) = 0._wp
-               ENDIF
-               ! update exchanges with ocean
-               sfx_res(ji,jj)  = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
-               wfx_res(ji,jj)  = wfx_res(ji,jj) - ( v_i(ji,jj,jl)   - zvi  ) * rhoic * r1_rdtice
-               wfx_snw(ji,jj)  = wfx_snw(ji,jj) - ( v_s(ji,jj,jl)   - zvs  ) * rhosn * r1_rdtice
-               hfx_res(ji,jj)  = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
-            END DO
-         END DO
-      END DO ! jl 
-
-      ! to be sure that at_i is the sum of a_i(jl)
-      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
-      !
-      CALL wrk_dealloc( jpi, jpj, zmask )
-      !
-   END SUBROUTINE lim_itd_me_zapsmall
 
 #else
@@ -1493,10 +1252,6 @@
    SUBROUTINE lim_itd_me_icestrength
    END SUBROUTINE lim_itd_me_icestrength
-   SUBROUTINE lim_itd_me_sort
-   END SUBROUTINE lim_itd_me_sort
    SUBROUTINE lim_itd_me_init
    END SUBROUTINE lim_itd_me_init
-   SUBROUTINE lim_itd_me_zapsmall
-   END SUBROUTINE lim_itd_me_zapsmall
 #endif
    !!======================================================================
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90	(revision 5682)
@@ -13,5 +13,4 @@
    !!   'key_lim3' :                                   LIM3 sea-ice model
    !!----------------------------------------------------------------------
-   !!   lim_itd_th       : thermodynamics of ice thickness distribution
    !!   lim_itd_th_rem   :
    !!   lim_itd_th_reb   :
@@ -25,8 +24,5 @@
    USE thd_ice          ! LIM-3 thermodynamic variables
    USE ice              ! LIM-3 variables
-   USE par_ice          ! LIM-3 parameters
-   USE limthd_lac       ! LIM-3 lateral accretion
    USE limvar           ! LIM-3 variables
-   USE limcons          ! LIM-3 conservation
    USE prtctl           ! Print control
    USE in_out_manager   ! I/O manager
@@ -34,15 +30,11 @@
    USE wrk_nemo         ! work arrays
    USE lib_fortran      ! to use key_nosignedzero
-   USE timing          ! Timing
-   USE limcons        ! conservation tests
+   USE limcons          ! conservation tests
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_itd_th         ! called by ice_stp
    PUBLIC   lim_itd_th_rem
    PUBLIC   lim_itd_th_reb
-   PUBLIC   lim_itd_fitline
-   PUBLIC   lim_itd_shiftice
 
    !!----------------------------------------------------------------------
@@ -53,84 +45,4 @@
 CONTAINS
 
-   SUBROUTINE lim_itd_th( kt )
-      !!------------------------------------------------------------------
-      !!                ***  ROUTINE lim_itd_th ***
-      !!
-      !! ** Purpose :   computes the thermodynamics of ice thickness distribution
-      !!
-      !! ** Method  :
-      !!------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! time step index
-      !
-      INTEGER ::   ji, jj, jk, jl   ! dummy loop index         
-      !
-      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
-      !!------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('limitd_th')
-
-      ! conservation test
-      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'lim_itd_th  : Thermodynamics of the ice thickness distribution'
-         WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-
-      !------------------------------------------------------------------------------|
-      !  1) Transport of ice between thickness categories.                           |
-      !------------------------------------------------------------------------------|
-      ! Given thermodynamic growth rates, transport ice between
-      ! thickness categories.
-      IF( jpl > 1 )   CALL lim_itd_th_rem( 1, jpl, kt )
-      !
-      CALL lim_var_glo2eqv    ! only for info
-      CALL lim_var_agg(1)
-
-      !------------------------------------------------------------------------------|
-      !  3) Add frazil ice growing in leads.
-      !------------------------------------------------------------------------------|
-      CALL lim_thd_lac
-      CALL lim_var_glo2eqv    ! only for info
-     
-      IF(ln_ctl) THEN   ! Control print
-         CALL prt_ctl_info(' ')
-         CALL prt_ctl_info(' - Cell values : ')
-         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_th  : cell area :')
-         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th  : at_i      :')
-         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th  : vt_i      :')
-         CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th  : vt_s      :')
-         DO jl = 1, jpl
-            CALL prt_ctl_info(' ')
-            CALL prt_ctl_info(' - Category : ', ivar1=jl)
-            CALL prt_ctl_info('   ~~~~~~~~~~')
-            CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : a_i      : ')
-            CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_i     : ')
-            CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_s     : ')
-            CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_i      : ')
-            CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_s      : ')
-            CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : e_s      : ')
-            CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_itd_th  : t_su     : ')
-            CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : t_snow   : ')
-            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ')
-            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ')
-            DO jk = 1, nlay_i
-               CALL prt_ctl_info(' ')
-               CALL prt_ctl_info(' - Layer : ', ivar1=jk)
-               CALL prt_ctl_info('   ~~~~~~~')
-               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : t_i      : ')
-               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : e_i      : ')
-            END DO
-         END DO
-      ENDIF
-      !
-      ! conservation test
-      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-      !
-     IF( nn_timing == 1 )  CALL timing_stop('limitd_th')
-   END SUBROUTINE lim_itd_th
-   !
-
    SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt )
       !!------------------------------------------------------------------
@@ -153,5 +65,5 @@
       REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars
       REAL(wp) ::   zx2, zwk2, zda0, zetamax           !   -      -
-      REAL(wp) ::   zx3,             zareamin          !   -      -
+      REAL(wp) ::   zx3        
       CHARACTER (len = 15) :: fieldid
 
@@ -179,14 +91,12 @@
       !!------------------------------------------------------------------
 
-      CALL wrk_alloc( jpi,jpj, zremap_flag )    ! integer
-      CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )   ! integer
+      CALL wrk_alloc( jpi,jpj, zremap_flag )
+      CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )
       CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )
       CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )   
       CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
       CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )   
-      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
+      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
       CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final )
-
-      zareamin = epsi10   !minimum area in thickness categories tolerated by the conceptors of the model
 
       !!----------------------------------------------------------------------------------------------
@@ -216,9 +126,9 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               rswitch             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) )     !0 if no ice and 1 if yes
+               rswitch           = MAX( 0.0, SIGN( 1.0, a_i(ji,jj,jl) - epsi10 ) )     !0 if no ice and 1 if yes
                ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * rswitch
-               rswitch             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i_b(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes
+               rswitch           = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) )
                zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch
-               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) 
+               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) ! clem: useless IF statement? 
             END DO
          END DO
@@ -239,5 +149,5 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            IF ( at_i(ji,jj) .gt. zareamin ) THEN
+            IF ( at_i(ji,jj) > epsi10 ) THEN
                nbrem         = nbrem + 1
                nind_i(nbrem) = ji
@@ -247,6 +157,6 @@
                zremap_flag(ji,jj) = 0
             ENDIF
-         END DO !ji
-      END DO !jj
+         END DO
+      END DO
 
       !-----------------------------------------------------------------------------------------------
@@ -254,7 +164,4 @@
       !-----------------------------------------------------------------------------------------------
       !- 4.1 Compute category boundaries
-      ! Tricky trick see limitd_me.F90
-      ! will be soon removed, CT
-      ! hi_max(kubnd) = 99.
       zhbnew(:,:,:) = 0._wp
 
@@ -265,11 +172,11 @@
             !
             zhbnew(ii,ij,jl) = hi_max(jl)
-            IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN
+            IF    ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN
                !interpolate between adjacent category growth rates
                zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) )
                zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) )
-            ELSEIF ( a_i_b(ii,ij,jl) > epsi10) THEN
+            ELSEIF( a_i_b(ii,ij,jl) > epsi10) THEN
                zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl)
-            ELSEIF ( a_i_b(ii,ij,jl+1) > epsi10) THEN
+            ELSEIF( a_i_b(ii,ij,jl+1) > epsi10) THEN
                zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1)
             ENDIF
@@ -280,16 +187,23 @@
             ii = nind_i(ji)
             ij = nind_j(ji)
-            IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN
+
+            ! clem: we do not want ht_i to be too close to either HR or HL otherwise a division by nearly 0 is possible 
+            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
+            IF    ( a_i(ii,ij,jl  ) > epsi10 .AND. ht_i(ii,ij,jl  ) > ( zhbnew(ii,ij,jl) - epsi10 ) ) THEN
                zremap_flag(ii,ij) = 0
-            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN
+            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) < ( zhbnew(ii,ij,jl) + epsi10 ) ) THEN
                zremap_flag(ii,ij) = 0
             ENDIF
 
             !- 4.3 Check that each zhbnew does not exceed maximal values hi_max  
+            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0
             IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0
-            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0
-         END DO
-
-      END DO !jl
+            ! clem bug: why is not the following instead?
+            !!IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0
+            !!IF( zhbnew(ii,ij,jl) > hi_max(jl  ) ) zremap_flag(ii,ij) = 0
+ 
+         END DO
+
+      END DO
 
       !-----------------------------------------------------------------------------------------------
@@ -312,21 +226,24 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            zhb0(ji,jj) = hi_max(0) ! 0eme
-            zhb1(ji,jj) = hi_max(1) ! 1er
-
-            zhbnew(ji,jj,klbnd-1) = 0._wp
+            zhb0(ji,jj) = hi_max(0)
+            zhb1(ji,jj) = hi_max(1)
 
             IF( a_i(ji,jj,kubnd) > epsi10 ) THEN
-               zhbnew(ji,jj,kubnd) = 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1)
+               zhbnew(ji,jj,kubnd) = MAX( hi_max(kubnd-1), 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1) )
             ELSE
-               zhbnew(ji,jj,kubnd) = hi_max(kubnd)  
-               !!? clem bug: since hi_max(jpl)=99, this limit is very high 
-               !!? but I think it is erased in fitline subroutine 
-            ENDIF
-
-            IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) zhbnew(ji,jj,kubnd) = hi_max(kubnd-1)
-
-         END DO !jj
-      END DO !jj
+!clem bug               zhbnew(ji,jj,kubnd) = hi_max(kubnd)  
+               zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) ! not used anyway
+            ENDIF
+
+            ! clem: we do not want ht_i_b to be too close to either HR or HL otherwise a division by nearly 0 is possible 
+            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
+            IF    ( zht_i_b(ji,jj,klbnd) < ( zhb0(ji,jj) + epsi10 ) )  THEN
+               zremap_flag(ji,jj) = 0
+            ELSEIF( zht_i_b(ji,jj,klbnd) > ( zhb1(ji,jj) - epsi10 ) )  THEN
+               zremap_flag(ji,jj) = 0
+            ENDIF
+
+         END DO
+      END DO
 
       !-----------------------------------------------------------------------------------------------
@@ -334,6 +251,5 @@
       !-----------------------------------------------------------------------------------------------
       !- 7.1 g(h) for category 1 at start of time step
-      CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd),         &
-         &                  g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   &
+      CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd), g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   &
          &                  hR(:,:,klbnd), zremap_flag )
 
@@ -343,48 +259,39 @@
          ij = nind_j(ji) 
 
-         !ji
-         IF (a_i(ii,ij,klbnd) .gt. epsi10) THEN
+         IF( a_i(ii,ij,klbnd) > epsi10 ) THEN
+
             zdh0 = zdhice(ii,ij,klbnd) !decrease of ice thickness in the lower category
-            ! ji, a_i > epsi10
-            IF (zdh0 .lt. 0.0) THEN !remove area from category 1
-               ! ji, a_i > epsi10; zdh0 < 0
-               zdh0 = MIN(-zdh0,hi_max(klbnd))
-
+
+            IF( zdh0 < 0.0 ) THEN      !remove area from category 1
+               zdh0 = MIN( -zdh0, hi_max(klbnd) )
                !Integrate g(1) from 0 to dh0 to estimate area melted
-               zetamax = MIN(zdh0,hR(ii,ij,klbnd)) - hL(ii,ij,klbnd)
-               IF (zetamax.gt.0.0) THEN
-                  zx1  = zetamax
-                  zx2  = 0.5 * zetamax*zetamax 
-                  zda0 = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1 !ice area removed
-                  ! Constrain new thickness <= ht_i
-                  zdamax = a_i(ii,ij,klbnd) * & 
-                     (1.0 - ht_i(ii,ij,klbnd)/zht_i_b(ii,ij,klbnd)) ! zdamax > 0
-                  !ice area lost due to melting of thin ice
-                  zda0   = MIN(zda0, zdamax)
-
+               zetamax = MIN( zdh0, hR(ii,ij,klbnd) ) - hL(ii,ij,klbnd)
+
+               IF( zetamax > 0.0 ) THEN
+                  zx1    = zetamax
+                  zx2    = 0.5 * zetamax * zetamax 
+                  zda0   = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1                        ! ice area removed
+                  zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! Constrain new thickness <= ht_i                
+                  zda0   = MIN( zda0, zdamax )                                                  ! ice area lost due to melting 
+                                                                                                !     of thin ice (zdamax > 0)
                   ! Remove area, conserving volume
-                  ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) & 
-                     * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 )
+                  ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 )
                   a_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd) - zda0
-                  v_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd)*ht_i(ii,ij,klbnd) ! clem-useless ?
-               ENDIF     ! zetamax > 0
-               ! ji, a_i > epsi10
-
-            ELSE ! if ice accretion
-               ! ji, a_i > epsi10; zdh0 > 0
-               zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd)) 
-               ! zhbnew was 0, and is shifted to the right to account for thin ice
-               ! growth in openwater (F0 = f1)
-            ENDIF ! zdh0 
-
-            ! a_i > epsi10
-         ENDIF ! a_i > epsi10
-
-      END DO ! ji
+                  v_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd) * ht_i(ii,ij,klbnd) ! clem-useless ?
+               ENDIF
+
+            ELSE ! if ice accretion zdh0 > 0
+               ! zhbnew was 0, and is shifted to the right to account for thin ice growth in openwater (F0 = f1)
+               zhbnew(ii,ij,klbnd-1) = MIN( zdh0, hi_max(klbnd) ) 
+            ENDIF
+
+         ENDIF
+
+      END DO
 
       !- 7.3 g(h) for each thickness category  
       DO jl = klbnd, kubnd
-         CALL lim_itd_fitline(jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), &
-            g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag)
+         CALL lim_itd_fitline( jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl),  &
+            &                  g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag )
       END DO
 
@@ -406,36 +313,34 @@
             ij = nind_j(ji)
 
-            IF (zhbnew(ii,ij,jl) .gt. hi_max(jl)) THEN ! transfer from jl to jl+1
-
+            IF (zhbnew(ii,ij,jl) > hi_max(jl)) THEN ! transfer from jl to jl+1
                ! left and right integration limits in eta space
-               zvetamin(ji) = MAX(hi_max(jl), hL(ii,ij,jl)) - hL(ii,ij,jl)
-               zvetamax(ji) = MIN(zhbnew(ii,ij,jl), hR(ii,ij,jl)) - hL(ii,ij,jl)
+               zvetamin(ji) = MAX( hi_max(jl), hL(ii,ij,jl) ) - hL(ii,ij,jl)
+               zvetamax(ji) = MIN( zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl)
                zdonor(ii,ij,jl) = jl
 
-            ELSE  ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl
-
+            ELSE                                    ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl
                ! left and right integration limits in eta space
                zvetamin(ji) = 0.0
-               zvetamax(ji) = MIN(hi_max(jl), hR(ii,ij,jl+1)) - hL(ii,ij,jl+1)
+               zvetamax(ji) = MIN( hi_max(jl), hR(ii,ij,jl+1) ) - hL(ii,ij,jl+1)
                zdonor(ii,ij,jl) = jl + 1
 
-            ENDIF  ! zhbnew(jl) > hi_max(jl)
-
-            zetamax = MAX(zvetamax(ji), zvetamin(ji)) ! no transfer if etamax < etamin
+            ENDIF
+
+            zetamax = MAX( zvetamax(ji), zvetamin(ji) ) ! no transfer if etamax < etamin
             zetamin = zvetamin(ji)
 
             zx1  = zetamax - zetamin
-            zwk1 = zetamin*zetamin
-            zwk2 = zetamax*zetamax
-            zx2  = 0.5 * (zwk2 - zwk1)
+            zwk1 = zetamin * zetamin
+            zwk2 = zetamax * zetamax
+            zx2  = 0.5 * ( zwk2 - zwk1 )
             zwk1 = zwk1 * zetamin
             zwk2 = zwk2 * zetamax
-            zx3  = 1.0/3.0 * (zwk2 - zwk1)
+            zx3  = 1.0 / 3.0 * ( zwk2 - zwk1 )
             nd   = zdonor(ii,ij,jl)
             zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1
             zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd)
 
-         END DO ! ji
-      END DO ! jl klbnd -> kubnd - 1
+         END DO
+      END DO
 
       !!----------------------------------------------------------------------------------------------
@@ -451,9 +356,9 @@
          ii = nind_i(ji)
          ij = nind_j(ji)
-         IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < hiclim ) THEN
-            a_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim 
-            ht_i(ii,ij,1) = hiclim
+         IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < rn_himin ) THEN
+            a_i (ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / rn_himin 
+            ht_i(ii,ij,1) = rn_himin
          ENDIF
-      END DO !ji
+      END DO
 
       !!----------------------------------------------------------------------------------------------
@@ -479,11 +384,11 @@
       ENDIF
 
-      CALL wrk_dealloc( jpi,jpj, zremap_flag )    ! integer
-      CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )   ! integer
+      CALL wrk_dealloc( jpi,jpj, zremap_flag )
+      CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )
       CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )
       CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )   
       CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
       CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )   
-      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
+      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
       CALL wrk_dealloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final )
 
@@ -491,6 +396,5 @@
 
 
-   SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice,   &
-      &                        g0, g1, hL, hR, zremap_flag )
+   SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice, g0, g1, hL, hR, zremap_flag )
       !!------------------------------------------------------------------
       !!                ***  ROUTINE lim_itd_fitline ***
@@ -511,5 +415,5 @@
       INTEGER , DIMENSION(jpi,jpj), INTENT(in   ) ::   zremap_flag  !
       !
-      INTEGER ::   ji,jj           ! horizontal indices
+      INTEGER  ::   ji,jj        ! horizontal indices
       REAL(wp) ::   zh13         ! HbL + 1/3 * (HbR - HbL)
       REAL(wp) ::   zh23         ! HbL + 2/3 * (HbR - HbL)
@@ -518,20 +422,17 @@
       !!------------------------------------------------------------------
       !
-      !
       DO jj = 1, jpj
          DO ji = 1, jpi
             !
             IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > epsi10   &
-               &                        .AND. hice(ji,jj)        > 0._wp     ) THEN
+               &                        .AND. hice(ji,jj)        > 0._wp )  THEN
 
                ! Initialize hL and hR
-
                hL(ji,jj) = HbL(ji,jj)
                hR(ji,jj) = HbR(ji,jj)
 
                ! Change hL or hR if hice falls outside central third of range
-
-               zh13 = 1.0/3.0 * (2.0*hL(ji,jj) + hR(ji,jj))
-               zh23 = 1.0/3.0 * (hL(ji,jj) + 2.0*hR(ji,jj))
+               zh13 = 1.0 / 3.0 * ( 2.0 * hL(ji,jj) + hR(ji,jj) )
+               zh23 = 1.0 / 3.0 * ( hL(ji,jj) + 2.0 * hR(ji,jj) )
 
                IF    ( hice(ji,jj) < zh13 ) THEN   ;   hR(ji,jj) = 3._wp * hice(ji,jj) - 2._wp * hL(ji,jj)
@@ -540,17 +441,16 @@
 
                ! Compute coefficients of g(eta) = g0 + g1*eta
-
                zdhr = 1._wp / (hR(ji,jj) - hL(ji,jj))
                zwk1 = 6._wp * a_i(ji,jj,num_cat) * zdhr
                zwk2 = ( hice(ji,jj) - hL(ji,jj) ) * zdhr
-               g0(ji,jj) = zwk1 * ( 2._wp/3._wp - zwk2 )
-               g1(ji,jj) = 2._wp * zdhr * zwk1 * (zwk2 - 0.5)
+               g0(ji,jj) = zwk1 * ( 2._wp / 3._wp - zwk2 )
+               g1(ji,jj) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5 )
                !
-            ELSE                   ! remap_flag = .false. or a_i < epsi10 
+            ELSE  ! remap_flag = .false. or a_i < epsi10 
                hL(ji,jj) = 0._wp
                hR(ji,jj) = 0._wp
                g0(ji,jj) = 0._wp
                g1(ji,jj) = 0._wp
-            ENDIF                  ! a_i > epsi10
+            ENDIF
             !
          END DO
@@ -576,5 +476,5 @@
 
       INTEGER ::   ji, jj, jl, jl2, jl1, jk   ! dummy loop indices
-      INTEGER ::   ii, ij          ! indices when changing from 2D-1D is done
+      INTEGER ::   ii, ij                     ! indices when changing from 2D-1D is done
 
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaTsfn
@@ -589,15 +489,10 @@
       INTEGER, POINTER, DIMENSION(:) ::   nind_i, nind_j   ! compressed indices for i/j directions
 
-      INTEGER ::   nbrem             ! number of cells with ice to transfer
-
-      LOGICAL ::   zdaice_negative         ! true if daice < -puny
-      LOGICAL ::   zdvice_negative         ! true if dvice < -puny
-      LOGICAL ::   zdaice_greater_aicen    ! true if daice > aicen
-      LOGICAL ::   zdvice_greater_vicen    ! true if dvice > vicen
+      INTEGER  ::   nbrem             ! number of cells with ice to transfer
       !!------------------------------------------------------------------
 
       CALL wrk_alloc( jpi,jpj,jpl, zaTsfn )
       CALL wrk_alloc( jpi,jpj, zworka )
-      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer
+      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )
 
       !----------------------------------------------------------------------------------------------
@@ -606,91 +501,9 @@
 
       DO jl = klbnd, kubnd
-         zaTsfn(:,:,jl) = a_i(:,:,jl)*t_su(:,:,jl)
-      END DO
-
-      !----------------------------------------------------------------------------------------------
-      ! 2) Check for daice or dvice out of range, allowing for roundoff error
-      !----------------------------------------------------------------------------------------------
-      ! Note: zdaice < 0 or zdvice < 0 usually happens when category jl
-      ! has a small area, with h(n) very close to a boundary.  Then
-      ! the coefficients of g(h) are large, and the computed daice and
-      ! dvice can be in error. If this happens, it is best to transfer
-      ! either the entire category or nothing at all, depending on which
-      ! side of the boundary hice(n) lies.
-      !-----------------------------------------------------------------
-      DO jl = klbnd, kubnd-1
-
-         zdaice_negative = .false.
-         zdvice_negative = .false.
-         zdaice_greater_aicen = .false.
-         zdvice_greater_vicen = .false.
-
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-
-               IF (zdonor(ji,jj,jl) .GT. 0) THEN
-                  jl1 = zdonor(ji,jj,jl)
-
-                  IF (zdaice(ji,jj,jl) .LT. 0.0) THEN
-                     IF (zdaice(ji,jj,jl) .GT. -epsi10) THEN
-                        IF ( ( jl1.EQ.jl   .AND. ht_i(ji,jj,jl1) .GT. hi_max(jl) )           &
-                           .OR.                                      &
-                           ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) )           &  
-                           ) THEN                                                             
-                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1)  ! shift entire category
-                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1)
-                        ELSE
-                           zdaice(ji,jj,jl) = 0.0 ! shift no ice
-                           zdvice(ji,jj,jl) = 0.0
-                        ENDIF
-                     ELSE
-                        zdaice_negative = .true.
-                     ENDIF
-                  ENDIF
-
-                  IF (zdvice(ji,jj,jl) .LT. 0.0) THEN
-                     IF (zdvice(ji,jj,jl) .GT. -epsi10 ) THEN
-                        IF ( ( jl1.EQ.jl .AND. ht_i(ji,jj,jl1).GT.hi_max(jl) )     &
-                           .OR.                                     &
-                           ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) ) &
-                           ) THEN
-                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category
-                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
-                        ELSE
-                           zdaice(ji,jj,jl) = 0.0    ! shift no ice
-                           zdvice(ji,jj,jl) = 0.0
-                        ENDIF
-                     ELSE
-                        zdvice_negative = .true.
-                     ENDIF
-                  ENDIF
-
-                  ! If daice is close to aicen, set daice = aicen.
-                  IF (zdaice(ji,jj,jl) .GT. a_i(ji,jj,jl1) - epsi10 ) THEN
-                     IF (zdaice(ji,jj,jl) .LT. a_i(ji,jj,jl1)+epsi10) THEN
-                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1)
-                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
-                     ELSE
-                        zdaice_greater_aicen = .true.
-                     ENDIF
-                  ENDIF
-
-                  IF (zdvice(ji,jj,jl) .GT. v_i(ji,jj,jl1)-epsi10) THEN
-                     IF (zdvice(ji,jj,jl) .LT. v_i(ji,jj,jl1)+epsi10) THEN
-                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1)
-                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
-                     ELSE
-                        zdvice_greater_vicen = .true.
-                     ENDIF
-                  ENDIF
-
-               ENDIF               ! donor > 0
-            END DO                   ! i
-         END DO                 ! j
-
-      END DO !jl
+         zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl)
+      END DO
 
       !-------------------------------------------------------------------------------
-      ! 3) Transfer volume and energy between categories
+      ! 2) Transfer volume and energy between categories
       !-------------------------------------------------------------------------------
 
@@ -699,9 +512,9 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF (zdaice(ji,jj,jl) .GT. 0.0 ) THEN ! daice(n) can be < puny
+               IF (zdaice(ji,jj,jl) > 0.0 ) THEN ! daice(n) can be < puny
                   nbrem = nbrem + 1
                   nind_i(nbrem) = ji
                   nind_j(nbrem) = jj
-               ENDIF ! tmask
+               ENDIF
             END DO
          END DO
@@ -712,8 +525,8 @@
 
             jl1 = zdonor(ii,ij,jl)
-            rswitch             = MAX( 0.0 , SIGN( 1.0 , v_i(ii,ij,jl1) - epsi10 ) )
-            zworka(ii,ij)   = zdvice(ii,ij,jl) / MAX(v_i(ii,ij,jl1),epsi10) * rswitch
+            rswitch       = MAX( 0._wp , SIGN( 1._wp , v_i(ii,ij,jl1) - epsi10 ) )
+            zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi10 ) * rswitch
             IF( jl1 == jl) THEN   ;   jl2 = jl1+1
-            ELSE                    ;   jl2 = jl 
+            ELSE                  ;   jl2 = jl 
             ENDIF
 
@@ -721,5 +534,4 @@
             ! Ice areas
             !--------------
-
             a_i(ii,ij,jl1) = a_i(ii,ij,jl1) - zdaice(ii,ij,jl)
             a_i(ii,ij,jl2) = a_i(ii,ij,jl2) + zdaice(ii,ij,jl)
@@ -728,5 +540,4 @@
             ! Ice volumes
             !--------------
-
             v_i(ii,ij,jl1) = v_i(ii,ij,jl1) - zdvice(ii,ij,jl) 
             v_i(ii,ij,jl2) = v_i(ii,ij,jl2) + zdvice(ii,ij,jl)
@@ -735,5 +546,4 @@
             ! Snow volumes
             !--------------
-
             zdvsnow        = v_s(ii,ij,jl1) * zworka(ii,ij)
             v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow
@@ -743,5 +553,4 @@
             ! Snow heat content  
             !--------------------
-
             zdesnow            = e_s(ii,ij,1,jl1) * zworka(ii,ij)
             e_s(ii,ij,1,jl1)   = e_s(ii,ij,1,jl1) - zdesnow
@@ -751,5 +560,4 @@
             ! Ice age 
             !--------------
-
             zdo_aice           = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl)
             oa_i(ii,ij,jl1)    = oa_i(ii,ij,jl1) - zdo_aice
@@ -759,5 +567,4 @@
             ! Ice salinity
             !--------------
-
             zdsm_vice          = smv_i(ii,ij,jl1) * zworka(ii,ij)
             smv_i(ii,ij,jl1)   = smv_i(ii,ij,jl1) - zdsm_vice
@@ -767,10 +574,9 @@
             ! Surface temperature
             !---------------------
-
             zdaTsf             = t_su(ii,ij,jl1) * zdaice(ii,ij,jl)
             zaTsfn(ii,ij,jl1)  = zaTsfn(ii,ij,jl1) - zdaTsf
             zaTsfn(ii,ij,jl2)  = zaTsfn(ii,ij,jl2) + zdaTsf 
 
-         END DO                 ! ji
+         END DO
 
          !------------------
@@ -779,5 +585,4 @@
 
          DO jk = 1, nlay_i
-!CDIR NODEP
             DO ji = 1, nbrem
                ii = nind_i(ji)
@@ -785,5 +590,5 @@
 
                jl1 = zdonor(ii,ij,jl)
-               IF (jl1 .EQ. jl) THEN
+               IF (jl1 == jl) THEN
                   jl2 = jl+1
                ELSE             ! n1 = n+1
@@ -794,6 +599,6 @@
                e_i(ii,ij,jk,jl1) =  e_i(ii,ij,jk,jl1) - zdeice
                e_i(ii,ij,jk,jl2) =  e_i(ii,ij,jk,jl2) + zdeice 
-            END DO              ! ji
-         END DO                 ! jk
+            END DO
+         END DO
 
       END DO                   ! boundaries, 1 to ncat-1
@@ -809,16 +614,15 @@
                   ht_i(ji,jj,jl)  =  v_i   (ji,jj,jl) / a_i(ji,jj,jl) 
                   t_su(ji,jj,jl)  =  zaTsfn(ji,jj,jl) / a_i(ji,jj,jl) 
-                  rswitch         =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes
                ELSE
                   ht_i(ji,jj,jl)  = 0._wp
-                  t_su(ji,jj,jl)  = rtt
+                  t_su(ji,jj,jl)  = rt0
                ENDIF
-            END DO                 ! ji
-         END DO                 ! jj
-      END DO                    ! jl
+            END DO
+         END DO
+      END DO
       !
       CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn )
       CALL wrk_dealloc( jpi,jpj, zworka )
-      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer
+      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )
       !
    END SUBROUTINE lim_itd_shiftice
@@ -846,5 +650,4 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   ! snow volume summed over categories
       !!------------------------------------------------------------------
-      !! clem 2014/04: be carefull, rebining does not conserve salt(maybe?) => the difference is taken into account in limupdate
       
       CALL wrk_alloc( jpi,jpj,jpl, zdonor )   ! interger
@@ -864,9 +667,6 @@
          DO jj = 1, jpj
             DO ji = 1, jpi 
-               IF( a_i(ji,jj,jl) > epsi10 ) THEN 
-                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
-               ELSE
-                  ht_i(ji,jj,jl) = 0._wp
-               ENDIF
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
+               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
             END DO
          END DO
@@ -874,19 +674,5 @@
 
       !------------------------------------------------------------------------------
-      ! 2) Make sure thickness of cat klbnd is at least hi_max(klbnd)
-      !------------------------------------------------------------------------------
-      DO jj = 1, jpj 
-         DO ji = 1, jpi 
-            IF( a_i(ji,jj,klbnd) > epsi10 ) THEN
-               IF( ht_i(ji,jj,klbnd) <= hi_max(0) .AND. hi_max(0) > 0._wp ) THEN
-                  a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max(0) 
-                  ht_i(ji,jj,klbnd) = hi_max(0)
-               ENDIF
-            ENDIF
-         END DO
-      END DO
-
-      !------------------------------------------------------------------------------
-      ! 3) If a category thickness is not in bounds, shift the
+      ! 2) If a category thickness is not in bounds, shift the
       ! entire area, volume, and energy to the neighboring category
       !------------------------------------------------------------------------------
@@ -917,15 +703,13 @@
                   zdonor(ji,jj,jl)  = jl 
                   ! begin TECLIM change
-                  !zdaice(ji,jj,jl)  = a_i(ji,jj,jl)
-                  !zdvice(ji,jj,jl)  = v_i(ji,jj,jl)
                   !zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * 0.5_wp
                   !zdvice(ji,jj,jl)  = v_i(ji,jj,jl)-zdaice(ji,jj,jl)*(hi_max(jl)+hi_max(jl-1)) * 0.5_wp
                   ! end TECLIM change 
                   ! clem: how much of a_i you send in cat sup is somewhat arbitrary
-                  zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * ( ht_i(ji,jj,jl) - hi_max(jl) + epsi10 ) / ht_i(ji,jj,jl)  
-                  zdvice(ji,jj,jl)  = v_i(ji,jj,jl) - ( a_i(ji,jj,jl) - zdaice(ji,jj,jl) ) * ( hi_max(jl) - epsi10 )
+                  zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * ( ht_i(ji,jj,jl) - hi_max(jl) + epsi20 ) / ht_i(ji,jj,jl)  
+                  zdvice(ji,jj,jl)  = v_i(ji,jj,jl) - ( a_i(ji,jj,jl) - zdaice(ji,jj,jl) ) * ( hi_max(jl) - epsi20 )
                ENDIF
-            END DO                 ! ji
-         END DO                 ! jj
+            END DO
+         END DO
          IF(lk_mpp)   CALL mpp_max( zshiftflag )
 
@@ -938,5 +722,5 @@
          ENDIF
          !
-      END DO                    ! jl
+      END DO
 
       !----------------------------
@@ -951,5 +735,4 @@
          zshiftflag = 0
 
-!clem-change
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -961,6 +744,6 @@
                   zdvice(ji,jj,jl) = v_i(ji,jj,jl+1)
                ENDIF
-            END DO                 ! ji
-         END DO                 ! jj
+            END DO
+         END DO
 
          IF(lk_mpp)   CALL mpp_max( zshiftflag )
@@ -973,21 +756,9 @@
             zdvice(:,:,jl) = 0._wp
          ENDIF
-!clem-change
-
-!         ! clem-change begin: why not doing that?
-!         DO jj = 1, jpj
-!            DO ji = 1, jpi
-!               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN
-!                  ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10
-!                  a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1) 
-!               ENDIF
-!            END DO                 ! ji
-!         END DO                 ! jj
-         ! clem-change end
-
-      END DO                    ! jl
+
+      END DO
 
       !------------------------------------------------------------------------------
-      ! 4) Conservation check
+      ! 3) Conservation check
       !------------------------------------------------------------------------------
 
@@ -1002,5 +773,5 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi,jpj,jpl, zdonor )   ! interger
+      CALL wrk_dealloc( jpi,jpj,jpl, zdonor )
       CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice )
       CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final )
@@ -1013,8 +784,4 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE lim_itd_th           ! Empty routines
-   END SUBROUTINE lim_itd_th
-   SUBROUTINE lim_itd_th_ini
-   END SUBROUTINE lim_itd_th_ini
    SUBROUTINE lim_itd_th_rem
    END SUBROUTINE lim_itd_th_rem
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90	(revision 5682)
@@ -23,5 +23,5 @@
    PRIVATE
 
-   PUBLIC   lim_msh   ! routine called by ice_ini.F90
+   PUBLIC   lim_msh   ! routine called by sbcice_lim.F90
 
    !!----------------------------------------------------------------------
@@ -41,5 +41,4 @@
       !!              - Definition of some constants linked with the grid
       !!              - Definition of the metric coef. for the sea/ice
-      !!              - Initialization of the ice masks (tmsk, umsk)
       !! 
       !! Reference  : Deleersnijder et al. Ocean Modelling 100, 7-10 
@@ -103,17 +102,4 @@
 !!gm end
 
-      !                           !==  ice masks  ==!
-      tms(:,:) = tmask(:,:,1)             ! ice T-point  : use surface tmask
-      tmu(:,:) = umask(:,:,1)             ! ice U-point  : use surface umask  (C-grid EVP)
-      tmv(:,:) = vmask(:,:,1)             ! ice V-point  : use surface vmask  (C-grid EVP)
-      DO jj = 1, jpjm1                    ! ice F-point  : recompute fmask (due to nn_shlat)
-         DO ji = 1 , jpim1   ! NO vector opt.
-            tmf(ji,jj) =  tms(ji,jj) * tms(ji+1,jj) * tms(ji,jj+1) * tms(ji+1,jj+1)
-         END DO
-      END DO
-      CALL lbc_lnk( tmf(:,:), 'F', 1. )           ! lateral boundary conditions
-
-      !                           !==  unmasked and masked area of T-grid cell
-      area(:,:) = e1t(:,:) * e2t(:,:)
       !
    END SUBROUTINE lim_msh
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 5682)
@@ -102,5 +102,5 @@
       !!                 and charge ellipse.
       !!                 The user should make sure that the parameters
-      !!                 nevp, telast and creepl maintain stress state
+      !!                 nn_nevp, elastic time scale and rn_creepl maintain stress state
       !!                 on the charge ellipse for plastic flow
       !!                 e.g. in the Canadian Archipelago
@@ -108,5 +108,4 @@
       !! References : Hunke and Dukowicz, JPO97
       !!              Bouillon et al., Ocean Modelling 2009
-      !!              Vancoppenolle et al., Ocean Modelling 2008
       !!-------------------------------------------------------------------
       INTEGER, INTENT(in) ::   k_j1    ! southern j-index for ice computation
@@ -117,18 +116,17 @@
       CHARACTER (len=50) ::   charout
       REAL(wp) ::   zt11, zt12, zt21, zt22, ztagnx, ztagny, delta                         !
-      REAL(wp) ::   za, zstms, zmask   ! local scalars
-      REAL(wp) ::   zc1, zc2, zc3             ! ice mass
-
-      REAL(wp) ::   dtevp              ! time step for subcycling
-      REAL(wp) ::   dtotel, ecc2, ecci ! square of yield ellipse eccenticity
-      REAL(wp) ::   z0, zr, zcca, zccb ! temporary scalars
-      REAL(wp) ::   zu_ice2, zv_ice1   !
-      REAL(wp) ::   zddc, zdtc         ! delta on corners and on centre
-      REAL(wp) ::   zdst               ! shear at the center of the grid point
-      REAL(wp) ::   zdsshx, zdsshy     ! term for the gradient of ocean surface
-      REAL(wp) ::   sigma1, sigma2     ! internal ice stress
+      REAL(wp) ::   za, zstms          ! local scalars
+      REAL(wp) ::   zc1, zc2, zc3      ! ice mass
+
+      REAL(wp) ::   dtevp , z1_dtevp              ! time step for subcycling
+      REAL(wp) ::   dtotel, z1_dtotel, ecc2, ecci ! square of yield ellipse eccenticity
+      REAL(wp) ::   z0, zr, zcca, zccb            ! temporary scalars
+      REAL(wp) ::   zu_ice2, zv_ice1              !
+      REAL(wp) ::   zddc, zdtc                    ! delta on corners and on centre
+      REAL(wp) ::   zdst                          ! shear at the center of the grid point
+      REAL(wp) ::   zdsshx, zdsshy                ! term for the gradient of ocean surface
+      REAL(wp) ::   sigma1, sigma2                ! internal ice stress
 
       REAL(wp) ::   zresm         ! Maximal error on ice velocity
-      REAL(wp) ::   zdummy        ! dummy argument
       REAL(wp) ::   zintb, zintn  ! dummy argument
 
@@ -139,8 +137,9 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   zcorl1, zcorl2   ! coriolis parameter on U/V points
       REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct , za2ct    ! temporary arrays
-      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce1, v_oce1   ! ocean u/v component on U points                           
-      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce2, v_oce2   ! ocean u/v component on V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   v_oce1           ! ocean u/v component on U points                           
+      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce2           ! ocean u/v component on V points
       REAL(wp), POINTER, DIMENSION(:,:) ::   u_ice2, v_ice1   ! ice u/v component on V/U point
       REAL(wp), POINTER, DIMENSION(:,:) ::   zf1   , zf2      ! arrays for internal stresses
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask            ! mask ocean grid points
       
       REAL(wp), POINTER, DIMENSION(:,:) ::   zdt              ! tension at centre of grid cells
@@ -152,8 +151,11 @@
                                                               !   ocean surface (ssh_m) if ice is not embedded
                                                               !   ice top surface if ice is embedded   
+
+      REAL(wp), PARAMETER               ::   zepsi = 1.0e-20_wp ! tolerance parameter
+      REAL(wp), PARAMETER               ::   zvmin = 1.0e-03_wp ! ice volume below which ice velocity equals ocean velocity
       !!-------------------------------------------------------------------
 
       CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )
-      CALL wrk_alloc( jpi,jpj, u_oce1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1                )
+      CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               )
       CALL wrk_alloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  )
       CALL wrk_alloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
@@ -161,14 +163,14 @@
 #if  defined key_lim2 && ! defined key_lim2_vp
 # if defined key_agrif
-     USE ice_2, vt_s => hsnm
-     USE ice_2, vt_i => hicm
+      USE ice_2, vt_s => hsnm
+      USE ice_2, vt_i => hicm
 # else
-     vt_s => hsnm
-     vt_i => hicm
+      vt_s => hsnm
+      vt_i => hicm
 # endif
-     at_i(:,:) = 1. - frld(:,:)
+      at_i(:,:) = 1. - frld(:,:)
 #endif
 #if defined key_agrif && defined key_lim2 
-    CALL agrif_rhg_lim2_load      ! First interpolation of coarse values
+      CALL agrif_rhg_lim2_load      ! First interpolation of coarse values
 #endif
       !
@@ -186,19 +188,17 @@
 
 #if defined key_lim3
-      CALL lim_itd_me_icestrength( ridge_scheme_swi )      ! LIM-3: Ice strength on T-points
-#endif
-
-!CDIR NOVERRCHK
+      CALL lim_itd_me_icestrength( nn_icestr )      ! LIM-3: Ice strength on T-points
+#endif
+
       DO jj = k_j1 , k_jpj       ! Ice mass and temp variables
-!CDIR NOVERRCHK
          DO ji = 1 , jpi
 #if defined key_lim3
-            zpresh(ji,jj) = tms(ji,jj) *  strength(ji,jj)
+            zpresh(ji,jj) = tmask(ji,jj,1) *  strength(ji,jj)
 #endif
 #if defined key_lim2
-            zpresh(ji,jj) = tms(ji,jj) *  pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) )
-#endif
-            ! tmi = 1 where there is ice or on land
-            tmi(ji,jj)    = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - epsd ) ) ) * tms(ji,jj)
+            zpresh(ji,jj) = tmask(ji,jj,1) *  pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) )
+#endif
+            ! zmask = 1 where there is ice or on land
+            zmask(ji,jj)    = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - zepsi ) ) ) * tmask(ji,jj,1)
          END DO
       END DO
@@ -206,20 +206,13 @@
       ! Ice strength on grid cell corners (zpreshc)
       ! needed for calculation of shear stress 
-!CDIR NOVERRCHK
       DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
          DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1)
-            zstms          =  tms(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + &
-               &              tms(ji,jj+1)   * wght(ji+1,jj+1,1,2) + &
-               &              tms(ji+1,jj)   * wght(ji+1,jj+1,2,1) + &
-               &              tms(ji,jj)     * wght(ji+1,jj+1,1,1)
-            zpreshc(ji,jj) = (  zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + &
-               &                zpresh(ji,jj+1)   * wght(ji+1,jj+1,1,2) + &
-               &                zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + & 
-               &                zpresh(ji,jj)     * wght(ji+1,jj+1,1,1)   &
-               &             ) / MAX( zstms, epsd )
+            zstms          =  tmask(ji+1,jj+1,1) * wght(ji+1,jj+1,2,2) + tmask(ji,jj+1,1) * wght(ji+1,jj+1,1,2) +   &
+               &              tmask(ji+1,jj,1)   * wght(ji+1,jj+1,2,1) + tmask(ji,jj,1)   * wght(ji+1,jj+1,1,1)
+            zpreshc(ji,jj) = ( zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + zpresh(ji,jj+1) * wght(ji+1,jj+1,1,2) +   &
+               &               zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + zpresh(ji,jj)   * wght(ji+1,jj+1,1,1)     &
+               &             ) / MAX( zstms, zepsi )
          END DO
       END DO
-
       CALL lbc_lnk( zpreshc(:,:), 'F', 1. )
       !
@@ -236,21 +229,19 @@
       !  zcorl2: Coriolis parameter on V-points                            
       !  (ztagnx,ztagny): wind stress on U/V points                       
-      !  u_oce1: ocean u component on u points                           
       !  v_oce1: ocean v component on u points                          
       !  u_oce2: ocean u component on v points                         
-      !  v_oce2: ocean v component on v points                        
 
       IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
-          !                                            
-          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
-          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
+         !                                            
+         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
+         !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
          zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp     
-          !
-          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
-          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
+         !
+         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
+         !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
          zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
-          !
+         !
          zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0
-          !
+         !
       ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
          zpice(:,:) = ssh_m(:,:)
@@ -260,36 +251,33 @@
          DO ji = fs_2, fs_jpim1
 
-            zc1 = tms(ji  ,jj  ) * ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) )
-            zc2 = tms(ji+1,jj  ) * ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) )
-            zc3 = tms(ji  ,jj+1) * ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) )
-
-            zt11 = tms(ji  ,jj) * e1t(ji  ,jj)
-            zt12 = tms(ji+1,jj) * e1t(ji+1,jj)
-            zt21 = tms(ji,jj  ) * e2t(ji,jj  )
-            zt22 = tms(ji,jj+1) * e2t(ji,jj+1)
+            zc1 = tmask(ji  ,jj  ,1) * ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) )
+            zc2 = tmask(ji+1,jj  ,1) * ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) )
+            zc3 = tmask(ji  ,jj+1,1) * ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) )
+
+            zt11 = tmask(ji  ,jj,1) * e1t(ji  ,jj)
+            zt12 = tmask(ji+1,jj,1) * e1t(ji+1,jj)
+            zt21 = tmask(ji,jj  ,1) * e2t(ji,jj  )
+            zt22 = tmask(ji,jj+1,1) * e2t(ji,jj+1)
 
             ! Leads area.
-            zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + epsd )
-            zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + epsd )
+            zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + zepsi )
+            zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + zepsi )
 
             ! Mass, coriolis coeff. and currents
-            zmass1(ji,jj) = ( zt12*zc1 + zt11*zc2 ) / (zt11+zt12+epsd)
-            zmass2(ji,jj) = ( zt22*zc1 + zt21*zc3 ) / (zt21+zt22+epsd)
-            zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj)*fcor(ji,jj) + e1t(ji,jj)*fcor(ji+1,jj) )   &
-               &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + epsd )
-            zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1)*fcor(ji,jj) + e2t(ji,jj)*fcor(ji,jj+1) )   &
-               &                          / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd )
+            zmass1(ji,jj) = ( zt12 * zc1 + zt11 * zc2 ) / ( zt11 + zt12 + zepsi )
+            zmass2(ji,jj) = ( zt22 * zc1 + zt21 * zc3 ) / ( zt21 + zt22 + zepsi )
+            zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj) * fcor(ji,jj) + e1t(ji,jj) * fcor(ji+1,jj) )   &
+               &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + zepsi )
+            zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) * fcor(ji,jj) + e2t(ji,jj) * fcor(ji,jj+1) )   &
+               &                          / ( e2t(ji,jj+1) + e2t(ji,jj) + zepsi )
             !
-            u_oce1(ji,jj)  = u_oce(ji,jj)
-            v_oce2(ji,jj)  = v_oce(ji,jj)
-
             ! Ocean has no slip boundary condition
-            v_oce1(ji,jj)  = 0.5*( (v_oce(ji,jj)+v_oce(ji,jj-1))*e1t(ji,jj)    &
-               &                 +(v_oce(ji+1,jj)+v_oce(ji+1,jj-1))*e1t(ji+1,jj)) &
-               &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)  
-
-            u_oce2(ji,jj)  = 0.5*((u_oce(ji,jj)+u_oce(ji-1,jj))*e2t(ji,jj)     &
-               &                 +(u_oce(ji,jj+1)+u_oce(ji-1,jj+1))*e2t(ji,jj+1)) &
-               &                / (e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
+            v_oce1(ji,jj)  = 0.5 * ( ( v_oce(ji  ,jj) + v_oce(ji  ,jj-1) ) * e1t(ji,jj)      &
+               &                   + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji+1,jj) )  &
+               &                   / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)  
+
+            u_oce2(ji,jj)  = 0.5 * ( ( u_oce(ji,jj  ) + u_oce(ji-1,jj  ) ) * e2t(ji,jj)      &
+               &                   + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj+1) )  &
+               &                   / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
 
             ! Wind stress at U,V-point
@@ -303,6 +291,6 @@
             ! include it later
 
-            zdsshx =  ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj)
-            zdsshy =  ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj)
+            zdsshx =  ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
+            zdsshy =  ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
 
             za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx
@@ -318,9 +306,14 @@
       !
       ! Time step for subcycling
-      dtevp  = rdt_ice / nevp
+      dtevp  = rdt_ice / nn_nevp
+#if defined key_lim3
+      dtotel = dtevp / ( 2._wp * rn_relast * rdt_ice )
+#else
       dtotel = dtevp / ( 2._wp * telast )
-
+#endif
+      z1_dtotel = 1._wp / ( 1._wp + dtotel )
+      z1_dtevp  = 1._wp / dtevp
       !-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter)
-      ecc2 = ecc * ecc
+      ecc2 = rn_ecc * rn_ecc
       ecci = 1. / ecc2
 
@@ -331,5 +324,5 @@
 
       !                                               !----------------------!
-      DO jter = 1 , nevp                              !    loop over jter    !
+      DO jter = 1 , nn_nevp                           !    loop over jter    !
          !                                            !----------------------!        
          DO jj = k_j1, k_jpj-1
@@ -339,5 +332,5 @@
 
          DO jj = k_j1+1, k_jpj-1
-            DO ji = fs_2, jpim1   !RB bug no vect opt due to tmi
+            DO ji = fs_2, fs_jpim1   !RB bug no vect opt due to zmask
 
                !  
@@ -360,122 +353,80 @@
                !
                !
-               divu_i(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      &
-                  &             -e2u(ji-1,jj)*u_ice(ji-1,jj)                  &
-                  &             +e1v(ji,jj)*v_ice(ji,jj)                      &
-                  &             -e1v(ji,jj-1)*v_ice(ji,jj-1)                  &
-                  &             )                                             &
-                  &            / area(ji,jj)
-
-               zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    &
-                  &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                &
-                  &           )*e2t(ji,jj)*e2t(ji,jj)                      &
-                  &          -( v_ice(ji,jj)/e1v(ji,jj)                    &
-                  &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                &
-                  &           )*e1t(ji,jj)*e1t(ji,jj)                      &
-                  &         )                                              &
-                  &        / area(ji,jj)
+               divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
+                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
+                  &            ) * r1_e12t(ji,jj)
+
+               zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
+                  &         - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
+                  &         ) * r1_e12t(ji,jj)
 
                !
-               zds(ji,jj) = ( ( u_ice(ji,jj+1)/e1u(ji,jj+1)                &
-                  &            -u_ice(ji,jj)/e1u(ji,jj)                    &
-                  &           )*e1f(ji,jj)*e1f(ji,jj)                      &
-                  &          +( v_ice(ji+1,jj)/e2v(ji+1,jj)                &
-                  &            -v_ice(ji,jj)/e2v(ji,jj)                    &
-                  &           )*e2f(ji,jj)*e2f(ji,jj)                      &
-                  &         )                                              &
-                  &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) &
-                  &        * tmi(ji,jj) * tmi(ji,jj+1)                     &
-                  &        * tmi(ji+1,jj) * tmi(ji+1,jj+1)
-
-
-               v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   &
-                  &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) &
-                  &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
-
-               u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   &
-                  &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) &
-                  &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
-
-            END DO
-         END DO
-         CALL lbc_lnk( v_ice1, 'U', -1. )   ;   CALL lbc_lnk( u_ice2, 'V', -1. )      ! lateral boundary cond.
-
-!CDIR NOVERRCHK
+               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
+                  &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
+                  &         ) * r1_e12f(ji,jj) * ( 2._wp - fmask(ji,jj,1) )   &
+                  &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1)
+
+
+               v_ice1(ji,jj)  = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji+1,jj)     &
+                  &                      + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) )   &
+                  &                      / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
+
+               u_ice2(ji,jj)  = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     &
+                  &                      + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) )   &
+                  &                      / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+            END DO
+         END DO
+
+         CALL lbc_lnk_multi( v_ice1, 'U', -1., u_ice2, 'V', -1. )      ! lateral boundary cond.
+         
          DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
             DO ji = fs_2, fs_jpim1
 
                !- Calculate Delta at centre of grid cells
-               zdst      = (  e2u(ji  , jj) * v_ice1(ji  ,jj)          &
-                  &          - e2u(ji-1, jj) * v_ice1(ji-1,jj)          &
-                  &          + e1v(ji, jj  ) * u_ice2(ji,jj  )          &
-                  &          - e1v(ji, jj-1) * u_ice2(ji,jj-1)          &
-                  &          )                                          &
-                  &         / area(ji,jj)
-
-               delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )  
-               delta_i(ji,jj) = delta + creepl
-               !-Calculate stress tensor components zs1 and zs2 
-               !-at centre of grid cells (see section 3.5 of CICE user's guide).
-               zs1(ji,jj) = ( zs1(ji,jj) + dtotel * ( ( divu_i(ji,jj) / delta_i(ji,jj) - delta / delta_i(ji,jj) )  &
-                  &         * zpresh(ji,jj) ) ) / ( 1._wp + dtotel )
-               zs2(ji,jj) = ( zs2(ji,jj) + dtotel * ( ecci * zdt(ji,jj) / delta_i(ji,jj) * zpresh(ji,jj) ) )  &
-                  &         / ( 1._wp + dtotel )
-
-            END DO
-         END DO
-
-         CALL lbc_lnk( zs1(:,:), 'T', 1. )
-         CALL lbc_lnk( zs2(:,:), 'T', 1. )
-
-!CDIR NOVERRCHK
-         DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
-            DO ji = fs_2, fs_jpim1
+               zdst          = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )   &
+                  &            + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1)   &
+                  &            ) * r1_e12t(ji,jj)
+
+               delta          = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )  
+               delta_i(ji,jj) = delta + rn_creepl
+
                !- Calculate Delta on corners
-               zddc  =      ( ( v_ice1(ji,jj+1)/e1u(ji,jj+1)                &
-                  &            -v_ice1(ji,jj)/e1u(ji,jj)                    &
-                  &           )*e1f(ji,jj)*e1f(ji,jj)                       &
-                  &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                &
-                  &            -u_ice2(ji,jj)/e2v(ji,jj)                    &
-                  &           )*e2f(ji,jj)*e2f(ji,jj)                       &
-                  &         )                                               &
-                  &        / ( e1f(ji,jj) * e2f(ji,jj) )
-
-               zdtc  =      (-( v_ice1(ji,jj+1)/e1u(ji,jj+1)                &
-                  &            -v_ice1(ji,jj)/e1u(ji,jj)                    &
-                  &           )*e1f(ji,jj)*e1f(ji,jj)                       &
-                  &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                &
-                  &            -u_ice2(ji,jj)/e2v(ji,jj)                    &
-                  &           )*e2f(ji,jj)*e2f(ji,jj)                       &
-                  &         )                                               &
-                  &        / ( e1f(ji,jj) * e2f(ji,jj) )
-
-               zddc = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl
-
-               !-Calculate stress tensor component zs12 at corners (see section 3.5 of CICE user's guide).
-               zs12(ji,jj) = ( zs12(ji,jj) + dtotel *  &
-                  &          ( ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj) ) )  &
-                  &          / ( 1.0 + dtotel ) 
-
-            END DO ! ji
-         END DO ! jj
-
-         CALL lbc_lnk( zs12(:,:), 'F', 1. )
-
+               zddc  = (  ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  &
+                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  &
+                  &    ) * r1_e12f(ji,jj)
+
+               zdtc  = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  &
+                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  &
+                  &    ) * r1_e12f(ji,jj)
+
+               zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl
+
+               !-Calculate stress tensor components zs1 and zs2 at centre of grid cells (see section 3.5 of CICE user's guide).
+               zs1(ji,jj)  = ( zs1 (ji,jj) + dtotel * ( divu_i(ji,jj) - delta ) / delta_i(ji,jj)   * zpresh(ji,jj)   &
+                  &          ) * z1_dtotel
+               zs2(ji,jj)  = ( zs2 (ji,jj) + dtotel *         ecci * zdt(ji,jj) / delta_i(ji,jj)   * zpresh(ji,jj)   &
+                  &          ) * z1_dtotel
+               !-Calculate stress tensor component zs12 at corners
+               zs12(ji,jj) = ( zs12(ji,jj) + dtotel *         ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj)  &
+                  &          ) * z1_dtotel 
+
+            END DO
+         END DO
+
+         CALL lbc_lnk_multi( zs1 , 'T', 1., zs2, 'T', 1., zs12, 'F', 1. )
+ 
          ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002)
          DO jj = k_j1+1, k_jpj-1
             DO ji = fs_2, fs_jpim1
                !- contribution of zs1, zs2 and zs12 to zf1
-               zf1(ji,jj) = 0.5*( (zs1(ji+1,jj)-zs1(ji,jj))*e2u(ji,jj) &
-                  &              +(zs2(ji+1,jj)*e2t(ji+1,jj)**2-zs2(ji,jj)*e2t(ji,jj)**2)/e2u(ji,jj) &
-                  &              +2.0*(zs12(ji,jj)*e1f(ji,jj)**2-zs12(ji,jj-1)*e1f(ji,jj-1)**2)/e1u(ji,jj) &
-                  &             ) / ( e1u(ji,jj)*e2u(ji,jj) )
+               zf1(ji,jj) = 0.5 * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)  &
+                  &             + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj)          &
+                  &             + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj)  &
+                  &                ) * r1_e12u(ji,jj)
                ! contribution of zs1, zs2 and zs12 to zf2
-               zf2(ji,jj) = 0.5*( (zs1(ji,jj+1)-zs1(ji,jj))*e1v(ji,jj) &
-                  &              -(zs2(ji,jj+1)*e1t(ji,jj+1)**2 - zs2(ji,jj)*e1t(ji,jj)**2)/e1v(ji,jj) &
-                  &              + 2.0*(zs12(ji,jj)*e2f(ji,jj)**2 -    &
-                  zs12(ji-1,jj)*e2f(ji-1,jj)**2)/e2v(ji,jj) &
-                  &             ) / ( e1v(ji,jj)*e2v(ji,jj) )
+               zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)  &
+                  &             - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj)          &
+                  &             + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj)  &
+                  &               )  * r1_e12v(ji,jj)
             END DO
          END DO
@@ -487,23 +438,19 @@
          IF (MOD(jter,2).eq.0) THEN 
 
-!CDIR NOVERRCHK
             DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
                DO ji = fs_2, fs_jpim1
-                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj)
-                  z0           = zmass1(ji,jj)/dtevp
+                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1)
+                  z0           = zmass1(ji,jj) * z1_dtevp
 
                   ! SB modif because ocean has no slip boundary condition
-                  zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)         &
-                     &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   &
-                     &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
-                  za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + &
-                     (zv_ice1-v_oce1(ji,jj))**2) * (1.0-zfrld1(ji,jj))
-                  zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + &
-                     za*(u_oce1(ji,jj))
-                  zcca         = z0+za
+                  zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji  ,jj)     &
+                     &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   &
+                     &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+                  za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  &
+                     &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) )
+                  zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj)
+                  zcca         = z0 + za
                   zccb         = zcorl1(ji,jj)
-                  u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask 
-
+                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch 
                END DO
             END DO
@@ -511,5 +458,5 @@
             CALL lbc_lnk( u_ice(:,:), 'U', -1. )
 #if defined key_agrif && defined key_lim2
-            CALL agrif_rhg_lim2( jter, nevp, 'U' )
+            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' )
 #endif
 #if defined key_bdy
@@ -517,23 +464,19 @@
 #endif         
 
-!CDIR NOVERRCHK
             DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
                DO ji = fs_2, fs_jpim1
 
-                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj)
-                  z0           = zmass2(ji,jj)/dtevp
+                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1)
+                  z0           = zmass2(ji,jj) * z1_dtevp
                   ! SB modif because ocean has no slip boundary condition
-                  zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)     &
-                     &                 + (u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   &
-                     &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
-                  za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + & 
-                     (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj))
-                  zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + &
-                     za2ct(ji,jj) + za*(v_oce2(ji,jj))
-                  zcca         = z0+za
+                  zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       &
+                     &                 + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   &
+                     &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+                  za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  & 
+                     &                         ( v_ice(ji,jj) - v_oce(ji,jj))**2 ) * ( 1.0 - zfrld2(ji,jj) )
+                  zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj)
+                  zcca         = z0 + za
                   zccb         = zcorl2(ji,jj)
-                  v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask
-
+                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch
                END DO
             END DO
@@ -541,5 +484,5 @@
             CALL lbc_lnk( v_ice(:,:), 'V', -1. )
 #if defined key_agrif && defined key_lim2
-            CALL agrif_rhg_lim2( jter, nevp, 'V' )
+            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' )
 #endif
 #if defined key_bdy
@@ -548,23 +491,19 @@
 
          ELSE 
-!CDIR NOVERRCHK
             DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
                DO ji = fs_2, fs_jpim1
-                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj)
-                  z0           = zmass2(ji,jj)/dtevp
+                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1)
+                  z0           = zmass2(ji,jj) * z1_dtevp
                   ! SB modif because ocean has no slip boundary condition
-                  zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)      &
-                     &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   &
-                     &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)   
-
-                  za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + &
-                     (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj))
-                  zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + &
-                     za2ct(ji,jj) + za*(v_oce2(ji,jj))
-                  zcca         = z0+za
+                  zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       &
+                     &                  +( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   &
+                     &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)   
+
+                  za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  &
+                     &                         ( v_ice(ji,jj) - v_oce(ji,jj) )**2 ) * ( 1.0 - zfrld2(ji,jj) )
+                  zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj)
+                  zcca         = z0 + za
                   zccb         = zcorl2(ji,jj)
-                  v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask
-
+                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch
                END DO
             END DO
@@ -572,5 +511,5 @@
             CALL lbc_lnk( v_ice(:,:), 'V', -1. )
 #if defined key_agrif && defined key_lim2
-            CALL agrif_rhg_lim2( jter, nevp, 'V' )
+            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' )
 #endif
 #if defined key_bdy
@@ -578,27 +517,24 @@
 #endif         
 
-!CDIR NOVERRCHK
             DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
                DO ji = fs_2, fs_jpim1
-                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj)
-                  z0           = zmass1(ji,jj)/dtevp
-                  zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)      &
-                     &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   &
-                     &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
-
-                  za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + &
-                     (zv_ice1-v_oce1(ji,jj))**2)*(1.0-zfrld1(ji,jj))
-                  zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + &
-                     za*(u_oce1(ji,jj))
-                  zcca         = z0+za
+                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1)
+                  z0           = zmass1(ji,jj) * z1_dtevp
+                  zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji,jj)       &
+                     &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   &
+                     &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+
+                  za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  &
+                     &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) )
+                  zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj)
+                  zcca         = z0 + za
                   zccb         = zcorl1(ji,jj)
-                  u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask 
-               END DO ! ji
-            END DO ! jj
+                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch 
+               END DO
+            END DO
 
             CALL lbc_lnk( u_ice(:,:), 'U', -1. )
 #if defined key_agrif && defined key_lim2
-            CALL agrif_rhg_lim2( jter, nevp, 'U' )
+            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' )
 #endif
 #if defined key_bdy
@@ -611,8 +547,7 @@
             !---  Convergence test.
             DO jj = k_j1+1 , k_jpj-1
-               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ) ,           &
-                  ABS( v_ice(:,jj) - zv_ice(:,jj) ) )
-            END DO
-            zresm = MAXVAL( zresr( 1:jpi , k_j1+1:k_jpj-1 ) )
+               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) )
+            END DO
+            zresm = MAXVAL( zresr( 1:jpi, k_j1+1:k_jpj-1 ) )
             IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain
          ENDIF
@@ -625,24 +560,20 @@
       ! 4) Prevent ice velocities when the ice is thin
       !------------------------------------------------------------------------------!
-      ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the
-      ! ocean velocity, 
-      ! This prevents high velocity when ice is thin
-!CDIR NOVERRCHK
+      ! If the ice volume is below zvmin then ice velocity should equal the
+      ! ocean velocity. This prevents high velocity when ice is thin
       DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
          DO ji = fs_2, fs_jpim1
-            zdummy = vt_i(ji,jj)
-            IF ( zdummy .LE. hminrhg ) THEN
+            IF ( vt_i(ji,jj) <= zvmin ) THEN
                u_ice(ji,jj) = u_oce(ji,jj)
                v_ice(ji,jj) = v_oce(ji,jj)
-            ENDIF ! zdummy
+            ENDIF
          END DO
       END DO
 
-      CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
-      CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
+      CALL lbc_lnk_multi( u_ice(:,:), 'U', -1., v_ice(:,:), 'V', -1. )
+
 #if defined key_agrif && defined key_lim2
-      CALL agrif_rhg_lim2( nevp , nevp, 'U' )
-      CALL agrif_rhg_lim2( nevp , nevp, 'V' )
+      CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'U' )
+      CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'V' )
 #endif
 #if defined key_bdy
@@ -653,93 +584,64 @@
       DO jj = k_j1+1, k_jpj-1 
          DO ji = fs_2, fs_jpim1
-            zdummy = vt_i(ji,jj)
-            IF ( zdummy .LE. hminrhg ) THEN
-               v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   &
-                  &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) &
-                  &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
-
-               u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   &
-                  &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) &
-                  &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
-            ENDIF ! zdummy
+            IF ( vt_i(ji,jj) <= zvmin ) THEN
+               v_ice1(ji,jj)  = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji,  jj-1) ) * e1t(ji+1,jj)     &
+                  &                      + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) )   &
+                  &                      / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+
+               u_ice2(ji,jj)  = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     &
+                  &                      + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) )   &
+                  &                      / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+            ENDIF 
          END DO
       END DO
 
-      CALL lbc_lnk( u_ice2(:,:), 'V', -1. ) 
-      CALL lbc_lnk( v_ice1(:,:), 'U', -1. )
+      CALL lbc_lnk_multi( u_ice2(:,:), 'V', -1., v_ice1(:,:), 'U', -1. )
 
       ! Recompute delta, shear and div, inputs for mechanical redistribution 
-!CDIR NOVERRCHK
       DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
-         DO ji = fs_2, jpim1   !RB bug no vect opt due to tmi
+         DO ji = fs_2, jpim1   !RB bug no vect opt due to zmask
             !- divu_i(:,:), zdt(:,:): divergence and tension at centre 
             !- zds(:,:): shear on northeast corner of grid cells
-            zdummy = vt_i(ji,jj)
-            IF ( zdummy .LE. hminrhg ) THEN
-
-               divu_i(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      &
-                  &             -e2u(ji-1,jj)*u_ice(ji-1,jj)                  &
-                  &             +e1v(ji,jj)*v_ice(ji,jj)                      &
-                  &             -e1v(ji,jj-1)*v_ice(ji,jj-1)                  &
-                  &            )                                              &
-                  &            / area(ji,jj)
-
-               zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    &
-                  &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                &
-                  &           )*e2t(ji,jj)*e2t(ji,jj)                      &
-                  &          -( v_ice(ji,jj)/e1v(ji,jj)                    &
-                  &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                &
-                  &           )*e1t(ji,jj)*e1t(ji,jj)                      &
-                  &         )                                              &
-                  &        / area(ji,jj)
+            IF ( vt_i(ji,jj) <= zvmin ) THEN
+
+               divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj  ) * u_ice(ji-1,jj  )   &
+                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji  ,jj-1) * v_ice(ji  ,jj-1)   &
+                  &            ) * r1_e12t(ji,jj)
+
+               zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)  &
+                  &          -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)  &
+                  &         ) * r1_e12t(ji,jj)
                !
                ! SB modif because ocean has no slip boundary condition 
-               zds(ji,jj) = ( ( u_ice(ji,jj+1) / e1u(ji,jj+1)              &
-                  &           - u_ice(ji,jj)   / e1u(ji,jj) )              &
-                  &           * e1f(ji,jj) * e1f(ji,jj)                    &
-                  &          + ( v_ice(ji+1,jj) / e2v(ji+1,jj)             &
-                  &            - v_ice(ji,jj)  / e2v(ji,jj) )              &
-                  &           * e2f(ji,jj) * e2f(ji,jj) )                  &
-                  &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) &
-                  &        * tmi(ji,jj) * tmi(ji,jj+1)                     &
-                  &        * tmi(ji+1,jj) * tmi(ji+1,jj+1)
-
-               zdst = (  e2u( ji  , jj   ) * v_ice1(ji  ,jj  )    &
-                  &           - e2u( ji-1, jj   ) * v_ice1(ji-1,jj  )    &
-                  &           + e1v( ji  , jj   ) * u_ice2(ji  ,jj  )    &
-                  &           - e1v( ji  , jj-1 ) * u_ice2(ji  ,jj-1)  ) / area(ji,jj)
-
-               delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )  
-               delta_i(ji,jj) = delta + creepl
+               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  &
+                  &          +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  &
+                  &         ) * r1_e12f(ji,jj) * ( 2.0 - fmask(ji,jj,1) )                                     &
+                  &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1)
+
+               zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )    &
+                  &   + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1) ) * r1_e12t(ji,jj)
+
+               delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )  
+               delta_i(ji,jj) = delta + rn_creepl
             
-            ENDIF ! zdummy
-
-         END DO !jj
-      END DO !ji
+            ENDIF
+         END DO
+      END DO
       !
       !------------------------------------------------------------------------------!
       ! 5) Store stress tensor and its invariants
       !------------------------------------------------------------------------------!
-      !
       ! * Invariants of the stress tensor are required for limitd_me
       !   (accelerates convergence and improves stability)
       DO jj = k_j1+1, k_jpj-1
          DO ji = fs_2, fs_jpim1
-            ! begin TECLIM change 
-            zdst= (  e2u( ji  , jj   ) * v_ice1(ji,jj)           &   
-               &          - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)         &   
-               &          + e1v( ji  , jj   ) * u_ice2(ji,jj)           &   
-               &          - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) / area(ji,jj) 
+            zdst           = (  e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)  &   
+               &              + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e12t(ji,jj) 
             shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst )
-            ! end TECLIM change
          END DO
       END DO
 
       ! Lateral boundary condition
-      CALL lbc_lnk( divu_i (:,:), 'T', 1. )
-      CALL lbc_lnk( delta_i(:,:), 'T', 1. )
-      ! CALL lbc_lnk( shear_i(:,:), 'F', 1. )
-      CALL lbc_lnk( shear_i(:,:), 'T', 1. )
+      CALL lbc_lnk_multi( divu_i (:,:), 'T', 1., delta_i(:,:), 'T', 1.,  shear_i(:,:), 'T', 1. )
 
       ! * Store the stress tensor for the next time step
@@ -772,5 +674,5 @@
             DO jj = k_j1+1, k_jpj-1
                DO ji = 2, jpim1
-                  IF (zpresh(ji,jj) .GT. 1.0) THEN
+                  IF (zpresh(ji,jj) > 1.0) THEN
                      sigma1 = ( zs1(ji,jj) + (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) ) 
                      sigma2 = ( zs1(ji,jj) - (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )
@@ -786,5 +688,5 @@
       !
       CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )
-      CALL wrk_dealloc( jpi,jpj, u_oce1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1                )
+      CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               )
       CALL wrk_dealloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  )
       CALL wrk_dealloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 5682)
@@ -18,5 +18,4 @@
    USE ice            ! sea-ice variables
    USE oce     , ONLY :  snwice_mass, snwice_mass_b
-   USE par_ice        ! sea-ice parameters
    USE dom_oce        ! ocean domain
    USE sbc_oce        ! Surface boundary condition: ocean fields
@@ -27,4 +26,5 @@
    USE wrk_nemo       ! work arrays
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE limctl
 
    IMPLICIT NONE
@@ -33,5 +33,5 @@
    PUBLIC   lim_rst_opn    ! routine called by icestep.F90
    PUBLIC   lim_rst_write  ! routine called by icestep.F90
-   PUBLIC   lim_rst_read   ! routine called by iceini.F90
+   PUBLIC   lim_rst_read   ! routine called by sbc_lim_init
 
    LOGICAL, PUBLIC ::   lrst_ice         !: logical to control the ice restart write 
@@ -55,4 +55,5 @@
       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
       CHARACTER(LEN=50)   ::   clname   ! ice output restart file name
+      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file 
       !!----------------------------------------------------------------------
       !
@@ -64,26 +65,33 @@
       IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc    &
          &                             .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN
-         ! beware of the format used to write kt (default is i8.8, that should be large enough...)
-         IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
-         ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
+         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
+            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
+            ENDIF
+            ! create the file
+            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
+            clpath = TRIM(cn_icerst_outdir) 
+            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'
+            IF(lwp) THEN
+               WRITE(numout,*)
+               SELECT CASE ( jprstlib )
+               CASE ( jprstdimg )
+                  WRITE(numout,*) '             open ice restart binary file: ',TRIM(clpath)//clname
+               CASE DEFAULT
+                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname
+               END SELECT
+               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
+                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
+               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
+               ENDIF
+            ENDIF
+            !
+            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib )
+            lrst_ice = .TRUE.
          ENDIF
-         ! create the file
-         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
-         IF(lwp) THEN
-            WRITE(numout,*)
-            SELECT CASE ( jprstlib )
-            CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ice restart binary file: '//clname
-            CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname
-            END SELECT
-            IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
-               WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
-            ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
-            ENDIF
-         ENDIF
-         !
-         CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib )
-         lrst_ice = .TRUE.
       ENDIF
       !
+      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print
    END SUBROUTINE lim_rst_opn
 
@@ -142,5 +150,5 @@
          CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
       END DO
-      
+
       DO jl = 1, jpl 
          WRITE(zchar,'(I1)') jl
@@ -165,6 +173,6 @@
       CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'    , stress2_i  )
       CALL iom_rstput( iter, nitrst, numriw, 'stress12_i'   , stress12_i )
-      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass )   !clem modif
-      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b ) !clem modif
+      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass )
+      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b )
 
       DO jl = 1, jpl 
@@ -306,8 +314,6 @@
       !! ** purpose  :   read of sea-ice variable restart in a netcdf file
       !!----------------------------------------------------------------------
-      INTEGER :: ji, jj, jk, jl, indx
+      INTEGER :: ji, jj, jk, jl
       REAL(wp) ::   zfice, ziter
-      REAL(wp) ::   zs_inf, z_slope_s, zsmax, zsmin, zalpha   ! local scalars used for the salinity profile
-      REAL(wp), POINTER, DIMENSION(:)   ::   zs_zero 
       REAL(wp), POINTER, DIMENSION(:,:) ::   z2d
       CHARACTER(len=15) ::   znam
@@ -317,5 +323,4 @@
       !!----------------------------------------------------------------------
 
-      CALL wrk_alloc( nlay_i, zs_zero )
       CALL wrk_alloc( jpi, jpj, z2d )
 
@@ -329,9 +334,9 @@
         ! eventually read netcdf file (monobloc)  for restarting on different number of processors
         ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90
-        INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok )
+        INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok )
         IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
       ENDIF
 
-      CALL iom_open ( cn_icerst_in, numrir, kiolib = jprstlib )
+      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib )
 
       CALL iom_get( numrir, 'nn_fsbc', zfice )
@@ -395,6 +400,6 @@
       CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  )
       CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i )
-      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass )   !clem modif
-      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) !clem modif
+      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass )
+      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b )
 
       DO jl = 1, jpl 
@@ -521,10 +526,10 @@
       !
       ! clem: I do not understand why the following IF is needed
-      !       I suspect something inconsistent in the main code with option num_sal=1
-      IF( num_sal == 1 ) THEN
+      !       I suspect something inconsistent in the main code with option nn_icesal=1
+      IF( nn_icesal == 1 ) THEN
          DO jl = 1, jpl 
-            sm_i(:,:,jl) = bulk_sal
+            sm_i(:,:,jl) = rn_icesal
             DO jk = 1, nlay_i 
-               s_i(:,:,jk,jl) = bulk_sal
+               s_i(:,:,jk,jl) = rn_icesal
             END DO
          END DO
@@ -533,5 +538,4 @@
       !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90
       !
-      CALL wrk_dealloc( nlay_i, zs_zero )
       CALL wrk_dealloc( jpi, jpj, z2d )
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 5682)
@@ -25,12 +25,10 @@
    USE par_oce          ! ocean parameters
    USE phycst           ! physical constants
-   USE par_ice          ! ice parameters
    USE dom_oce          ! ocean domain
-   USE dom_ice,    ONLY : tms, area
    USE ice              ! LIM sea-ice variables
    USE sbc_ice          ! Surface boundary condition: sea-ice fields
    USE sbc_oce          ! Surface boundary condition: ocean fields
    USE sbccpl
-   USE oce       , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
+   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
    USE albedo           ! albedo parameters
    USE lbclnk           ! ocean lateral boundary condition - MPP exchanges
@@ -40,12 +38,14 @@
    USE prtctl           ! Print control
    USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE traqsr           ! clem: add penetration of solar flux into the calculation of heat budget
+   USE traqsr           ! add penetration of solar flux in the calculation of heat budget
    USE iom
    USE domvvl           ! Variable volume
+   USE limctl
+   USE limcons
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_sbc_init   ! called by ice_init
+   PUBLIC   lim_sbc_init   ! called by sbc_lim_init
    PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim
    PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim
@@ -94,18 +94,15 @@
       !!              - fr_i    : ice fraction
       !!              - tn_ice  : sea-ice surface temperature
-      !!              - alb_ice : sea-ice albedo (lk_cpl=T)
+      !!              - alb_ice : sea-ice albedo (only useful in coupled mode)
       !!
       !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
       !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
       !!              These refs are now obsolete since everything has been revised
-      !!              The ref should be Rousset et al., 2015?
+      !!              The ref should be Rousset et al., 2015
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt                                   ! number of iteration
-      !
-      INTEGER  ::   ji, jj, jl, jk                                  ! dummy loop indices
-      !
-      REAL(wp) ::   zemp                                            !  local scalars
-      REAL(wp) ::   zf_mass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2)
-      REAL(wp) ::   zfcm1                                           ! New solar flux received by the ocean
+      INTEGER, INTENT(in) ::   kt                                  ! number of iteration
+      INTEGER  ::   ji, jj, jl, jk                                 ! dummy loop indices
+      REAL(wp) ::   zqmass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2)
+      REAL(wp) ::   zqsr                                           ! New solar flux received by the ocean
       !
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace
@@ -113,11 +110,14 @@
 
       ! make calls for heat fluxes before it is modified
-      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) )   !     solar flux at ocean surface
-      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) )   ! non-solar flux at ocean surface
-      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux at ice surface
-      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface
-      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux transmitted thru ice
-      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )  
-      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) )
+      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface
+      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface
+      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux at ice surface
+      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface
+      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux transmitted thru ice
+      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) )  
+      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   &
+         &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) )
+      IF( iom_use('qemp_oce' ) )   CALL iom_put( "qemp_oce"  , qemp_oce(:,:) )  
+      IF( iom_use('qemp_ice' ) )   CALL iom_put( "qemp_ice"  , qemp_ice(:,:) )  
 
       ! pfrld is the lead fraction at the previous time step (actually between TRP and THD)
@@ -128,29 +128,24 @@
             !      heat flux at the ocean surface      !
             !------------------------------------------!
-            ! Solar heat flux reaching the ocean = zfcm1 (W.m-2) 
+            ! Solar heat flux reaching the ocean = zqsr (W.m-2) 
             !---------------------------------------------------
-            IF( lk_cpl ) THEN 
-               !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) )
-               zfcm1 = qsr_tot(ji,jj)
-               DO jl = 1, jpl
-                  zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl)
-               END DO
-            ELSE
-               !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj)
-               zfcm1   = pfrld(ji,jj) * qsr(ji,jj)
-               DO jl = 1, jpl
-                  zfcm1   = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl)
-               END DO
-            ENDIF
+            zqsr = qsr_tot(ji,jj)
+            DO jl = 1, jpl
+               zqsr = zqsr - a_i_b(ji,jj,jl) * (  qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) 
+            END DO
 
             ! Total heat flux reaching the ocean = hfx_out (W.m-2) 
             !---------------------------------------------------
-            zf_mass        = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
-            hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1
+            zqmass         = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
+            hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr
+
+            ! Add the residual from heat diffusion equation (W.m-2)
+            !-------------------------------------------------------
+            hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj)
 
             ! New qsr and qns used to compute the oceanic heat flux at the next time step
             !---------------------------------------------------
-            qsr(ji,jj) = zfcm1                                      
-            qns(ji,jj) = hfx_out(ji,jj) - zfcm1              
+            qsr(ji,jj) = zqsr                                      
+            qns(ji,jj) = hfx_out(ji,jj) - zqsr              
 
             !------------------------------------------!
@@ -165,14 +160,4 @@
             !                     Even if i see Ice melting as a FW and SALT flux
             !        
-            !  computing freshwater exchanges at the ice/ocean interface
-            IF( lk_cpl ) THEN 
-               zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !
-                  &   + wfx_snw(ji,jj)
-            ELSE
-               zemp =   emp(ji,jj)     *           pfrld(ji,jj)            &   ! evaporation over oceanic fraction
-                  &   - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) )          &   ! all precipitation reach the ocean
-                  &   + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas )       ! except solid precip intercepted by sea-ice
-            ENDIF
-
             ! mass flux from ice/ocean
             wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   &
@@ -180,6 +165,6 @@
 
             ! mass flux at the ocean/ice interface
-            fmmflx(ji,jj) = - wfx_ice(ji,jj) * r1_rdtice                    ! F/M mass flux save at least for biogeochemical model
-            emp(ji,jj)    = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj)       ! mass flux + F/M mass flux (always ice/ocean mass exchange)
+            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice  ! F/M mass flux save at least for biogeochemical model
+            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)
             
          END DO
@@ -199,5 +184,5 @@
          snwice_mass_b(:,:) = snwice_mass(:,:)                  
          ! new mass per unit area
-         snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
+         snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
          ! time evolution of snow+ice mass
          snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice
@@ -210,19 +195,17 @@
       tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                      
 
-      !------------------------------------------------!
-      !    Snow/ice albedo (only if sent to coupler)   !
-      !------------------------------------------------!
-      IF( lk_cpl ) THEN          ! coupled case
-
-            CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os )
-
-            CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos
-
-            alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
-
-            CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os )
-
-      ENDIF
-
+      !------------------------------------------------------------------------!
+      !    Snow/ice albedo (only if sent to coupler, useless in forced mode)   !
+      !------------------------------------------------------------------------!
+      CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os )    
+      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos
+      alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+      CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os )
+
+      ! conservation test
+      IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' )
+
+      ! control prints
+      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' )
 
       IF(ln_ctl) THEN
@@ -270,7 +253,5 @@
       !
       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step)
-!CDIR NOVERRCHK
          DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
-!CDIR NOVERRCHK
             DO ji = fs_2, fs_jpim1
                !                                               ! 2*(U_ice-U_oce) at T-point
@@ -322,6 +303,4 @@
       !! ** input   : Namelist namicedia
       !!-------------------------------------------------------------------
-      REAL(wp) :: zsum, zarea
-      !
       INTEGER  ::   ji, jj, jk                       ! dummy loop indices
       REAL(wp) ::   zcoefu, zcoefv, zcoeff          ! local scalar
@@ -343,14 +322,9 @@
          END WHERE
       ENDIF
-      ! clem modif
-      IF( .NOT. ln_rstart ) THEN
-         fraqsr_1lev(:,:) = 1._wp
-      ENDIF
-      !
-      ! clem: snwice_mass in the restart file now
+      !
       IF( .NOT. ln_rstart ) THEN
          !                                      ! embedded sea ice
          IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
-            snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )
+            snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )
             snwice_mass_b(:,:) = snwice_mass(:,:)
          ELSE
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 5682)
@@ -22,16 +22,15 @@
    USE phycst         ! physical constants
    USE dom_oce        ! ocean space and time domain variables
-   USE oce     , ONLY : fraqsr_1lev 
    USE ice            ! LIM: sea-ice variables
-   USE par_ice        ! LIM: sea-ice parameters
    USE sbc_oce        ! Surface boundary condition: ocean fields
    USE sbc_ice        ! Surface boundary condition: ice fields
    USE thd_ice        ! LIM thermodynamic sea-ice variables
    USE dom_ice        ! LIM sea-ice domain
-   USE domvvl         ! domain: variable volume level
    USE limthd_dif     ! LIM: thermodynamics, vertical diffusion
    USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation
    USE limthd_sal     ! LIM: thermodynamics, ice salinity
    USE limthd_ent     ! LIM: thermodynamics, ice enthalpy redistribution
+   USE limthd_lac     ! LIM-3 lateral accretion
+   USE limitd_th      ! remapping thickness distribution
    USE limtab         ! LIM: 1D <==> 2D transformation
    USE limvar         ! LIM: sea-ice variables
@@ -44,10 +43,11 @@
    USE timing         ! Timing
    USE limcons        ! conservation tests
+   USE limctl
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_thd        ! called by limstp module
-   PUBLIC   lim_thd_init   ! called by iceini module
+   PUBLIC   lim_thd         ! called by limstp module
+   PUBLIC   lim_thd_init    ! called by sbc_lim_init
 
    !! * Substitutions
@@ -80,19 +80,15 @@
       !! ** References : 
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! number of iteration
+      INTEGER, INTENT(in) :: kt    ! number of iteration
       !!
       INTEGER  :: ji, jj, jk, jl   ! dummy loop indices
-      INTEGER  :: nbpb             ! nb of icy pts for thermo. cal.
+      INTEGER  :: nbpb             ! nb of icy pts for vertical thermo calculations
       INTEGER  :: ii, ij           ! temporary dummy loop index
-      REAL(wp) :: zfric_umin = 0._wp        ! lower bound for the friction velocity (cice value=5.e-04)
-      REAL(wp) :: zch        = 0.0057_wp    ! heat transfer coefficient
-      REAL(wp) :: zareamin 
       REAL(wp) :: zfric_u, zqld, zqfr
-      !
       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
-      !
-      REAL(wp), POINTER, DIMENSION(:,:) ::  zqsr, zqns
+      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04)
+      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient
+      !
       !!-------------------------------------------------------------------
-      CALL wrk_alloc( jpi, jpj, zqsr, zqns )
 
       IF( nn_timing == 1 )  CALL timing_start('limthd')
@@ -101,4 +97,5 @@
       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
+      CALL lim_var_glo2eqv
       !------------------------------------------------------------------------!
       ! 1) Initialization of some variables                                    !
@@ -106,9 +103,8 @@
       ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice
 
-
       !--------------------
       ! 1.2) Heat content    
       !--------------------
-      ! Change the units of heat content; from global units to J.m3
+      ! Change the units of heat content; from J/m2 to J/m3
       DO jl = 1, jpl
          DO jk = 1, nlay_i
@@ -116,9 +112,7 @@
                DO ji = 1, jpi
                   !0 if no ice and 1 if yes
-                  rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 )  )
+                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  )
                   !Energy of melting q(S,T) [J.m-3]
-                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i )
-                  !convert units ! very important that this line is here        
-                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 
+                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL( nlay_i )
                END DO
             END DO
@@ -128,9 +122,7 @@
                DO ji = 1, jpi
                   !0 if no ice and 1 if yes
-                  rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 )  )
+                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 )  )
                   !Energy of melting q(S,T) [J.m-3]
-                  e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s )
-                  !convert units ! very important that this line is here
-                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac 
+                  e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL( nlay_s )
                END DO
             END DO
@@ -140,30 +132,7 @@
       ! 2) Partial computation of forcing for the thermodynamic sea ice model.      !
       !-----------------------------------------------------------------------------!
-
-      !--- Ocean solar and non solar fluxes to be used in zqld
-      IF ( .NOT. lk_cpl ) THEN   ! --- forced case, fluxes to the lead are the same as over the ocean
-         !
-         zqsr(:,:) = qsr(:,:)      ; zqns(:,:) = qns(:,:)
-         !
-      ELSE                       ! --- coupled case, fluxes to the lead are total - intercepted
-         !
-         zqsr(:,:) = qsr_tot(:,:)  ; zqns(:,:) = qns_tot(:,:)
-         !
-         DO jl = 1, jpl
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * a_i_b(ji,jj,jl)
-                  zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * a_i_b(ji,jj,jl)
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF
-
-!CDIR NOVERRCHK
       DO jj = 1, jpj
-!CDIR NOVERRCHK
          DO ji = 1, jpi
-            rswitch          = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice
+            rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice
             !
             !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
@@ -173,31 +142,25 @@
             !           !  temperature and turbulent mixing (McPhee, 1992)
             !
-
             ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- !
-            ! REMARK valid at least in forced mode from clem
-            ! precip is included in qns but not in qns_ice
-            IF ( lk_cpl ) THEN
-               zqld =  tms(ji,jj) * rdt_ice *  &
-                  &    (   zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj)               &   ! pfrld already included in coupled mode
-                  &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *     &   ! heat content of precip
-                  &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )   &
-                  &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) )
-            ELSE
-               zqld =  tms(ji,jj) * rdt_ice *  &
-                  &      ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) )    &
-                  &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *             &  ! heat content of precip
-                  &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )           &
-                  &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) )
-            ENDIF
-
-            !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- !
-            zqfr = tms(ji,jj) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )
+            zqld =  tmask(ji,jj,1) * rdt_ice *  &
+               &    ( pfrld(ji,jj) * qsr_oce(ji,jj) * frq_m(ji,jj) + pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) )
+
+            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- !
+            zqfr = tmask(ji,jj,1) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )
+
+            ! --- Energy from the turbulent oceanic heat flux (W/m2) --- !
+            zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin ) 
+            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2
+            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
+            ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach 
+            !                        the freezing point, so that we do not have SST < T_freeze
+            !                        This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0
 
             !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice
-            qlead(ji,jj) = MIN( 0._wp , zqld - zqfr ) 
+            qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr )
 
             ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting 
-            IF( at_i(ji,jj) > epsi10 .AND. zqld > 0._wp ) THEN
-               fhld (ji,jj) = zqld * r1_rdtice / at_i(ji,jj) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90
+            IF( zqld > 0._wp ) THEN
+               fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90
                qlead(ji,jj) = 0._wp
             ELSE
@@ -205,44 +168,20 @@
             ENDIF
             !
-            !-- Energy from the turbulent oceanic heat flux --- !
-            !clem zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )
-            zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin ) 
-            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 
-            ! upper bound for fhtur: we do not want SST to drop below Tfreeze. 
-            ! So we say that the heat retrieved from the ocean (fhtur+fhld) must be < to the heat necessary to reach Tfreeze (zqfr)   
-            ! This is not a clean budget, so that should be corrected at some point
-            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
-
             ! -----------------------------------------
             ! Net heat flux on top of ice-ocean [W.m-2]
             ! -----------------------------------------
-            !     First  step here      : heat flux at the ocean surface + precip
-            !     Second step below     : heat flux at the ice   surface (after limthd_dif) 
-            hfx_in(ji,jj) = hfx_in(ji,jj)                                                                                         & 
-               ! heat flux above the ocean
-               &    +             pfrld(ji,jj)   * ( zqns(ji,jj) + zqsr(ji,jj) )                                                  &
-               ! latent heat of precip (note that precip is included in qns but not in qns_ice)
-               &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  &
-               &    +   ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )
+            hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 
 
             ! -----------------------------------------------------------------------------
-            ! Net heat flux that is retroceded to the ocean or taken from the ocean [W.m-2]
+            ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2]
             ! -----------------------------------------------------------------------------
             !     First  step here              :  non solar + precip - qlead - qturb
             !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema) 
             !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar
-            hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                       & 
-               ! Non solar heat flux received by the ocean
-               &    +        pfrld(ji,jj) * qns(ji,jj)                                                                            &
-               ! latent heat of precip (note that precip is included in qns but not in qns_ice)
-               &    +      ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)       &
-               &         * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  &
-               &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )       &
-               ! heat flux taken from the ocean where there is open water ice formation
-               &    -      qlead(ji,jj) * r1_rdtice                                                                               &
-               ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth)
-               &    -      at_i(ji,jj) * fhtur(ji,jj)                                                                             &
-               &    -      at_i(ji,jj) *  fhld(ji,jj)
-
+            hfx_out(ji,jj) =   pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj)  &  ! Non solar heat flux received by the ocean               
+               &             - qlead(ji,jj) * r1_rdtice                         &  ! heat flux taken from the ocean where there is open water ice formation
+               &             - at_i(ji,jj) * fhtur(ji,jj)                       &  ! heat flux taken by turbulence
+               &             - at_i(ji,jj) *  fhld(ji,jj)                          ! heat flux taken during bottom growth/melt 
+                                                                                   !    (fhld should be 0 while bott growth)
          END DO
       END DO
@@ -259,9 +198,8 @@
          ENDIF
 
-         zareamin = epsi10
          nbpb = 0
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF ( a_i(ji,jj,jl) .gt. zareamin ) THEN     
+               IF ( a_i(ji,jj,jl) > epsi10 ) THEN     
                   nbpb      = nbpb  + 1
                   npb(nbpb) = (jj - 1) * jpi + ji
@@ -272,7 +210,7 @@
          ! debug point to follow
          jiindex_1d = 0
-         IF( ln_nicep ) THEN
-            DO ji = mi0(jiindx), mi1(jiindx)
-               DO jj = mj0(jjindx), mj1(jjindx)
+         IF( ln_icectl ) THEN
+            DO ji = mi0(iiceprt), mi1(iiceprt)
+               DO jj = mj0(jiceprt), mj1(jiceprt)
                   jiindex_1d = (jj - 1) * jpi + ji
                   WRITE(numout,*) ' lim_thd : Category no : ', jl 
@@ -289,83 +227,16 @@
          IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing.
 
-            !-------------------------
-            ! 4.1 Move to 1D arrays
-            !-------------------------
-
-            CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-
-            CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
-            DO jk = 1, nlay_s
-               CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-               CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-            END DO
-            DO jk = 1, nlay_i
-               CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-               CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-               CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
-            END DO
-
-            CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:)   , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
-            IF( .NOT. lk_cpl ) THEN
-               CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
-               CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
-            ENDIF
-            CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) ) 
-            CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) )
-
-            CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) )
-
-            CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) )
-
-            CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) )
-
-            CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) )
-            CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) )
-
-            !--------------------------------
-            ! 4.3) Thermodynamic processes
-            !--------------------------------
+            !-------------------------!
+            ! --- Move to 1D arrays ---
+            !-------------------------!
+            CALL lim_thd_1d2d( nbpb, jl, 1 )
+
+            !--------------------------------------!
+            ! --- Ice/Snow Temperature profile --- !
+            !--------------------------------------!
+            CALL lim_thd_dif( 1, nbpb )
 
             !---------------------------------!
-            ! Ice/Snow Temperature profile    !
-            !---------------------------------!
-            CALL lim_thd_dif( 1, nbpb )
-
-            !---------------------------------!
-            ! Ice/Snow thicnkess              !
+            ! --- Ice/Snow thickness ---      !
             !---------------------------------!
             CALL lim_thd_dh( 1, nbpb )    
@@ -375,71 +246,30 @@
                                             
             !---------------------------------!
-            ! --- Ice salinity --- !
+            ! --- Ice salinity ---            !
             !---------------------------------!
             CALL lim_thd_sal( 1, nbpb )    
 
             !---------------------------------!
-            ! --- temperature update --- !
+            ! --- temperature update ---      !
             !---------------------------------!
             CALL lim_thd_temp( 1, nbpb )
 
-            !--------------------------------
-            ! 4.4) Move 1D to 2D vectors
-            !--------------------------------
-
-               CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_1d    (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_1d     (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_1d    (1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_1d    (1:nbpb)   , jpi, jpj )
-            DO jk = 1, nlay_s
-               CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d     (1:nbpb,jk), jpi, jpj)
-               CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d     (1:nbpb,jk), jpi, jpj)
-            END DO
-            DO jk = 1, nlay_i
-               CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d     (1:nbpb,jk), jpi, jpj)
-               CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d     (1:nbpb,jk), jpi, jpj)
-               CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d     (1:nbpb,jk), jpi, jpj)
-            END DO
-               CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj )
-
-               CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj )
-
-               CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj )
-
-               CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj )
-               CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj )
-
-              CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_sum       , npb, hfx_sum_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_bom       , npb, hfx_bom_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_bog       , npb, hfx_bog_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_dif       , npb, hfx_dif_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_opw       , npb, hfx_opw_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj )
-              CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb)   , jpi, jpj )
-            !
-              CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj)
-              CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj )
+            !------------------------------------!
+            ! --- lateral melting if monocat --- !
+            !------------------------------------!
+            IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN
+               CALL lim_thd_lam( 1, nbpb )
+            END IF
+
+            !-------------------------!
+            ! --- Move to 2D arrays ---
+            !-------------------------!
+            CALL lim_thd_1d2d( nbpb, jl, 2 )
+
             !
             IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ??
          ENDIF
          !
-      END DO
+      END DO !jl
 
       !------------------------------------------------------------------------------!
@@ -448,36 +278,52 @@
 
       !------------------------
-      ! 5.1) Ice heat content              
+      ! Ice heat content              
       !------------------------
-      ! Enthalpies are global variables we have to readjust the units (heat content in Joules)
+      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2)
       DO jl = 1, jpl
          DO jk = 1, nlay_i
-            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) / ( unit_fac * REAL( nlay_i ) )
+            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i
          END DO
       END DO
 
       !------------------------
-      ! 5.2) Snow heat content              
+      ! Snow heat content              
       !------------------------
-      ! Enthalpies are global variables we have to readjust the units (heat content in Joules)
+      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2)
       DO jl = 1, jpl
          DO jk = 1, nlay_s
-            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) / ( unit_fac * REAL( nlay_s ) )
+            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s
          END DO
       END DO
-
+ 
       !----------------------------------
-      ! 5.3) Change thickness to volume
+      ! Change thickness to volume
       !----------------------------------
-      CALL lim_var_eqv2glo
+      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:)
+      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:)
+      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
+
+      ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat)
+      DO jl  = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i_b(ji,jj,jl) - epsi10 ) )
+               oa_i(ji,jj,jl) = rswitch * oa_i(ji,jj,jl) * a_i(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 )
+            END DO
+         END DO
+      END DO
+
+      CALL lim_var_zapsmall
 
       !--------------------------------------------
-      ! 5.4) Diagnostic thermodynamic growth rates
+      ! Diagnostic thermodynamic growth rates
       !--------------------------------------------
+      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' )   ! control print
+
       IF(ln_ctl) THEN            ! Control print
          CALL prt_ctl_info(' ')
          CALL prt_ctl_info(' - Cell values : ')
          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=area , clinfo1=' lim_thd  : cell area :')
+         CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_thd  : cell area :')
          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd  : at_i      :')
          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd  : vt_i      :')
@@ -508,9 +354,59 @@
       !
       !
-      CALL wrk_dealloc( jpi, jpj, zqsr, zqns )
-
-      !
-      ! conservation test
       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      !------------------------------------------------------------------------------|
+      !  6) Transport of ice between thickness categories.                           |
+      !------------------------------------------------------------------------------|
+      ! Given thermodynamic growth rates, transport ice between thickness categories.
+      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      IF( jpl > 1 )      CALL lim_itd_th_rem( 1, jpl, kt )
+
+      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      !------------------------------------------------------------------------------|
+      !  7) Add frazil ice growing in leads.
+      !------------------------------------------------------------------------------|
+      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      CALL lim_thd_lac
+      
+      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      ! Control print
+      IF(ln_ctl) THEN
+         CALL lim_var_glo2eqv
+
+         CALL prt_ctl_info(' ')
+         CALL prt_ctl_info(' - Cell values : ')
+         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
+         CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_th  : cell area :')
+         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th  : at_i      :')
+         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th  : vt_i      :')
+         CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th  : vt_s      :')
+         DO jl = 1, jpl
+            CALL prt_ctl_info(' ')
+            CALL prt_ctl_info(' - Category : ', ivar1=jl)
+            CALL prt_ctl_info('   ~~~~~~~~~~')
+            CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : a_i      : ')
+            CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_i     : ')
+            CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_s     : ')
+            CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_i      : ')
+            CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_s      : ')
+            CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : e_s      : ')
+            CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_itd_th  : t_su     : ')
+            CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : t_snow   : ')
+            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ')
+            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ')
+            DO jk = 1, nlay_i
+               CALL prt_ctl_info(' ')
+               CALL prt_ctl_info(' - Layer : ', ivar1=jk)
+               CALL prt_ctl_info('   ~~~~~~~')
+               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : t_i      : ')
+               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : e_i      : ')
+            END DO
+         END DO
+      ENDIF
       !
       IF( nn_timing == 1 )  CALL timing_stop('limthd')
@@ -518,4 +414,5 @@
    END SUBROUTINE lim_thd 
 
+ 
    SUBROUTINE lim_thd_temp( kideb, kiut )
       !!-----------------------------------------------------------------------
@@ -534,19 +431,188 @@
       DO jk = 1, nlay_i
          DO ji = kideb, kiut
-            ztmelts       =  -tmut * s_i_1d(ji,jk) + rtt
+            ztmelts       =  -tmut * s_i_1d(ji,jk) + rt0
             ! Conversion q(S,T) -> T (second order equation)
             zaaa          =  cpic
-            zbbb          =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_1d(ji,jk) / rhoic - lfus
-            zccc          =  lfus * ( ztmelts - rtt )
+            zbbb          =  ( rcp - cpic ) * ( ztmelts - rt0 ) + q_i_1d(ji,jk) * r1_rhoic - lfus
+            zccc          =  lfus * ( ztmelts - rt0 )
             zdiscrim      =  SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) )
-            t_i_1d(ji,jk) =  rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa )
+            t_i_1d(ji,jk) =  rt0 - ( zbbb + zdiscrim ) / ( 2._wp * zaaa )
             
             ! mask temperature
             rswitch       =  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 
-            t_i_1d(ji,jk) =  rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rtt
+            t_i_1d(ji,jk) =  rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0
          END DO 
       END DO 
 
    END SUBROUTINE lim_thd_temp
+
+   SUBROUTINE lim_thd_lam( kideb, kiut )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_lam *** 
+      !!                 
+      !! ** Purpose :   Lateral melting in case monocategory
+      !!                          ( dA = A/2h dh )
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kideb, kiut        ! bounds for the spatial loop
+      INTEGER             ::   ji                 ! dummy loop indices
+      REAL(wp)            ::   zhi_bef            ! ice thickness before thermo
+      REAL(wp)            ::   zdh_mel, zda_mel   ! net melting
+      REAL(wp)            ::   zvi, zvs           ! ice/snow volumes 
+
+      DO ji = kideb, kiut
+         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) )
+         IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp )  THEN
+            zvi          = a_i_1d(ji) * ht_i_1d(ji)
+            zvs          = a_i_1d(ji) * ht_s_1d(ji)
+            ! lateral melting = concentration change
+            zhi_bef     = ht_i_1d(ji) - zdh_mel
+            rswitch     = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) )
+            zda_mel     = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) )
+            a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel ) 
+             ! adjust thickness
+            ht_i_1d(ji) = zvi / a_i_1d(ji)            
+            ht_s_1d(ji) = zvs / a_i_1d(ji)            
+            ! retrieve total concentration
+            at_i_1d(ji) = a_i_1d(ji)
+         END IF
+      END DO
+      
+   END SUBROUTINE lim_thd_lam
+
+   SUBROUTINE lim_thd_1d2d( nbpb, jl, kn )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_1d2d *** 
+      !!                 
+      !! ** Purpose :   move arrays from 1d to 2d and the reverse
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D
+                                        ! 2= from 1D to 2D
+      INTEGER, INTENT(in) ::   nbpb     ! size of 1D arrays
+      INTEGER, INTENT(in) ::   jl       ! ice cat
+      INTEGER             ::   jk       ! dummy loop indices
+
+      SELECT CASE( kn )
+
+      CASE( 1 )
+
+         CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+         
+         CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+         DO jk = 1, nlay_s
+            CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+         END DO
+         DO jk = 1, nlay_i
+            CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+         END DO
+         
+         CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, evap_ice_1d (1:nbpb), evap_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) ) 
+         CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) )
+         
+         CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) )
+         
+         CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) )
+         
+         CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) )
+         
+         CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) )
+
+      CASE( 2 )
+
+         CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_1d    (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_1d     (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_1d    (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_1d    (1:nbpb)   , jpi, jpj )
+         DO jk = 1, nlay_s
+            CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d     (1:nbpb,jk), jpi, jpj)
+            CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d     (1:nbpb,jk), jpi, jpj)
+         END DO
+         DO jk = 1, nlay_i
+            CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d     (1:nbpb,jk), jpi, jpj)
+            CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d     (1:nbpb,jk), jpi, jpj)
+            CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d     (1:nbpb,jk), jpi, jpj)
+         END DO
+         CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj )
+         
+         CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj )
+         
+         CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj )
+         
+         CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj )
+         
+         CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_sum       , npb, hfx_sum_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_bom       , npb, hfx_bom_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_bog       , npb, hfx_bog_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_dif       , npb, hfx_dif_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_opw       , npb, hfx_opw_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_err_dif   , npb, hfx_err_dif_1d(1:nbpb), jpi, jpj )
+         !
+         CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj)
+         CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj )
+         !         
+      END SELECT
+
+   END SUBROUTINE lim_thd_1d2d
+
 
    SUBROUTINE lim_thd_init
@@ -563,7 +629,7 @@
       !!-------------------------------------------------------------------
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,   &
-         &                hiclim, hnzst, parsub, betas,                          & 
-         &                kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi
+      NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,                       &
+         &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, &
+         &                nn_monocat, ln_it_qnsice
       !!-------------------------------------------------------------------
       !
@@ -582,26 +648,29 @@
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp )
       IF(lwm) WRITE ( numoni, namicethd )
-
-      IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )
+      !
+      IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN 
+         nn_monocat = 0
+         IF(lwp) WRITE(numout, *) '   nn_monocat must be 0 in multi-category case '
+      ENDIF
+
       !
       IF(lwp) THEN                          ! control print
          WRITE(numout,*)
          WRITE(numout,*)'   Namelist of ice parameters for ice thermodynamic computation '
-         WRITE(numout,*)'      maximum melting at the bottom                           hmelt        = ', hmelt
-         WRITE(numout,*)'      ice thick. for lateral accretion                        hiccrit      = ', hiccrit
-         WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       fraz_swi     = ', fraz_swi
-         WRITE(numout,*)'      Maximum proportion of frazil ice collecting at bottom   maxfrazb     = ', maxfrazb
-         WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  vfrazb       = ', vfrazb
-         WRITE(numout,*)'      Squeezing coefficient for collection of frazil          Cfrazb       = ', Cfrazb
-         WRITE(numout,*)'      minimum ice thickness                                   hiclim       = ', hiclim 
+         WRITE(numout,*)'      ice thick. for lateral accretion                        rn_hnewice   = ', rn_hnewice
+         WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       ln_frazil    = ', ln_frazil
+         WRITE(numout,*)'      Maximum proportion of frazil ice collecting at bottom   rn_maxfrazb  = ', rn_maxfrazb
+         WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  rn_vfrazb    = ', rn_vfrazb
+         WRITE(numout,*)'      Squeezing coefficient for collection of frazil          rn_Cfrazb    = ', rn_Cfrazb
+         WRITE(numout,*)'      minimum ice thickness                                   rn_himin     = ', rn_himin 
          WRITE(numout,*)'      numerical carac. of the scheme for diffusion in ice '
-         WRITE(numout,*)'      thickness of the surf. layer in temp. computation       hnzst        = ', hnzst
-         WRITE(numout,*)'      switch for snow sublimation  (=1) or not (=0)           parsub       = ', parsub  
-         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          betas        = ', betas
-         WRITE(numout,*)'      extinction radiation parameter in sea ice (1.0)         kappa_i      = ', kappa_i
-         WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nconv_i_thd  = ', nconv_i_thd
-         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        maxer_i_thd  = ', maxer_i_thd
-         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     thcon_i_swi  = ', thcon_i_swi
+         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          rn_betas     = ', rn_betas
+         WRITE(numout,*)'      extinction radiation parameter in sea ice               rn_kappa_i   = ', rn_kappa_i
+         WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nn_conv_dif  = ', nn_conv_dif
+         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        rn_terr_dif  = ', rn_terr_dif
+         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     nn_ice_thcon = ', nn_ice_thcon
          WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i
+         WRITE(numout,*)'      virtual ITD mono-category parameterizations (1) or not  nn_monocat   = ', nn_monocat
+         WRITE(numout,*)'      iterate the surface non-solar flux (T) or not (F)       ln_it_qnsice = ', ln_it_qnsice
       ENDIF
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 5682)
@@ -20,5 +20,4 @@
    USE sbc_oce        ! Surface boundary condition: ocean fields
    USE ice            ! LIM variables
-   USE par_ice        ! LIM parameters
    USE thd_ice        ! LIM thermodynamics
    USE in_out_manager ! I/O manager
@@ -30,5 +29,10 @@
    PRIVATE
 
-   PUBLIC   lim_thd_dh   ! called by lim_thd
+   PUBLIC   lim_thd_dh      ! called by lim_thd
+   PUBLIC   lim_thd_snwblow ! called in sbcblk/sbcclio/sbccpl and here
+
+   INTERFACE lim_thd_snwblow
+      MODULE PROCEDURE lim_thd_snwblow_1d, lim_thd_snwblow_2d
+   END INTERFACE
 
    !!----------------------------------------------------------------------
@@ -70,8 +74,7 @@
 
       REAL(wp) ::   ztmelts             ! local scalar
-      REAL(wp) ::   zdh, zfdum  !
+      REAL(wp) ::   zfdum       
       REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment
-      REAL(wp) ::   zcoeff       ! dummy argument for snowfall partitioning over ice and leads
-      REAL(wp) ::   zs_snic  ! snow-ice salinity
+      REAL(wp) ::   zs_snic      ! snow-ice salinity
       REAL(wp) ::   zswi1        ! switch for computation of bottom salinity
       REAL(wp) ::   zswi12       ! switch for computation of bottom salinity
@@ -87,12 +90,9 @@
       REAL(wp) ::   zsstK        ! SST in Kelvin
 
-      REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness
       REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow                       (J.m-3)
       REAL(wp), POINTER, DIMENSION(:) ::   zq_su       ! heat for surface ablation                   (J.m-2)
       REAL(wp), POINTER, DIMENSION(:) ::   zq_bo       ! heat for bottom ablation                    (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zq_1cat     ! corrected heat in case 1-cat and hmelt>15cm (J.m-2)
       REAL(wp), POINTER, DIMENSION(:) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2)
-      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt     ! Heat budget to determine melting or freezing(W.m-2)
-      INTEGER , POINTER, DIMENSION(:) ::   icount      ! number of layers vanished by melting 
+      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2)
 
       REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel   ! snow melt 
@@ -102,11 +102,12 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   zdeltah
       REAL(wp), POINTER, DIMENSION(:,:) ::   zh_i      ! ice layer thickness
+      INTEGER , POINTER, DIMENSION(:,:) ::   icount    ! number of layers vanished by melting 
 
       REAL(wp), POINTER, DIMENSION(:) ::   zqh_i       ! total ice heat content  (J.m-2)
       REAL(wp), POINTER, DIMENSION(:) ::   zqh_s       ! total snow heat content (J.m-2)
       REAL(wp), POINTER, DIMENSION(:) ::   zq_s        ! total snow enthalpy     (J.m-3)
-
-      ! mass and salt flux (clem)
-      REAL(wp) :: zdvres, zswitch_sal
+      REAL(wp), POINTER, DIMENSION(:) ::   zsnw        ! distribution of snow after wind blowing
+
+      REAL(wp) :: zswitch_sal
 
       ! Heat conservation 
@@ -115,31 +116,31 @@
       !!------------------------------------------------------------------
 
-      ! Discriminate between varying salinity (num_sal=2) and prescribed cases (other values)
-      SELECT CASE( num_sal )                       ! varying salinity or not
+      ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values)
+      SELECT CASE( nn_icesal )                       ! varying salinity or not
          CASE( 1, 3, 4 ) ;   zswitch_sal = 0       ! prescribed salinity profile
          CASE( 2 )       ;   zswitch_sal = 1       ! varying salinity profile
       END SELECT
 
-      CALL wrk_alloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema )
+      CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw )
       CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s )
-      CALL wrk_alloc( jpij, nlay_i+1, zdeltah, zh_i )
-      CALL wrk_alloc( jpij, icount )
-      
+      CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i )
+      CALL wrk_alloc( jpij, nlay_i, icount )
+       
       dh_i_surf  (:) = 0._wp ; dh_i_bott  (:) = 0._wp ; dh_snowice(:) = 0._wp
       dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp   
- 
-      zqprec (:) = 0._wp ; zq_su  (:) = 0._wp ; zq_bo  (:) = 0._wp ; zf_tt  (:) = 0._wp
-      zq_1cat(:) = 0._wp ; zq_rema(:) = 0._wp
-
-      zh_s     (:) = 0._wp       
-      zdh_s_pre(:) = 0._wp
-      zdh_s_mel(:) = 0._wp
-      zdh_s_sub(:) = 0._wp
-      zqh_s    (:) = 0._wp      
-      zqh_i    (:) = 0._wp   
-
-      zh_i      (:,:) = 0._wp       
-      zdeltah   (:,:) = 0._wp       
-      icount    (:)   = 0
+
+      zqprec   (:) = 0._wp ; zq_su    (:) = 0._wp ; zq_bo    (:) = 0._wp ; zf_tt(:) = 0._wp
+      zq_rema  (:) = 0._wp ; zsnw     (:) = 0._wp
+      zdh_s_mel(:) = 0._wp ; zdh_s_pre(:) = 0._wp ; zdh_s_sub(:) = 0._wp ; zqh_i(:) = 0._wp
+      zqh_s    (:) = 0._wp ; zq_s     (:) = 0._wp     
+
+      zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp       
+      icount (:,:) = 0
+
+
+      ! Initialize enthalpy at nlay_i+1
+      DO ji = kideb, kiut
+         q_i_1d(ji,nlay_i+1) = 0._wp
+      END DO
 
       ! initialize layer thicknesses and enthalpies
@@ -148,5 +149,5 @@
       DO jk = 1, nlay_i
          DO ji = kideb, kiut
-            h_i_old (ji,jk) = ht_i_1d(ji) / REAL( nlay_i )
+            h_i_old (ji,jk) = ht_i_1d(ji) * r1_nlay_i
             qh_i_old(ji,jk) = q_i_1d(ji,jk) * h_i_old(ji,jk)
          ENDDO
@@ -158,11 +159,8 @@
       !
       DO ji = kideb, kiut
-         rswitch       = 1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )
-         ztmelts       = rswitch * rtt + ( 1._wp - rswitch ) * rtt
-
          zfdum      = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
          zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 
 
-         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - ztmelts ) )
+         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) )
          zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice )
       END DO
@@ -174,5 +172,5 @@
       !------------------------------------------------------------------------------!
       DO ji = kideb, kiut
-         IF( t_s_1d(ji,1) > rtt ) THEN !!! Internal melting
+         IF( t_s_1d(ji,1) > rt0 ) THEN !!! Internal melting
             ! Contribution to heat flux to the ocean [W.m-2], < 0  
             hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_1d(ji,1) * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice
@@ -182,5 +180,5 @@
             ht_s_1d(ji)   = 0._wp
             q_s_1d (ji,1) = 0._wp
-            t_s_1d (ji,1) = rtt
+            t_s_1d (ji,1) = rt0
          END IF
       END DO
@@ -190,11 +188,7 @@
       !------------------------------------------------------------!
       !
-      DO ji = kideb, kiut     
-         zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s )
-      END DO
-      !
       DO jk = 1, nlay_s
          DO ji = kideb, kiut
-            zqh_s(ji) =  zqh_s(ji) + q_s_1d(ji,jk) * zh_s(ji)
+            zqh_s(ji) =  zqh_s(ji) + q_s_1d(ji,jk) * ht_s_1d(ji) * r1_nlay_s
          END DO
       END DO
@@ -202,5 +196,5 @@
       DO jk = 1, nlay_i
          DO ji = kideb, kiut
-            zh_i(ji,jk) = ht_i_1d(ji) / REAL( nlay_i )
+            zh_i(ji,jk) = ht_i_1d(ji) * r1_nlay_i
             zqh_i(ji)   = zqh_i(ji) + q_i_1d(ji,jk) * zh_i(ji,jk)
          END DO
@@ -225,4 +219,7 @@
       ! Martin Vancoppenolle, December 2006
 
+      CALL lim_thd_snwblow( 1. - at_i_1d(kideb:kiut), zsnw(kideb:kiut) ) ! snow distribution over ice after wind blowing
+
+      zdeltah(:,:) = 0._wp
       DO ji = kideb, kiut
          !-----------
@@ -230,8 +227,7 @@
          !-----------
          ! thickness change
-         zcoeff = ( 1._wp - ( 1._wp - at_i_1d(ji) )**betas ) / at_i_1d(ji) 
-         zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice / rhosn
-         ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K)
-         zqprec   (ji) = rhosn * ( cpic * ( rtt - MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus )   
+         zdh_s_pre(ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhosn / at_i_1d(ji)
+         ! enthalpy of the precip (>0, J.m-3)
+         zqprec   (ji) = - qprec_ice_1d(ji)   
          IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp
          ! heat flux from snow precip (>0, W.m-2)
@@ -239,6 +235,4 @@
          ! mass flux, <0
          wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice
-         ! update thickness
-         ht_s_1d    (ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) )
 
          !---------------------
@@ -246,30 +240,28 @@
          !---------------------
          ! thickness change
-         IF( zdh_s_pre(ji) > 0._wp ) THEN
-         rswitch        = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zqprec(ji) + epsi20 ) )
-         zdh_s_mel (ji) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 )
-         zdh_s_mel (ji) = MAX( - zdh_s_pre(ji), zdh_s_mel(ji) ) ! bound melting 
+         rswitch        = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) )
+         zdeltah (ji,1) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 )
+         zdeltah (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) ) ! bound melting 
          ! heat used to melt snow (W.m-2, >0)
-         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdh_s_mel(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
+         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
          ! snow melting only = water into the ocean (then without snow precip), >0
-         wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_mel(ji) * r1_rdtice
-         
-         ! updates available heat + thickness
-         zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdh_s_mel(ji) * zqprec(ji) )      
-         ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_mel(ji) )
-         zh_s  (ji) = ht_s_1d(ji) / REAL( nlay_s )
-
-         ENDIF
-      END DO
-
-      ! If heat still available, then melt more snow
-      zdeltah(:,:) = 0._wp ! important
+         wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice    
+         ! updates available heat + precipitations after melting
+         zq_su     (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,1) * zqprec(ji) )      
+         zdh_s_pre (ji) = zdh_s_pre(ji) + zdeltah(ji,1)
+
+         ! update thickness
+         ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) )
+      END DO
+
+      ! If heat still available (zq_su > 0), then melt more snow
+      zdeltah(:,:) = 0._wp
       DO jk = 1, nlay_s
          DO ji = kideb, kiut
             ! thickness change
             rswitch          = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) ) 
-            rswitch          = rswitch * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - q_s_1d(ji,jk) + epsi20 ) ) ) 
+            rswitch          = rswitch * ( MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,jk) - epsi20 ) ) ) 
             zdeltah  (ji,jk) = - rswitch * zq_su(ji) / MAX( q_s_1d(ji,jk), epsi20 )
-            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) ! bound melting
+            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - ht_s_1d(ji) ) ! bound melting
             zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk)    
             ! heat used to melt snow(W.m-2, >0)
@@ -277,9 +269,7 @@
             ! snow melting only = water into the ocean (then without snow precip)
             wfx_snw_1d(ji)   = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
-
             ! updates available heat + thickness
-            zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) )
+            zq_su (ji)  = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) )
             ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdeltah(ji,jk) )
-
          END DO
       END DO
@@ -289,31 +279,29 @@
       !----------------------
       ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates
-      ! clem comment: not counted in mass exchange in limsbc since this is an exchange with atm. (not ocean)
+      ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean)
       ! clem comment: ice should also sublimate
-      IF( lk_cpl ) THEN
-         ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice)
-         zdh_s_sub(:)      =  0._wp 
-      ELSE
-         ! forced  mode: snow thickness change due to sublimation
-         DO ji = kideb, kiut
-            zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice )
-            ! Heat flux by sublimation [W.m-2], < 0
-            !      sublimate first snow that had fallen, then pre-existing snow
-            zcoeff         =      ( MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) )   * zqprec(ji) +   &
-               &  ( zdh_s_sub(ji) - MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) ) * q_s_1d(ji,1) )  &
-               &  * a_i_1d(ji) * r1_rdtice
-            hfx_sub_1d(ji) = hfx_sub_1d(ji) + zcoeff
-            ! Mass flux by sublimation
-            wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice
-            ! new snow thickness
-            ht_s_1d(ji)     =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) )
-         END DO
-      ENDIF
-
+      zdeltah(:,:) = 0._wp
+      ! coupled mode: sublimation is set to 0 (evap_ice = 0) until further notice
+      ! forced  mode: snow thickness change due to sublimation
+      DO ji = kideb, kiut
+         zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice )
+         ! Heat flux by sublimation [W.m-2], < 0
+         !      sublimate first snow that had fallen, then pre-existing snow
+         zdeltah(ji,1)  = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) )
+         hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1)  &
+            &                              ) * a_i_1d(ji) * r1_rdtice
+         ! Mass flux by sublimation
+         wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice
+         ! new snow thickness
+         ht_s_1d(ji)    =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) )
+         ! update precipitations after sublimation and correct sublimation
+         zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1)
+         zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1)
+      END DO
+      
       ! --- Update snow diags --- !
       DO ji = kideb, kiut
-         dh_s_tot(ji)   = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji)
-         zh_s(ji)       = ht_s_1d(ji) / REAL( nlay_s )
-      END DO ! ji
+         dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji)
+      END DO
 
       !-------------------------------------------
@@ -324,8 +312,8 @@
       DO jk = 1, nlay_s
          DO ji = kideb,kiut
-            rswitch       =  MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) + epsi20 )  )
-            q_s_1d(ji,jk) = ( 1._wp - rswitch ) / MAX( ht_s_1d(ji), epsi20 ) *             &
-              &            ( (   MAX( 0._wp, dh_s_tot(ji) )              ) * zqprec(ji) +  &
-              &              ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_1d(ji) ) * rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus ) )
+            rswitch       = MAX(  0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 )  )
+            q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) *                          &
+              &            ( (   zdh_s_pre(ji)             ) * zqprec(ji) +  &
+              &              (   ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) )
             zq_s(ji)     =  zq_s(ji) + q_s_1d(ji,jk)
          END DO
@@ -337,45 +325,68 @@
       zdeltah(:,:) = 0._wp ! important
       DO jk = 1, nlay_i
-         DO ji = kideb, kiut 
-            zEi            = - q_i_1d(ji,jk) / rhoic                ! Specific enthalpy of layer k [J/kg, <0]
-
-            ztmelts        = - tmut * s_i_1d(ji,jk) + rtt           ! Melting point of layer k [K]
-
-            zEw            =    rcp * ( ztmelts - rt0 )            ! Specific enthalpy of resulting meltwater [J/kg, <0]
-
-            zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0
-
-            zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0]
-
-            zdeltah(ji,jk) = - zfmdt / rhoic                       ! Melt of layer jk [m, <0]
-
-            zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0]
-
-            zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat
-
-            dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt
-
-            zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0]
-
-            zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0]
-
-            ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
-            sfx_sum_1d(ji)   = sfx_sum_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
-
-            ! Contribution to heat flux [W.m-2], < 0
-            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
-
-            ! Total heat flux used in this process [W.m-2], > 0  
-            hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
-
-            ! Contribution to mass flux
-            wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
-           
+         DO ji = kideb, kiut
+            ztmelts           = - tmut * s_i_1d(ji,jk) + rt0          ! Melting point of layer k [K]
+            
+            IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting
+
+               zEi            = - q_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0]       
+               zdE            = 0._wp                                 ! Specific enthalpy difference   (J/kg, <0)
+                                                                      ! set up at 0 since no energy is needed to melt water...(it is already melted)
+               zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing     
+                                                                      ! this should normally not happen, but sometimes, heat diffusion leads to this
+               zfmdt          = - zdeltah(ji,jk) * rhoic              ! Mass flux x time step > 0
+                         
+               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt
+               
+               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0]
+
+               ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 
+               hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice
+               
+               ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
+               
+               ! Contribution to mass flux
+               wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+
+            ELSE                                !!! Surface melting
+               
+               zEi            = - q_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0]
+               zEw            =    rcp * ( ztmelts - rt0 )            ! Specific enthalpy of resulting meltwater [J/kg, <0]
+               zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0
+               
+               zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0]
+               
+               zdeltah(ji,jk) = - zfmdt * r1_rhoic                    ! Melt of layer jk [m, <0]
+               
+               zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0]
+               
+               zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat
+               
+               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt
+               
+               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0]
+               
+               zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0]
+               
+               ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+               sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
+               
+               ! Contribution to heat flux [W.m-2], < 0
+               hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
+               
+               ! Total heat flux used in this process [W.m-2], > 0  
+               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
+               
+               ! Contribution to mass flux
+               wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+               
+            END IF
             ! record which layers have disappeared (for bottom melting) 
             !    => icount=0 : no layer has vanished
             !    => icount=5 : 5 layers have vanished
-            rswitch     = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) 
-            icount(ji)  = icount(ji) + NINT( rswitch )
-            zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) )
+            rswitch       = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) 
+            icount(ji,jk) = NINT( rswitch )
+            zh_i(ji,jk)   = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) )
 
             ! update heat content (J.m-2) and layer thickness
@@ -408,14 +419,6 @@
       ! -> need for an iterative procedure, which converges quickly
 
-      IF ( num_sal == 2 ) THEN
-         num_iter_max = 5
-      ELSE
-         num_iter_max = 1
-      ENDIF
-
-      !clem debug. Just to be sure that enthalpy at nlay_i+1 is null
-      DO ji = kideb, kiut
-         q_i_1d(ji,nlay_i+1) = 0._wp
-      END DO
+      num_iter_max = 1
+      IF( nn_icesal == 2 ) num_iter_max = 5
 
       ! Iterative procedure
@@ -440,11 +443,11 @@
                                   + ( 1. - zswitch_sal ) * sm_i_1d(ji) 
                ! New ice growth
-               ztmelts            = - tmut * s_i_new(ji) + rtt          ! New ice melting point (K)
+               ztmelts            = - tmut * s_i_new(ji) + rt0          ! New ice melting point (K)
 
                zt_i_new           = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
                
                zEi                = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)      
-                  &               - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) )   &
-                  &               + rcp  * ( ztmelts-rtt )          
+                  &               - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) )   &
+                  &               + rcp  * ( ztmelts-rt0 )          
 
                zEw                = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
@@ -456,7 +459,7 @@
                q_i_1d(ji,nlay_i+1) = -zEi * rhoic                        ! New ice energy of melting (J/m3, >0)
                
-            ENDIF ! fc_bo_i
-         END DO ! ji
-      END DO ! iter
+            ENDIF
+         END DO
+      END DO
 
       ! Contribution to Energy and Salt Fluxes
@@ -467,11 +470,11 @@
             zfmdt          = - rhoic * dh_i_bott(ji)             ! Mass flux x time step (kg/m2, < 0)
 
-            ztmelts        = - tmut * s_i_new(ji) + rtt          ! New ice melting point (K)
+            ztmelts        = - tmut * s_i_new(ji) + rt0          ! New ice melting point (K)
             
             zt_i_new       = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
             
             zEi            = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)      
-               &               - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) )   &
-               &               + rcp  * ( ztmelts-rtt )          
+               &               - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) )   &
+               &               + rcp  * ( ztmelts-rt0 )          
             
             zEw            = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
@@ -486,5 +489,5 @@
             
             ! Contribution to salt flux, <0
-            sfx_bog_1d(ji) = sfx_bog_1d(ji) + s_i_new(ji) * a_i_1d(ji) * zfmdt * r1_rdtice
+            sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * s_i_new(ji) * r1_rdtice
 
             ! Contribution to mass flux, <0
@@ -503,23 +506,19 @@
       DO jk = nlay_i, 1, -1
          DO ji = kideb, kiut
-            IF(  zf_tt(ji)  >=  0._wp  .AND. jk > icount(ji) ) THEN   ! do not calculate where layer has already disappeared from surface melting 
-
-               ztmelts = - tmut * s_i_1d(ji,jk) + rtt  ! Melting point of layer jk (K)
+            IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(ji,jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting 
+
+               ztmelts = - tmut * s_i_1d(ji,jk) + rt0  ! Melting point of layer jk (K)
 
                IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting
 
-                  zEi               = - q_i_1d(ji,jk) / rhoic        ! Specific enthalpy of melting ice (J/kg, <0)
-
-                  !!zEw               = rcp * ( t_i_1d(ji,jk) - rtt )  ! Specific enthalpy of meltwater at T = t_i_1d (J/kg, <0)
-
+                  zEi               = - q_i_1d(ji,jk) * r1_rhoic    ! Specific enthalpy of melting ice (J/kg, <0)
                   zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0)
                                                                     ! set up at 0 since no energy is needed to melt water...(it is already melted)
-
-                  zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing     
-                                                                   ! this should normally not happen, but sometimes, heat diffusion leads to this
+                  zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )  ! internal melting occurs when the internal temperature is above freezing     
+                                                                    ! this should normally not happen, but sometimes, heat diffusion leads to this
 
                   dh_i_bott (ji)    = dh_i_bott(ji) + zdeltah(ji,jk)
 
-                  zfmdt             = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0
+                  zfmdt             = - zdeltah(ji,jk) * rhoic      ! Mass flux x time step > 0
 
                   ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 
@@ -527,5 +526,5 @@
 
                   ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
-                  sfx_res_1d(ji) = sfx_res_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
+                  sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
                                     
                   ! Contribution to mass flux
@@ -538,35 +537,33 @@
                ELSE                               !!! Basal melting
 
-                  zEi               = - q_i_1d(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0)
-
-                  zEw               = rcp * ( ztmelts - rtt )! Specific enthalpy of meltwater (J/kg, <0)
-
-                  zdE               = zEi - zEw              ! Specific enthalpy difference   (J/kg, <0)
-
-                  zfmdt             = - zq_bo(ji) / zdE  ! Mass flux x time step (kg/m2, >0)
-
-                  zdeltah(ji,jk)    = - zfmdt / rhoic        ! Gross thickness change
-
-                  zdeltah(ji,jk)    = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change
+                  zEi             = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0)
+                  zEw             = rcp * ( ztmelts - rt0 )    ! Specific enthalpy of meltwater (J/kg, <0)
+                  zdE             = zEi - zEw                  ! Specific enthalpy difference   (J/kg, <0)
+
+                  zfmdt           = - zq_bo(ji) / zdE          ! Mass flux x time step (kg/m2, >0)
+
+                  zdeltah(ji,jk)  = - zfmdt * r1_rhoic         ! Gross thickness change
+
+                  zdeltah(ji,jk)  = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change
                   
-                  zq_bo(ji)         = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors
-
-                  dh_i_bott(ji)     = dh_i_bott(ji) + zdeltah(ji,jk)    ! Update basal melt
-
-                  zfmdt             = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0
-
-                  zQm               = zfmdt * zEw         ! Heat exchanged with ocean
+                  zq_bo(ji)       = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors
+
+                  dh_i_bott(ji)   = dh_i_bott(ji) + zdeltah(ji,jk)    ! Update basal melt
+
+                  zfmdt           = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0
+
+                  zQm             = zfmdt * zEw         ! Heat exchanged with ocean
 
                   ! Contribution to heat flux to the ocean [W.m-2], <0  
-                  hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
+                  hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
 
                   ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
-                  sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
+                  sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoic *  a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
                   
                   ! Total heat flux used in this process [W.m-2], >0  
-                  hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
+                  hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
                   
                   ! Contribution to mass flux
-                  wfx_bom_1d(ji) =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+                  wfx_bom_1d(ji)  =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
 
                   ! update heat content (J.m-2) and layer thickness
@@ -576,31 +573,6 @@
            
             ENDIF
-         END DO ! ji
-      END DO ! jk
-
-      !------------------------------------------------------------------------------!
-      ! Excessive ablation in a 1-category model
-      !     in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15)
-      !------------------------------------------------------------------------------!
-      ! ??? keep ???
-      ! clem bug: I think this should be included above, so we would not have to 
-      !           track heat/salt/mass fluxes backwards
-!      IF( jpl == 1 ) THEN
-!         DO ji = kideb, kiut
-!            IF(  zf_tt(ji)  >=  0._wp  ) THEN
-!               zdh            = MAX( hmelt , dh_i_bott(ji) )
-!               zdvres         = zdh - dh_i_bott(ji) ! >=0
-!               dh_i_bott(ji)  = zdh
-!
-!               ! excessive energy is sent to lateral ablation
-!               rswitch = MAX( 0._wp, SIGN( 1._wp , 1._wp - at_i_1d(ji) - epsi20 ) )
-!               zq_1cat(ji) =  rswitch * rhoic * lfus * at_i_1d(ji) / MAX( 1._wp - at_i_1d(ji) , epsi20 ) * zdvres ! J.m-2 >=0
-!
-!               ! correct salt and mass fluxes
-!               sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdvres * rhoic * r1_rdtice ! this is only a raw approximation
-!               wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdvres * r1_rdtice
-!            ENDIF
-!         END DO
-!      ENDIF
+         END DO
+      END DO
 
       !-------------------------------------------
@@ -619,23 +591,22 @@
       DO ji = kideb, kiut
          zq_rema(ji)     = zq_su(ji) + zq_bo(ji) 
-!         zindh           = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )   ! =1 if snow
-!         zindq           = 1._wp - MAX( 0._wp, SIGN( 1._wp, - zq_s(ji) + epsi20 ) )
-!         zdeltah  (ji,1) = - zindh * zindq * zq_rema(ji) / MAX( zq_s(ji), epsi20 )
-!         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting
-!         zdh_s_mel(ji)   = zdh_s_mel(ji) + zdeltah(ji,1)    
-!         dh_s_tot (ji)   = dh_s_tot(ji) + zdeltah(ji,1)
-!         ht_s_1d   (ji)   = ht_s_1d(ji)   + zdeltah(ji,1)
-!        
-!         zq_rema(ji)     = zq_rema(ji) + zdeltah(ji,1) * zq_s(ji)                ! update available heat (J.m-2)
-!         ! heat used to melt snow
-!         hfx_snw_1d(ji)  = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zq_s(ji) * r1_rdtice ! W.m-2 (>0)
-!         ! Contribution to mass flux
-!         wfx_snw_1d(ji)  =  wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice
-!    
+         rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )   ! =1 if snow
+         rswitch         = rswitch * MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,1) - epsi20 ) )
+         zdeltah  (ji,1) = - rswitch * zq_rema(ji) / MAX( q_s_1d(ji,1), epsi20 )
+         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting
+         dh_s_tot (ji)   = dh_s_tot(ji)  + zdeltah(ji,1)
+         ht_s_1d   (ji)  = ht_s_1d(ji)   + zdeltah(ji,1)
+        
+         zq_rema(ji)     = zq_rema(ji) + zdeltah(ji,1) * q_s_1d(ji,1)                ! update available heat (J.m-2)
+         ! heat used to melt snow
+         hfx_snw_1d(ji)  = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * q_s_1d(ji,1) * r1_rdtice ! W.m-2 (>0)
+         ! Contribution to mass flux
+         wfx_snw_1d(ji)  =  wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice
+         !    
          ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
          ! Remaining heat flux (W.m-2) is sent to the ocean heat budget
-         hfx_out(ii,ij)  = hfx_out(ii,ij) + ( zq_1cat(ji) + zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice
-
-         IF( ln_nicep .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji)
+         hfx_out(ii,ij)  = hfx_out(ii,ij) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice
+
+         IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji)
       END DO
       
@@ -650,20 +621,20 @@
          dh_snowice(ji) = MAX(  0._wp , ( rhosn * ht_s_1d(ji) + (rhoic-rau0) * ht_i_1d(ji) ) / ( rhosn+rau0-rhoic )  )
 
-         ht_i_1d(ji)     = ht_i_1d(ji) + dh_snowice(ji)
-         ht_s_1d(ji)     = ht_s_1d(ji) - dh_snowice(ji)
+         ht_i_1d(ji)    = ht_i_1d(ji) + dh_snowice(ji)
+         ht_s_1d(ji)    = ht_s_1d(ji) - dh_snowice(ji)
 
          ! Salinity of snow ice
          ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
-         zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji)
+         zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji)
 
          ! entrapment during snow ice formation
-         ! new salinity difference stored (to be used in limthd_ent.F90)
-         IF (  num_sal == 2  ) THEN
-            rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi10 ) )
+         ! new salinity difference stored (to be used in limthd_sal.F90)
+         IF (  nn_icesal == 2  ) THEN
+            rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) )
             ! salinity dif due to snow-ice formation
-            dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi10 ) * rswitch     
+            dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch     
             ! salinity dif due to bottom growth 
             IF (  zf_tt(ji)  < 0._wp ) THEN
-               dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi10 ) * rswitch
+               dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch
             ENDIF
          ENDIF
@@ -691,8 +662,5 @@
          h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji)
          
-         ! Total ablation (to debug)
-         IF( ht_i_1d(ji) <= 0._wp )   a_i_1d(ji) = 0._wp
-
-      END DO !ji
+      END DO
 
       !
@@ -700,27 +668,47 @@
       ! Update temperature, energy
       !-------------------------------------------
-      !clem bug: we should take snow into account here
       DO ji = kideb, kiut
          rswitch     =  1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 
-         t_su_1d(ji) =  rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rtt
-      END DO  ! ji
+         t_su_1d(ji) =  rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rt0
+      END DO
 
       DO jk = 1, nlay_s
          DO ji = kideb,kiut
             ! mask enthalpy
-            rswitch       =  MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) )  )
-            q_s_1d(ji,jk) = ( 1.0 - rswitch ) * q_s_1d(ji,jk)
+            rswitch       = 1._wp - MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) )  )
+            q_s_1d(ji,jk) = rswitch * q_s_1d(ji,jk)
             ! recalculate t_s_1d from q_s_1d
-            t_s_1d(ji,jk) = rtt + ( 1._wp - rswitch ) * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic )
+            t_s_1d(ji,jk) = rt0 + rswitch * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic )
          END DO
       END DO
 
-      CALL wrk_dealloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema )
+      ! --- ensure that a_i = 0 where ht_i = 0 ---
+      WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp
+      
+      CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw )
       CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s )
-      CALL wrk_dealloc( jpij, nlay_i+1, zdeltah, zh_i )
-      CALL wrk_dealloc( jpij, icount )
+      CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i )
+      CALL wrk_dealloc( jpij, nlay_i, icount )
       !
       !
    END SUBROUTINE lim_thd_dh
+
+
+   !!--------------------------------------------------------------------------
+   !! INTERFACE lim_thd_snwblow
+   !! ** Purpose :   Compute distribution of precip over the ice
+   !!--------------------------------------------------------------------------
+   SUBROUTINE lim_thd_snwblow_2d( pin, pout )
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pin   ! previous fraction lead ( pfrld or (1. - a_i_b) )
+      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout
+      pout = ( 1._wp - ( pin )**rn_betas )
+   END SUBROUTINE lim_thd_snwblow_2d
+
+   SUBROUTINE lim_thd_snwblow_1d( pin, pout )
+      REAL(wp), DIMENSION(:), INTENT(in   ) :: pin
+      REAL(wp), DIMENSION(:), INTENT(inout) :: pout
+      pout = ( 1._wp - ( pin )**rn_betas )
+   END SUBROUTINE lim_thd_snwblow_1d
+
    
 #else
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90	(revision 5682)
@@ -19,5 +19,4 @@
    USE phycst         ! physical constants (ocean directory) 
    USE ice            ! LIM-3 variables
-   USE par_ice        ! LIM-3 parameters
    USE thd_ice        ! LIM-3: thermodynamics
    USE in_out_manager ! I/O manager
@@ -25,5 +24,4 @@
    USE wrk_nemo       ! work arrays
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE sbc_oce, ONLY : lk_cpl
 
    IMPLICIT NONE
@@ -100,7 +98,8 @@
       INTEGER ::   nconv       ! number of iterations in iterative procedure
       INTEGER ::   minnumeqmin, maxnumeqmax
+      
       INTEGER, POINTER, DIMENSION(:) ::   numeqmin   ! reference number of top equation
       INTEGER, POINTER, DIMENSION(:) ::   numeqmax   ! reference number of bottom equation
-      INTEGER, POINTER, DIMENSION(:) ::   isnow      ! switch for presence (1) or absence (0) of snow
+      
       REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system
       REAL(wp) ::   zg1       =  2._wp        !
@@ -112,47 +111,66 @@
       REAL(wp) ::   ztmelt_i    ! ice melting temperature
       REAL(wp) ::   zerritmax   ! current maximal error on temperature 
-      REAL(wp), POINTER, DIMENSION(:) ::   ztfs        ! ice melting point
-      REAL(wp), POINTER, DIMENSION(:) ::   ztsub       ! old surface temperature (before the iterative procedure )
-      REAL(wp), POINTER, DIMENSION(:) ::   ztsubit     ! surface temperature at previous iteration
-      REAL(wp), POINTER, DIMENSION(:) ::   zh_i        ! ice layer thickness
-      REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness
-      REAL(wp), POINTER, DIMENSION(:) ::   zfsw        ! solar radiation absorbed at the surface
-      REAL(wp), POINTER, DIMENSION(:) ::   zf          ! surface flux function
-      REAL(wp), POINTER, DIMENSION(:) ::   dzf         ! derivative of the surface flux function
-      REAL(wp), POINTER, DIMENSION(:) ::   zerrit      ! current error on temperature
-      REAL(wp), POINTER, DIMENSION(:) ::   zdifcase    ! case of the equation resolution (1->4)
-      REAL(wp), POINTER, DIMENSION(:) ::   zftrice     ! solar radiation transmitted through the ice
-      REAL(wp), POINTER, DIMENSION(:) ::   zihic, zhsu
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztcond_i    ! Ice thermal conductivity
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_i    ! Radiation transmitted through the ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_i    ! Radiation absorbed in the ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_i    ! Kappa factor in the ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztib        ! Old temperature in the ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_i      ! Eta factor in the ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztitemp     ! Temporary temperature in the ice to check the convergence
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zspeche_i   ! Ice specific heat
-      REAL(wp), POINTER, DIMENSION(:,:) ::   z_i         ! Vertical cotes of the layers in the ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_s    ! Radiation transmited through the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_s    ! Radiation absorbed in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_s    ! Kappa factor in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_s      ! Eta factor in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztstemp     ! Temporary temperature in the snow to check the convergence
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztsb        ! Temporary temperature in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   z_s         ! Vertical cotes of the layers in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zswiterm    ! Independent term
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zswitbis    ! temporary independent term
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zdiagbis
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid     ! tridiagonal system terms
+      REAL(wp) ::   zhsu
+      
+      REAL(wp), POINTER, DIMENSION(:)     ::   isnow       ! switch for presence (1) or absence (0) of snow
+      REAL(wp), POINTER, DIMENSION(:)     ::   ztsub       ! old surface temperature (before the iterative procedure )
+      REAL(wp), POINTER, DIMENSION(:)     ::   ztsubit     ! surface temperature at previous iteration
+      REAL(wp), POINTER, DIMENSION(:)     ::   zh_i        ! ice layer thickness
+      REAL(wp), POINTER, DIMENSION(:)     ::   zh_s        ! snow layer thickness
+      REAL(wp), POINTER, DIMENSION(:)     ::   zfsw        ! solar radiation absorbed at the surface
+      REAL(wp), POINTER, DIMENSION(:)     ::   zqns_ice_b  ! solar radiation absorbed at the surface
+      REAL(wp), POINTER, DIMENSION(:)     ::   zf          ! surface flux function
+      REAL(wp), POINTER, DIMENSION(:)     ::   dzf         ! derivative of the surface flux function
+      REAL(wp), POINTER, DIMENSION(:)     ::   zerrit      ! current error on temperature
+      REAL(wp), POINTER, DIMENSION(:)     ::   zdifcase    ! case of the equation resolution (1->4)
+      REAL(wp), POINTER, DIMENSION(:)     ::   zftrice     ! solar radiation transmitted through the ice
+      REAL(wp), POINTER, DIMENSION(:)     ::   zihic
+      
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztcond_i    ! Ice thermal conductivity
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradtr_i    ! Radiation transmitted through the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradab_i    ! Radiation absorbed in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zkappa_i    ! Kappa factor in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztib        ! Old temperature in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zeta_i      ! Eta factor in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztitemp     ! Temporary temperature in the ice to check the convergence
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zspeche_i   ! Ice specific heat
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   z_i         ! Vertical cotes of the layers in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradtr_s    ! Radiation transmited through the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradab_s    ! Radiation absorbed in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zkappa_s    ! Kappa factor in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zeta_s      ! Eta factor in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztstemp     ! Temporary temperature in the snow to check the convergence
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztsb        ! Temporary temperature in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   z_s         ! Vertical cotes of the layers in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zindterm    ! 'Ind'ependent term
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zindtbis    ! Temporary 'ind'ependent term
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdiagbis    ! Temporary 'dia'gonal term
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid       ! Tridiagonal system terms
+      
       ! diag errors on heat
-      REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err
+      REAL(wp), POINTER, DIMENSION(:)     :: zdq, zq_ini, zhfx_err
+      
+      ! Mono-category
+      REAL(wp)                            :: zepsilon      ! determines thres. above which computation of G(h) is done
+      REAL(wp)                            :: zratio_s      ! dummy factor
+      REAL(wp)                            :: zratio_i      ! dummy factor
+      REAL(wp)                            :: zh_thres      ! thickness thres. for G(h) computation
+      REAL(wp)                            :: zhe           ! dummy factor
+      REAL(wp)                            :: zkimean       ! mean sea ice thermal conductivity
+      REAL(wp)                            :: zfac          ! dummy factor
+      REAL(wp)                            :: zihe          ! dummy factor
+      REAL(wp)                            :: zheshth       ! dummy factor
+      
+      REAL(wp), POINTER, DIMENSION(:)     :: zghe          ! G(he), th. conduct enhancement factor, mono-cat
+      
       !!------------------------------------------------------------------     
       ! 
-      CALL wrk_alloc( jpij, numeqmin, numeqmax, isnow )
-      CALL wrk_alloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw )
-      CALL wrk_alloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu )
-      CALL wrk_alloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0)
-      CALL wrk_alloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0)
-      CALL wrk_alloc( jpij, nlay_i+3, zswiterm, zswitbis, zdiagbis  )
-      CALL wrk_alloc( jpij, nlay_i+3, 3, ztrid )
+      CALL wrk_alloc( jpij, numeqmin, numeqmax )
+      CALL wrk_alloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )
+      CALL wrk_alloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe )
+      CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 )
+      CALL wrk_alloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 )
+      CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis  )
+      CALL wrk_alloc( jpij,nlay_i+3,3, ztrid )
 
       CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err )
@@ -161,6 +179,6 @@
       zdq(:) = 0._wp ; zq_ini(:) = 0._wp      
       DO ji = kideb, kiut
-         zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) +  &
-            &           SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) ) 
+         zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i +  &
+            &           SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s ) 
       END DO
 
@@ -168,13 +186,9 @@
       ! 1) Initialization                                                            !
       !------------------------------------------------------------------------------!
-      ! clem clean: replace just ztfs by rtt
       DO ji = kideb , kiut
-         ! is there snow or not
-         isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) )  )
-         ! surface temperature of fusion
-         ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt
+         isnow(ji)= 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) )  ! is there snow or not
          ! layer thickness
-         zh_i(ji) = ht_i_1d(ji) / REAL( nlay_i )
-         zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s )
+         zh_i(ji) = ht_i_1d(ji) * r1_nlay_i
+         zh_s(ji) = ht_s_1d(ji) * r1_nlay_s
       END DO
 
@@ -188,5 +202,5 @@
       DO jk = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer
          DO ji = kideb , kiut
-            z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) / REAL( nlay_s )
+            z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) * r1_nlay_s
          END DO
       END DO
@@ -194,10 +208,10 @@
       DO jk = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer
          DO ji = kideb , kiut
-            z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) / REAL( nlay_i )
+            z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) * r1_nlay_i
          END DO
       END DO
       !
       !------------------------------------------------------------------------------|
-      ! 2) Radiations                                                                |
+      ! 2) Radiation								                                 |
       !------------------------------------------------------------------------------|
       !
@@ -212,19 +226,13 @@
       ! zftrice = io.qsr_ice       is below the surface 
       ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice 
-
+      ! fr1_i0_1d = i0 for a thin ice cover, fr1_i0_2d = i0 for a thick ice cover
+      zhsu = 0.1_wp ! threshold for the computation of i0
       DO ji = kideb , kiut
          ! switches
-         isnow(ji) = NINT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )  ) 
+         isnow(ji) = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ) 
          ! hs > 0, isnow = 1
-         zhsu (ji) = hnzst  ! threshold for the computation of i0
-         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu(ji) ) )     
-
-         i0(ji)    = REAL( 1 - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) )
-         !fr1_i0_1d = i0 for a thin ice surface
-         !fr1_i0_2d = i0 for a thick ice surface
-         !            a function of the cloud cover
-         !
-         !i0(ji)     =  (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_1d(ji)+10.0)
-         !formula used in Cice
+         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu ) )     
+
+         i0(ji)    = ( 1._wp - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) )
       END DO
 
@@ -234,7 +242,8 @@
       !-------------------------------------------------------
       DO ji = kideb , kiut
-         zfsw   (ji) =  qsr_ice_1d(ji) * ( 1 - i0(ji) )   ! Shortwave radiation absorbed at surface
-         zftrice(ji) =  qsr_ice_1d(ji) *       i0(ji)     ! Solar radiation transmitted below the surface layer
-         dzf    (ji) = dqns_ice_1d(ji)                    ! derivative of incoming nonsolar flux 
+         zfsw   (ji)    =  qsr_ice_1d(ji) * ( 1 - i0(ji) )   ! Shortwave radiation absorbed at surface
+         zftrice(ji)    =  qsr_ice_1d(ji) *       i0(ji)     ! Solar radiation transmitted below the surface layer
+         dzf    (ji)    = dqns_ice_1d(ji)                    ! derivative of incoming nonsolar flux 
+         zqns_ice_b(ji) = qns_ice_1d(ji)                     ! store previous qns_ice_1d value
       END DO
 
@@ -257,5 +266,5 @@
 
       DO ji = kideb, kiut           ! ice initialization
-         zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * REAL( isnow(ji) ) + zftrice(ji) * REAL( 1 - isnow(ji) )
+         zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + zftrice(ji) * ( 1._wp - isnow(ji) )
       END DO
 
@@ -263,5 +272,5 @@
          DO ji = kideb, kiut
             !                             ! radiation transmitted below the layer-th ice layer
-            zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) )
+            zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - rn_kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) )
             !                             ! radiation absorbed by the layer-th ice layer
             zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk)
@@ -273,5 +282,4 @@
       END DO
 
-      !
       !------------------------------------------------------------------------------|
       !  3) Iterative procedure begins                                               |
@@ -281,6 +289,6 @@
          ztsub  (ji) =  t_su_1d(ji)                              ! temperature at the beg of iter pr.
          ztsubit(ji) =  t_su_1d(ji)                              ! temperature at the previous iter
-         t_su_1d   (ji) =  MIN( t_su_1d(ji), ztfs(ji) - ztsu_err )  ! necessary
-         zerrit   (ji) =  1000._wp                                ! initial value of error
+         t_su_1d(ji) =  MIN( t_su_1d(ji), rt0 - ztsu_err )       ! necessary
+         zerrit (ji) =  1000._wp                                 ! initial value of error
       END DO
 
@@ -300,5 +308,5 @@
       zerritmax =  1000._wp    ! maximal value of error on all points
 
-      DO WHILE ( zerritmax > maxer_i_thd .AND. nconv < nconv_i_thd )
+      DO WHILE ( zerritmax > rn_terr_dif .AND. nconv < nn_conv_dif )
          !
          nconv = nconv + 1
@@ -308,78 +316,118 @@
          !------------------------------------------------------------------------------|
          !
-         IF( thcon_i_swi == 0 ) THEN      ! Untersteiner (1964) formula
-            DO ji = kideb , kiut
-               ztcond_i(ji,0)        = rcdic + zbeta*s_i_1d(ji,1) / MIN(-epsi10,t_i_1d(ji,1)-rtt)
-               ztcond_i(ji,0)        = MAX(ztcond_i(ji,0),zkimin)
+         IF( nn_ice_thcon == 0 ) THEN      ! Untersteiner (1964) formula
+            DO ji = kideb , kiut
+               ztcond_i(ji,0) = rcdic + zbeta * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 )
+               ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin )
             END DO
             DO jk = 1, nlay_i-1
                DO ji = kideb , kiut
-                  ztcond_i(ji,jk) = rcdic + zbeta*( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) /  &
-                     MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt)
-                  ztcond_i(ji,jk) = MAX(ztcond_i(ji,jk),zkimin)
+                  ztcond_i(ji,jk) = rcdic + zbeta * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) /  &
+                     MIN(-2.0_wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0)
+                  ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin )
                END DO
             END DO
          ENDIF
 
-         IF( thcon_i_swi == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T
-            DO ji = kideb , kiut
-               ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1)-rtt )   &
-                  &                   - 0.011_wp * ( t_i_1d(ji,1) - rtt )  
+         IF( nn_ice_thcon == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T
+            DO ji = kideb , kiut
+               ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 )   &
+                  &                   - 0.011_wp * ( t_i_1d(ji,1) - rt0 )  
                ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin )
             END DO
             DO jk = 1, nlay_i-1
                DO ji = kideb , kiut
-                  ztcond_i(ji,jk) = rcdic +                                                                     & 
-                     &                 0.090_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) )                          &
-                     &                 / MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt)   &
-                     &               - 0.0055_wp* ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0*rtt )  
+                  ztcond_i(ji,jk) = rcdic +                                                                       & 
+                     &                 0.09_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) )                              &
+                     &                 / MIN( -2._wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0 )   &
+                     &               - 0.0055_wp * ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0 * rt0 )  
                   ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin )
                END DO
             END DO
             DO ji = kideb , kiut
-               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN(-epsi10,t_bo_1d(ji)-rtt)   &
-                  &                        - 0.011_wp * ( t_bo_1d(ji) - rtt )  
+               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji) - rt0 )   &
+                  &                        - 0.011_wp * ( t_bo_1d(ji) - rt0 )  
                ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin )
             END DO
          ENDIF
-         !
-         !------------------------------------------------------------------------------|
-         !  5) kappa factors                                                            |
-         !------------------------------------------------------------------------------|
-         !
+         
+         !
+         !------------------------------------------------------------------------------|
+         !  5) G(he) - enhancement of thermal conductivity in mono-category case        |
+         !------------------------------------------------------------------------------|
+         !
+         ! Computation of effective thermal conductivity G(h)
+         ! Used in mono-category case only to simulate an ITD implicitly
+         ! Fichefet and Morales Maqueda, JGR 1997
+
+         zghe(:) = 1._wp
+
+         SELECT CASE ( nn_monocat )
+
+         CASE (1,3) ! LIM3
+
+            zepsilon = 0.1_wp
+            zh_thres = EXP( 1._wp ) * zepsilon * 0.5_wp
+
+            DO ji = kideb, kiut
+   
+               ! Mean sea ice thermal conductivity
+               zkimean  = SUM( ztcond_i(ji,0:nlay_i) ) / REAL( nlay_i+1, wp )
+
+               ! Effective thickness he (zhe)
+               zfac     = 1._wp / ( rcdsn + zkimean )
+               zratio_s = rcdsn   * zfac
+               zratio_i = zkimean * zfac
+               zhe      = zratio_s * ht_i_1d(ji) + zratio_i * ht_s_1d(ji)
+
+               ! G(he)
+               rswitch  = MAX( 0._wp , SIGN( 1._wp , zhe - zh_thres ) )  ! =0 if zhe < zh_thres, if >
+               zghe(ji) = ( 1._wp - rswitch ) + rswitch * 0.5_wp * ( 1._wp + LOG( 2._wp * zhe / zepsilon ) )
+   
+               ! Impose G(he) < 2.
+               zghe(ji) = MIN( zghe(ji), 2._wp )
+
+            END DO
+
+         END SELECT
+
+         !
+         !------------------------------------------------------------------------------|
+         !  6) kappa factors                                                            |
+         !------------------------------------------------------------------------------|
+         !
+         !--- Snow
          DO ji = kideb, kiut
-
-            !-- Snow kappa factors
-            zkappa_s(ji,0)         = rcdsn / MAX(epsi10,zh_s(ji))
-            zkappa_s(ji,nlay_s)    = rcdsn / MAX(epsi10,zh_s(ji))
+            zfac                  =  1. / MAX( epsi10 , zh_s(ji) )
+            zkappa_s(ji,0)        = zghe(ji) * rcdsn * zfac
+            zkappa_s(ji,nlay_s)   = zghe(ji) * rcdsn * zfac
          END DO
 
          DO jk = 1, nlay_s-1
             DO ji = kideb , kiut
-               zkappa_s(ji,jk)  = 2.0 * rcdsn / &
-                  MAX(epsi10,2.0*zh_s(ji))
-            END DO
-         END DO
-
+               zkappa_s(ji,jk)    = zghe(ji) * 2.0 * rcdsn / MAX( epsi10, 2.0 * zh_s(ji) )
+            END DO
+         END DO
+
+         !--- Ice
          DO jk = 1, nlay_i-1
             DO ji = kideb , kiut
-               !-- Ice kappa factors
-               zkappa_i(ji,jk)  = 2.0*ztcond_i(ji,jk)/ &
-                  MAX(epsi10,2.0*zh_i(ji)) 
-            END DO
-         END DO
-
-         DO ji = kideb , kiut
-            zkappa_i(ji,0)        = ztcond_i(ji,0)/MAX(epsi10,zh_i(ji))
-            zkappa_i(ji,nlay_i)   = ztcond_i(ji,nlay_i) / MAX(epsi10,zh_i(ji))
-            !-- Interface
-            zkappa_s(ji,nlay_s)   = 2.0*rcdsn*ztcond_i(ji,0)/MAX(epsi10, &
-               (ztcond_i(ji,0)*zh_s(ji) + rcdsn*zh_i(ji)))
-            zkappa_i(ji,0)        = zkappa_s(ji,nlay_s)*REAL( isnow(ji) ) &
-               + zkappa_i(ji,0)*REAL( 1 - isnow(ji) )
-         END DO
-         !
-         !------------------------------------------------------------------------------|
-         ! 6) Sea ice specific heat, eta factors                                        |
+               zkappa_i(ji,jk)    = zghe(ji) * 2.0 * ztcond_i(ji,jk) / MAX( epsi10 , 2.0 * zh_i(ji) )
+            END DO
+         END DO
+
+         !--- Snow-ice interface
+         DO ji = kideb , kiut
+            zfac                  = 1./ MAX( epsi10 , zh_i(ji) )
+            zkappa_i(ji,0)        = zghe(ji) * ztcond_i(ji,0) * zfac
+            zkappa_i(ji,nlay_i)   = zghe(ji) * ztcond_i(ji,nlay_i) * zfac
+            zkappa_s(ji,nlay_s)   = zghe(ji) * zghe(ji) * 2.0 * rcdsn * ztcond_i(ji,0) / & 
+           &                        MAX( epsi10, ( zghe(ji) * ztcond_i(ji,0) * zh_s(ji) + zghe(ji) * rcdsn * zh_i(ji) ) )
+            zkappa_i(ji,0)        = zkappa_s(ji,nlay_s) * isnow(ji) + zkappa_i(ji,0) * ( 1._wp - isnow(ji) )
+         END DO
+
+         !
+         !------------------------------------------------------------------------------|
+         ! 7) Sea ice specific heat, eta factors                                        |
          !------------------------------------------------------------------------------|
          !
@@ -387,8 +435,6 @@
             DO ji = kideb , kiut
                ztitemp(ji,jk)   = t_i_1d(ji,jk)
-               zspeche_i(ji,jk) = cpic + zgamma*s_i_1d(ji,jk)/ &
-                  MAX((t_i_1d(ji,jk)-rtt)*(ztib(ji,jk)-rtt),epsi10)
-               zeta_i(ji,jk)    = rdt_ice / MAX(rhoic*zspeche_i(ji,jk)*zh_i(ji), &
-                  epsi10)
+               zspeche_i(ji,jk) = cpic + zgamma * s_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztib(ji,jk) - rt0 ), epsi10 )
+               zeta_i(ji,jk)    = rdt_ice / MAX( rhoic * zspeche_i(ji,jk) * zh_i(ji), epsi10 )
             END DO
          END DO
@@ -397,13 +443,14 @@
             DO ji = kideb , kiut
                ztstemp(ji,jk) = t_s_1d(ji,jk)
-               zeta_s(ji,jk)  = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10)
-            END DO
-         END DO
-         !
-         !------------------------------------------------------------------------------|
-         ! 7) surface flux computation                                                  |
-         !------------------------------------------------------------------------------|
-         !
-         IF( .NOT. lk_cpl ) THEN   !--- forced atmosphere case
+               zeta_s(ji,jk)  = rdt_ice / MAX( rhosn * cpic * zh_s(ji), epsi10 )
+            END DO
+         END DO
+
+         !
+         !------------------------------------------------------------------------------|
+         ! 8) surface flux computation                                                  |
+         !------------------------------------------------------------------------------|
+         !
+         IF ( ln_it_qnsice ) THEN 
             DO ji = kideb , kiut
                ! update of the non solar flux according to the update in T_su
@@ -415,12 +462,11 @@
          DO ji = kideb , kiut
             ! update incoming flux
-            zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation
-               + qns_ice_1d(ji)                   ! non solar total flux 
-            ! (LWup, LWdw, SH, LH)
-         END DO
-
-         !
-         !------------------------------------------------------------------------------|
-         ! 8) tridiagonal system terms                                                  |
+            zf(ji)    =          zfsw(ji)              & ! net absorbed solar radiation
+               &         + qns_ice_1d(ji)                ! non solar total flux (LWup, LWdw, SH, LH)
+         END DO
+
+         !
+         !------------------------------------------------------------------------------|
+         ! 9) tridiagonal system terms                                                  |
          !------------------------------------------------------------------------------|
          !
@@ -437,6 +483,6 @@
                ztrid(ji,numeq,2) = 0.
                ztrid(ji,numeq,3) = 0.
-               zswiterm(ji,numeq)= 0.
-               zswitbis(ji,numeq)= 0.
+               zindterm(ji,numeq)= 0.
+               zindtbis(ji,numeq)= 0.
                zdiagbis(ji,numeq)= 0.
             ENDDO
@@ -445,11 +491,9 @@
          DO numeq = nlay_s + 2, nlay_s + nlay_i 
             DO ji = kideb , kiut
-               jk              = numeq - nlay_s - 1
-               ztrid(ji,numeq,1)  =  - zeta_i(ji,jk)*zkappa_i(ji,jk-1)
-               ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,jk)*(zkappa_i(ji,jk-1) + &
-                  zkappa_i(ji,jk))
-               ztrid(ji,numeq,3)  =  - zeta_i(ji,jk)*zkappa_i(ji,jk)
-               zswiterm(ji,numeq) =  ztib(ji,jk) + zeta_i(ji,jk)* &
-                  zradab_i(ji,jk)
+               jk                 = numeq - nlay_s - 1
+               ztrid(ji,numeq,1)  =  - zeta_i(ji,jk) * zkappa_i(ji,jk-1)
+               ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,jk) * ( zkappa_i(ji,jk-1) + zkappa_i(ji,jk) )
+               ztrid(ji,numeq,3)  =  - zeta_i(ji,jk) * zkappa_i(ji,jk)
+               zindterm(ji,numeq) =  ztib(ji,jk) + zeta_i(ji,jk) * zradab_i(ji,jk)
             END DO
          ENDDO
@@ -459,15 +503,13 @@
             !!ice bottom term
             ztrid(ji,numeq,1)  =  - zeta_i(ji,nlay_i)*zkappa_i(ji,nlay_i-1)   
-            ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,nlay_i)*( zkappa_i(ji,nlay_i)*zg1 &
-               +  zkappa_i(ji,nlay_i-1) )
+            ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i) * zg1 + zkappa_i(ji,nlay_i-1) )
             ztrid(ji,numeq,3)  =  0.0
-            zswiterm(ji,numeq) =  ztib(ji,nlay_i) + zeta_i(ji,nlay_i)* &
-               ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i)*zg1 &
-               *  t_bo_1d(ji) ) 
+            zindterm(ji,numeq) =  ztib(ji,nlay_i) + zeta_i(ji,nlay_i) *  &
+               &                  ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 *  t_bo_1d(ji) ) 
          ENDDO
 
 
          DO ji = kideb , kiut
-            IF ( ht_s_1d(ji).gt.0.0 ) THEN
+            IF ( ht_s_1d(ji) > 0.0 ) THEN
                !
                !------------------------------------------------------------------------------|
@@ -477,11 +519,9 @@
                !!snow interior terms (bottom equation has the same form as the others)
                DO numeq = 3, nlay_s + 1
-                  jk =  numeq - 1
-                  ztrid(ji,numeq,1)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk-1)
-                  ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,jk)*( zkappa_s(ji,jk-1) + &
-                     zkappa_s(ji,jk) )
+                  jk                  =  numeq - 1
+                  ztrid(ji,numeq,1)   =  - zeta_s(ji,jk) * zkappa_s(ji,jk-1)
+                  ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,jk) * ( zkappa_s(ji,jk-1) + zkappa_s(ji,jk) )
                   ztrid(ji,numeq,3)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk)
-                  zswiterm(ji,numeq)  =  ztsb(ji,jk) + zeta_s(ji,jk)* &
-                     zradab_s(ji,jk)
+                  zindterm(ji,numeq)  =  ztsb(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk)
                END DO
 
@@ -489,9 +529,8 @@
                IF ( nlay_i.eq.1 ) THEN
                   ztrid(ji,nlay_s+2,3)    =  0.0
-                  zswiterm(ji,nlay_s+2)   =  zswiterm(ji,nlay_s+2) + zkappa_i(ji,1)* &
-                     t_bo_1d(ji) 
+                  zindterm(ji,nlay_s+2)   =  zindterm(ji,nlay_s+2) + zkappa_i(ji,1) * t_bo_1d(ji) 
                ENDIF
 
-               IF ( t_su_1d(ji) .LT. rtt ) THEN
+               IF ( t_su_1d(ji) < rt0 ) THEN
 
                   !------------------------------------------------------------------------------|
@@ -503,14 +542,14 @@
 
                   !!surface equation
-                  ztrid(ji,1,1) = 0.0
-                  ztrid(ji,1,2) = dzf(ji) - zg1s*zkappa_s(ji,0)
-                  ztrid(ji,1,3) = zg1s*zkappa_s(ji,0)
-                  zswiterm(ji,1) = dzf(ji)*t_su_1d(ji)   - zf(ji)
+                  ztrid(ji,1,1)  = 0.0
+                  ztrid(ji,1,2)  = dzf(ji) - zg1s * zkappa_s(ji,0)
+                  ztrid(ji,1,3)  = zg1s * zkappa_s(ji,0)
+                  zindterm(ji,1) = dzf(ji) * t_su_1d(ji) - zf(ji)
 
                   !!first layer of snow equation
-                  ztrid(ji,2,1)  =  - zkappa_s(ji,0)*zg1s*zeta_s(ji,1)
-                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1)*(zkappa_s(ji,1) + zkappa_s(ji,0)*zg1s)
+                  ztrid(ji,2,1)  =  - zkappa_s(ji,0) * zg1s * zeta_s(ji,1)
+                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s )
                   ztrid(ji,2,3)  =  - zeta_s(ji,1)* zkappa_s(ji,1)
-                  zswiterm(ji,2) =  ztsb(ji,1) + zeta_s(ji,1)*zradab_s(ji,1)
+                  zindterm(ji,2) =  ztsb(ji,1) + zeta_s(ji,1) * zradab_s(ji,1)
 
                ELSE 
@@ -526,10 +565,8 @@
                   !!first layer of snow equation
                   ztrid(ji,2,1)  =  0.0
-                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + &
-                     zkappa_s(ji,0) * zg1s )
+                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s )
                   ztrid(ji,2,3)  =  - zeta_s(ji,1)*zkappa_s(ji,1) 
-                  zswiterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) *            &
-                     ( zradab_s(ji,1) +                         &
-                     zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 
+                  zindterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) *  &
+                     &             ( zradab_s(ji,1) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 
                ENDIF
             ELSE
@@ -539,5 +576,5 @@
                !------------------------------------------------------------------------------|
                !
-               IF (t_su_1d(ji) .LT. rtt) THEN
+               IF ( t_su_1d(ji) < rt0 ) THEN
                   !
                   !------------------------------------------------------------------------------|
@@ -553,26 +590,24 @@
                   ztrid(ji,numeqmin(ji),2)   =  dzf(ji) - zkappa_i(ji,0)*zg1    
                   ztrid(ji,numeqmin(ji),3)   =  zkappa_i(ji,0)*zg1
-                  zswiterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_1d(ji) - zf(ji)
+                  zindterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_1d(ji) - zf(ji)
 
                   !!first layer of ice equation
                   ztrid(ji,numeqmin(ji)+1,1) =  - zkappa_i(ji,0) * zg1 * zeta_i(ji,1)
-                  ztrid(ji,numeqmin(ji)+1,2) =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) & 
-                     + zkappa_i(ji,0) * zg1 )
-                  ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1)*zkappa_i(ji,1)  
-                  zswiterm(ji,numeqmin(ji)+1)=  ztib(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)  
+                  ztrid(ji,numeqmin(ji)+1,2) =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )
+                  ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1) * zkappa_i(ji,1)  
+                  zindterm(ji,numeqmin(ji)+1)=  ztib(ji,1) + zeta_i(ji,1) * zradab_i(ji,1)  
 
                   !!case of only one layer in the ice (surface & ice equations are altered)
 
-                  IF (nlay_i.eq.1) THEN
+                  IF ( nlay_i == 1 ) THEN
                      ztrid(ji,numeqmin(ji),1)    =  0.0
-                     ztrid(ji,numeqmin(ji),2)    =  dzf(ji) - zkappa_i(ji,0)*2.0
-                     ztrid(ji,numeqmin(ji),3)    =  zkappa_i(ji,0)*2.0
-                     ztrid(ji,numeqmin(ji)+1,1)  =  -zkappa_i(ji,0)*2.0*zeta_i(ji,1)
-                     ztrid(ji,numeqmin(ji)+1,2)  =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + &
-                        zkappa_i(ji,1))
+                     ztrid(ji,numeqmin(ji),2)    =  dzf(ji) - zkappa_i(ji,0) * 2.0
+                     ztrid(ji,numeqmin(ji),3)    =  zkappa_i(ji,0) * 2.0
+                     ztrid(ji,numeqmin(ji)+1,1)  =  -zkappa_i(ji,0) * 2.0 * zeta_i(ji,1)
+                     ztrid(ji,numeqmin(ji)+1,2)  =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) )
                      ztrid(ji,numeqmin(ji)+1,3)  =  0.0
 
-                     zswiterm(ji,numeqmin(ji)+1) =  ztib(ji,1) + zeta_i(ji,1)* &
-                        ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji) )
+                     zindterm(ji,numeqmin(ji)+1) =  ztib(ji,1) + zeta_i(ji,1) *  &
+                        &                          ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) )
                   ENDIF
 
@@ -590,19 +625,16 @@
                   !!first layer of ice equation
                   ztrid(ji,numeqmin(ji),1)      =  0.0
-                  ztrid(ji,numeqmin(ji),2)      =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,1) + zkappa_i(ji,0)* &
-                     zg1)  
+                  ztrid(ji,numeqmin(ji),2)      =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )  
                   ztrid(ji,numeqmin(ji),3)      =  - zeta_i(ji,1) * zkappa_i(ji,1)
-                  zswiterm(ji,numeqmin(ji))     =  ztib(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + &
-                     zkappa_i(ji,0) * zg1 * t_su_1d(ji) ) 
+                  zindterm(ji,numeqmin(ji))     =  ztib(ji,1) + zeta_i(ji,1) *  &
+                     &                             ( zradab_i(ji,1) + zkappa_i(ji,0) * zg1 * t_su_1d(ji) ) 
 
                   !!case of only one layer in the ice (surface & ice equations are altered)
-                  IF (nlay_i.eq.1) THEN
+                  IF ( nlay_i == 1 ) THEN
                      ztrid(ji,numeqmin(ji),1)  =  0.0
-                     ztrid(ji,numeqmin(ji),2)  =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + &
-                        zkappa_i(ji,1))
+                     ztrid(ji,numeqmin(ji),2)  =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) )
                      ztrid(ji,numeqmin(ji),3)  =  0.0
-                     zswiterm(ji,numeqmin(ji)) =  ztib(ji,1) + zeta_i(ji,1)* &
-                        (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji)) &
-                        + t_su_1d(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0
+                     zindterm(ji,numeqmin(ji)) =  ztib(ji,1) + zeta_i(ji,1) * ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) )  &
+                        &                       + t_su_1d(ji) * zeta_i(ji,1) * zkappa_i(ji,0) * 2.0
                   ENDIF
 
@@ -614,5 +646,5 @@
          !
          !------------------------------------------------------------------------------|
-         ! 9) tridiagonal system solving                                                |
+         ! 10) tridiagonal system solving                                               |
          !------------------------------------------------------------------------------|
          !
@@ -626,5 +658,5 @@
 
          DO ji = kideb , kiut
-            zswitbis(ji,numeqmin(ji)) =  zswiterm(ji,numeqmin(ji))
+            zindtbis(ji,numeqmin(ji)) =  zindterm(ji,numeqmin(ji))
             zdiagbis(ji,numeqmin(ji)) =  ztrid(ji,numeqmin(ji),2)
             minnumeqmin               =  MIN(numeqmin(ji),minnumeqmin)
@@ -635,8 +667,6 @@
             DO ji = kideb , kiut
                numeq               =  min(max(numeqmin(ji)+1,jk),numeqmax(ji))
-               zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2) - ztrid(ji,numeq,1)* &
-                  ztrid(ji,numeq-1,3)/zdiagbis(ji,numeq-1)
-               zswitbis(ji,numeq)  =  zswiterm(ji,numeq) - ztrid(ji,numeq,1)* &
-                  zswitbis(ji,numeq-1)/zdiagbis(ji,numeq-1)
+               zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2)  - ztrid(ji,numeq,1) * ztrid(ji,numeq-1,3)  / zdiagbis(ji,numeq-1)
+               zindtbis(ji,numeq)  =  zindterm(ji,numeq) - ztrid(ji,numeq,1) * zindtbis(ji,numeq-1) / zdiagbis(ji,numeq-1)
             END DO
          END DO
@@ -644,12 +674,11 @@
          DO ji = kideb , kiut
             ! ice temperatures
-            t_i_1d(ji,nlay_i)    =  zswitbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji))
-         END DO
-
-         DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1
+            t_i_1d(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji)) / zdiagbis(ji,numeqmax(ji))
+         END DO
+
+         DO numeq = nlay_i + nlay_s, nlay_s + 2, -1
             DO ji = kideb , kiut
                jk    =  numeq - nlay_s - 1
-               t_i_1d(ji,jk)  =  (zswitbis(ji,numeq) - ztrid(ji,numeq,3)* &
-                  t_i_1d(ji,jk+1))/zdiagbis(ji,numeq)
+               t_i_1d(ji,jk)  =  ( zindtbis(ji,numeq) - ztrid(ji,numeq,3) * t_i_1d(ji,jk+1) ) / zdiagbis(ji,numeq)
             END DO
          END DO
@@ -657,32 +686,31 @@
          DO ji = kideb , kiut
             ! snow temperatures      
-            IF (ht_s_1d(ji).GT.0._wp) &
-               t_s_1d(ji,nlay_s)     =  (zswitbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) &
-               *  t_i_1d(ji,1))/zdiagbis(ji,nlay_s+1) &
-               *        MAX(0.0,SIGN(1.0,ht_s_1d(ji))) 
+            IF (ht_s_1d(ji) > 0._wp) &
+               t_s_1d(ji,nlay_s)     =  ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) )  &
+               &                        / zdiagbis(ji,nlay_s+1) * MAX( 0.0, SIGN( 1.0, ht_s_1d(ji) ) ) 
 
             ! surface temperature
-            isnow(ji)     = NINT(  1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_1d(ji) )  )  )
+            isnow(ji)   = 1._wp - MAX( 0._wp , SIGN( 1._wp , -ht_s_1d(ji) ) )
             ztsubit(ji) = t_su_1d(ji)
-            IF( t_su_1d(ji) < ztfs(ji) ) &
-               t_su_1d(ji) = ( zswitbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_1d(ji,1)   &
-               &          + REAL( 1 - isnow(ji) )*t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))  
+            IF( t_su_1d(ji) < rt0 ) &
+               t_su_1d(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3) *  &
+               &             ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))  
          END DO
          !
          !--------------------------------------------------------------------------
-         !  10) Has the scheme converged ?, end of the iterative procedure         |
+         !  11) Has the scheme converged ?, end of the iterative procedure         |
          !--------------------------------------------------------------------------
          !
          ! check that nowhere it has started to melt
-         ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd
-         DO ji = kideb , kiut
-            t_su_1d(ji) =  MAX(  MIN( t_su_1d(ji) , ztfs(ji) ) , 190._wp  )
-            zerrit(ji) =  ABS( t_su_1d(ji) - ztsubit(ji) )     
+         ! zerrit(ji) is a measure of error, it has to be under terr_dif
+         DO ji = kideb , kiut
+            t_su_1d(ji) =  MAX(  MIN( t_su_1d(ji) , rt0 ) , 190._wp  )
+            zerrit(ji)  =  ABS( t_su_1d(ji) - ztsubit(ji) )     
          END DO
 
          DO jk  =  1, nlay_s
             DO ji = kideb , kiut
-               t_s_1d(ji,jk) = MAX(  MIN( t_s_1d(ji,jk), rtt ), 190._wp  )
-               zerrit(ji)      = MAX(zerrit(ji),ABS(t_s_1d(ji,jk) - ztstemp(ji,jk)))
+               t_s_1d(ji,jk) = MAX(  MIN( t_s_1d(ji,jk), rt0 ), 190._wp  )
+               zerrit(ji)    = MAX( zerrit(ji), ABS( t_s_1d(ji,jk) - ztstemp(ji,jk) ) )
             END DO
          END DO
@@ -690,7 +718,7 @@
          DO jk  =  1, nlay_i
             DO ji = kideb , kiut
-               ztmelt_i        = -tmut * s_i_1d(ji,jk) + rtt 
-               t_i_1d(ji,jk) =  MAX(MIN(t_i_1d(ji,jk),ztmelt_i), 190._wp)
-               zerrit(ji)      =  MAX(zerrit(ji),ABS(t_i_1d(ji,jk) - ztitemp(ji,jk)))
+               ztmelt_i      = -tmut * s_i_1d(ji,jk) + rt0 
+               t_i_1d(ji,jk) =  MAX( MIN( t_i_1d(ji,jk), ztmelt_i ), 190._wp )
+               zerrit(ji)    =  MAX( zerrit(ji), ABS( t_i_1d(ji,jk) - ztitemp(ji,jk) ) )
             END DO
          END DO
@@ -706,5 +734,5 @@
       END DO  ! End of the do while iterative procedure
 
-      IF( ln_nicep .AND. lwp ) THEN
+      IF( ln_icectl .AND. lwp ) THEN
          WRITE(numout,*) ' zerritmax : ', zerritmax
          WRITE(numout,*) ' nconv     : ', nconv
@@ -713,16 +741,39 @@
       !
       !-------------------------------------------------------------------------!
-      !   11) Fluxes at the interfaces                                          !
+      !   12) Fluxes at the interfaces                                          !
       !-------------------------------------------------------------------------!
       DO ji = kideb, kiut
-         ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux) 
-         IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_1d(ji) - ztsub(ji) ) )
          !                                ! surface ice conduction flux
-         isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) )  )
-         fc_su(ji)       =  -     REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji))   &
-            &               - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_1d(ji,1) - t_su_1d(ji))
+         isnow(ji)       = 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) )
+         fc_su(ji)       =  -           isnow(ji)   * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji))   &
+            &               - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_1d(ji,1) - t_su_1d(ji))
          !                                ! bottom ice conduction flux
          fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_1d(ji) - t_i_1d(ji,nlay_i)) )
       END DO
+
+      ! --- computes sea ice energy of melting compulsory for limthd_dh --- !
+      CALL lim_thd_enmelt( kideb, kiut )
+
+      ! --- diagnose the change in non-solar flux due to surface temperature change --- !
+      IF ( ln_it_qnsice ) THEN
+         DO ji = kideb, kiut
+            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji)  - zqns_ice_b(ji) ) * a_i_1d(ji) 
+         END DO
+      END IF
+
+      ! --- diag conservation imbalance on heat diffusion - PART 2 --- !
+      DO ji = kideb, kiut
+         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i +  &
+            &                              SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s )
+         IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC
+            zhfx_err(ji) = qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice 
+         ELSE                          ! case T_su = 0degC
+            zhfx_err(ji) = fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice 
+         ENDIF
+         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
+
+         ! total heat that is sent to the ocean (i.e. not used in the heat diffusion equation)
+         hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
+      END DO 
 
       !-----------------------------------------
@@ -730,55 +781,22 @@
       !-----------------------------------------
       DO ji = kideb, kiut
-         IF( t_su_1d(ji) < rtt ) THEN  ! case T_su < 0degC
+         IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC
             hfx_dif_1d(ji) = hfx_dif_1d(ji)  +   &
                &            ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji)
-         ELSE                         ! case T_su = 0degC
+         ELSE                          ! case T_su = 0degC
             hfx_dif_1d(ji) = hfx_dif_1d(ji) +    &
                &             ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji)
          ENDIF
-      END DO
-
-      ! --- computes sea ice energy of melting compulsory for limthd_dh --- !
-      CALL lim_thd_enmelt( kideb, kiut )
-
-      ! --- diag conservation imbalance on heat diffusion - PART 2 --- !
-      DO ji = kideb, kiut
-         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) +  &
-            &                              SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) )
-         zhfx_err(ji)   = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 
-         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
-      END DO 
-
-      ! diagnose external surface (forced case) or bottom (forced case) from heat conservation
-      IF( .NOT. lk_cpl ) THEN   ! --- forced case: qns_ice and fc_su are diagnosed
-         !
-         DO ji = kideb, kiut
-            qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji)
-            fc_su     (ji) = fc_su(ji)      - zhfx_err(ji)
-         END DO
-         !
-      ELSE                      ! --- coupled case: ocean turbulent heat flux is diagnosed
-         !
-         DO ji = kideb, kiut
-            fhtur_1d  (ji) = fhtur_1d(ji)   - zhfx_err(ji)
-         END DO
-         !
-      ENDIF
-
-      ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m2)
-      DO ji = kideb, kiut
-         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
-         hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_1d(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) )
-      END DO
-   
+         ! correction on the diagnosed heat flux due to non-convergence of the algorithm used to solve heat equation
+         hfx_dif_1d(ji) = hfx_dif_1d(ji) - zhfx_err(ji) * a_i_1d(ji)
+      END DO   
       !
-      CALL wrk_dealloc( jpij, numeqmin, numeqmax, isnow )
-      CALL wrk_dealloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw )
-      CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu )
-      CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i,   &
-         &              ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 )
-      CALL wrk_dealloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 )
-      CALL wrk_dealloc( jpij, nlay_i+3, zswiterm, zswitbis, zdiagbis )
-      CALL wrk_dealloc( jpij, nlay_i+3, 3, ztrid )
+      CALL wrk_dealloc( jpij, numeqmin, numeqmax )
+      CALL wrk_dealloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )
+      CALL wrk_dealloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe )
+      CALL wrk_dealloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 )
+      CALL wrk_dealloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 )
+      CALL wrk_dealloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis )
+      CALL wrk_dealloc( jpij,nlay_i+3,3, ztrid )
       CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err )
 
@@ -801,14 +819,15 @@
       DO jk = 1, nlay_i             ! Sea ice energy of melting
          DO ji = kideb, kiut
-            ztmelts      = - tmut  * s_i_1d(ji,jk) + rtt 
-            rswitch      = MAX( 0._wp , SIGN( 1._wp , -(t_i_1d(ji,jk) - rtt) - epsi10 ) )
-            q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) )                                             &
-               &                   + lfus * ( 1.0 - rswitch * ( ztmelts-rtt ) / MIN( t_i_1d(ji,jk)-rtt, -epsi10 ) )   &
-               &                   - rcp  *                 ( ztmelts-rtt )  ) 
+            ztmelts      = - tmut  * s_i_1d(ji,jk) + rt0
+            t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts ) ! Force t_i_1d to be lower than melting point
+                                                          !   (sometimes dif scheme produces abnormally high temperatures)   
+            q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) )                           &
+               &                    + lfus * ( 1.0 - ( ztmelts-rt0 ) / ( t_i_1d(ji,jk) - rt0 ) )   &
+               &                    - rcp  *         ( ztmelts-rt0 )  ) 
          END DO
       END DO
       DO jk = 1, nlay_s             ! Snow energy of melting
          DO ji = kideb, kiut
-            q_s_1d(ji,jk) = rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus )
+            q_s_1d(ji,jk) = rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus )
          END DO
       END DO
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90	(revision 5682)
@@ -25,5 +25,4 @@
    USE sbc_oce        ! Surface boundary condition: ocean fields
    USE ice            ! LIM variables
-   USE par_ice        ! LIM parameters
    USE thd_ice        ! LIM thermodynamics
    USE limvar         ! LIM variables
@@ -87,5 +86,5 @@
 
       !--------------------------------------------------------------------------
-      !  1) Cumulative integral of old enthalpy * thicnkess and layers interfaces
+      !  1) Cumulative integral of old enthalpy * thickness and layers interfaces
       !--------------------------------------------------------------------------
       zqh_cum0(:,0:nlay_i+2) = 0._wp 
@@ -103,5 +102,5 @@
       ! new layer thickesses
       DO ji = kideb, kiut
-         zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) / REAL( nlay_i )  
+         zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) * r1_nlay_i  
       ENDDO
 
@@ -133,6 +132,6 @@
       DO jk1 = 1, nlay_i
          DO ji = kideb, kiut
-            rswitch      = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zhnew(ji) + epsi10 ) ) 
-            qnew(ji,jk1) = rswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi10 )
+            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) ) 
+            qnew(ji,jk1) = rswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 )
          ENDDO
       ENDDO
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 5682)
@@ -22,5 +22,4 @@
    USE thd_ice        ! LIM thermodynamics
    USE dom_ice        ! LIM domain
-   USE par_ice        ! LIM parameters
    USE ice            ! LIM variables
    USE limtab         ! LIM 2D <==> 1D
@@ -32,4 +31,5 @@
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
    USE limthd_ent
+   USE limvar
 
    IMPLICIT NONE
@@ -106,5 +106,4 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_1d   ! 1-D version of a_i
       REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_1d   ! 1-D version of v_i
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_1d  ! 1-D version of oa_i
       REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i
 
@@ -112,4 +111,6 @@
 
       REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel                   ! relative ice / frazil velocity
+
+      REAL(wp) :: zcai = 1.4e-3_wp
       !!-----------------------------------------------------------------------!
 
@@ -117,8 +118,10 @@
       CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
       CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )
-      CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d )
-      CALL wrk_alloc( jpij,nlay_i+1,jpl, ze_i_1d )
+      CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )
+      CALL wrk_alloc( jpij,nlay_i,jpl, ze_i_1d )
       CALL wrk_alloc( jpi,jpj, zvrel )
 
+      CALL lim_var_agg(1)
+      CALL lim_var_glo2eqv
       !------------------------------------------------------------------------------|
       ! 2) Convert units for ice internal energy
@@ -129,8 +132,6 @@
                DO ji = 1, jpi
                   !Energy of melting q(S,T) [J.m-3]
-                  rswitch          = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 )  )   !0 if no ice and 1 if yes
-                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) &
-                      &   / ( area(ji,jj) * MAX( v_i(ji,jj,jl) ,  epsi10 ) ) * REAL( nlay_i, wp )
-                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac
+                  rswitch          = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  )   !0 if no ice
+                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl), epsi20 ) * REAL( nlay_i, wp )
                END DO
             END DO
@@ -155,7 +156,7 @@
 
       ! Default new ice thickness 
-      hicol(:,:) = hiccrit
-
-      IF( fraz_swi == 1 ) THEN
+      hicol(:,:) = rn_hnewice
+
+      IF( ln_frazil ) THEN
 
          !--------------------
@@ -166,5 +167,5 @@
          zhicrit = 0.04 ! frazil ice thickness
          ztwogp  = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav
-         zsqcd   = 1.0 / SQRT( 1.3 * cai ) ! 1/SQRT(airdensity*drag)
+         zsqcd   = 1.0 / SQRT( 1.3 * zcai ) ! 1/SQRT(airdensity*drag)
          zgamafr = 0.03
 
@@ -176,8 +177,8 @@
                   !-------------
                   ! C-grid wind stress components
-                  ztaux         = ( utau_ice(ji-1,jj  ) * tmu(ji-1,jj  )   &
-                     &          +   utau_ice(ji  ,jj  ) * tmu(ji  ,jj  ) ) * 0.5_wp
-                  ztauy         = ( vtau_ice(ji  ,jj-1) * tmv(ji  ,jj-1)   &
-                     &          +   vtau_ice(ji  ,jj  ) * tmv(ji  ,jj  ) ) * 0.5_wp
+                  ztaux         = ( utau_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)   &
+                     &          +   utau_ice(ji  ,jj  ) * umask(ji  ,jj  ,1) ) * 0.5_wp
+                  ztauy         = ( vtau_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)   &
+                     &          +   vtau_ice(ji  ,jj  ) * vmask(ji  ,jj  ,1) ) * 0.5_wp
                   ! Square root of wind stress
                   ztenagm       =  SQRT( SQRT( ztaux**2 + ztauy**2 ) )
@@ -195,6 +196,6 @@
                   ! C-grid ice velocity
                   rswitch = MAX(  0._wp, SIGN( 1._wp , at_i(ji,jj) )  )
-                  zvgx    = rswitch * ( u_ice(ji-1,jj  ) * tmu(ji-1,jj  )  + u_ice(ji,jj) * tmu(ji,jj) ) * 0.5_wp
-                  zvgy    = rswitch * ( v_ice(ji  ,jj-1) * tmv(ji  ,jj-1)  + v_ice(ji,jj) * tmv(ji,jj) ) * 0.5_wp
+                  zvgx    = rswitch * ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp
+                  zvgy    = rswitch * ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp
 
                   !-----------------------------------
@@ -222,5 +223,5 @@
                   iterate_frazil = .true.
 
-                  DO WHILE ( iter .LT. 100 .AND. iterate_frazil ) 
+                  DO WHILE ( iter < 100 .AND. iterate_frazil ) 
                      zf = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj)**2 - zhicrit**2 ) &
                         - hicol(ji,jj) * zhicrit * ztwogp * zvrel2
@@ -266,7 +267,7 @@
       ! debug point to follow
       jiindex_1d = 0
-      IF( ln_nicep ) THEN
-         DO ji = mi0(jiindx), mi1(jiindx)
-            DO jj = mj0(jjindx), mj1(jjindx)
+      IF( ln_icectl ) THEN
+         DO ji = mi0(iiceprt), mi1(iiceprt)
+            DO jj = mj0(jiceprt), mj1(jiceprt)
                IF ( qlead(ji,jj)  <  0._wp ) THEN
                   jiindex_1d = (jj - 1) * jpi + ji
@@ -276,5 +277,5 @@
       ENDIF
    
-      IF( ln_nicep ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac
+      IF( ln_icectl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac
 
       !------------------------------
@@ -290,10 +291,9 @@
             CALL tab_2d_1d( nbpac, za_i_1d  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) )
             CALL tab_2d_1d( nbpac, zv_i_1d  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) )
-            CALL tab_2d_1d( nbpac, zoa_i_1d (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) )
             CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) )
             DO jk = 1, nlay_i
                CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) )
-            END DO ! jk
-         END DO ! jl
+            END DO
+         END DO
 
          CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead  , jpi, jpj, npac(1:nbpac) )
@@ -320,19 +320,19 @@
          !----------------------
          DO ji = 1, nbpac
-            zh_newice(ji) = hiccrit
-         END DO
-         IF( fraz_swi == 1 ) zh_newice(1:nbpac) = hicol_1d(1:nbpac)
+            zh_newice(ji) = rn_hnewice
+         END DO
+         IF( ln_frazil ) zh_newice(1:nbpac) = hicol_1d(1:nbpac)
 
          !----------------------
          ! Salinity of new ice 
          !----------------------
-         SELECT CASE ( num_sal )
+         SELECT CASE ( nn_icesal )
          CASE ( 1 )                    ! Sice = constant 
-            zs_newice(1:nbpac) = bulk_sal
+            zs_newice(1:nbpac) = rn_icesal
          CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)]
             DO ji = 1, nbpac
                ii =   MOD( npac(ji) - 1 , jpi ) + 1
                ij =      ( npac(ji) - 1 ) / jpi + 1
-               zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , s_i_max , 0.5 * sss_m(ii,ij)  )
+               zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , rn_simax , 0.5 * sss_m(ii,ij)  )
             END DO
          CASE ( 3 )                    ! Sice = F(z) [multiyear ice]
@@ -345,9 +345,9 @@
          ! We assume that new ice is formed at the seawater freezing point
          DO ji = 1, nbpac
-            ztmelts       = - tmut * zs_newice(ji) + rtt                  ! Melting point (K)
+            ztmelts       = - tmut * zs_newice(ji) + rt0                  ! Melting point (K)
             ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_1d(ji) )                             &
-               &                       + lfus * ( 1.0 - ( ztmelts - rtt ) / MIN( t_bo_1d(ji) - rtt, -epsi10 ) )   &
-               &                       - rcp  *         ( ztmelts - rtt )  )
-         END DO ! ji
+               &                       + lfus * ( 1.0 - ( ztmelts - rt0 ) / MIN( t_bo_1d(ji) - rt0, -epsi10 ) )   &
+               &                       - rcp  *         ( ztmelts - rt0 )  )
+         END DO
 
          !----------------
@@ -356,5 +356,5 @@
          DO ji = 1, nbpac
             zo_newice(ji) = 0._wp
-         END DO ! ji
+         END DO
 
          !-------------------
@@ -363,7 +363,7 @@
          DO ji = 1, nbpac
 
-            zEi           = - ze_newice(ji) / rhoic                ! specific enthalpy of forming ice [J/kg]
-
-            zEw           = rcp * ( t_bo_1d(ji) - rt0 )             ! specific enthalpy of seawater at t_bo_1d [J/kg]
+            zEi           = - ze_newice(ji) * r1_rhoic             ! specific enthalpy of forming ice [J/kg]
+
+            zEw           = rcp * ( t_bo_1d(ji) - rt0 )            ! specific enthalpy of seawater at t_bo_1d [J/kg]
                                                                    ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied) 
                                                                    
@@ -372,5 +372,5 @@
             zfmdt         = - qlead_1d(ji) / zdE                   ! Fm.dt [kg/m2] (<0) 
                                                                    ! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point   
-            zv_newice(ji) = - zfmdt / rhoic
+            zv_newice(ji) = - zfmdt * r1_rhoic
 
             zQm           = zfmdt * zEw                            ! heat to the ocean >0 associated with mass flux  
@@ -387,5 +387,5 @@
             ! A fraction zfrazb of frazil ice is accreted at the ice bottom
             rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) )
-            zfrazb        = rswitch * ( TANH ( Cfrazb * ( zvrel_1d(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb
+            zfrazb        = rswitch * ( TANH ( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb
             zv_frazb(ji)  =         zfrazb   * zv_newice(ji)
             zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji)
@@ -409,6 +409,6 @@
          ! we keep the excessive volume in memory and attribute it later to bottom accretion
          DO ji = 1, nbpac
-            IF ( za_newice(ji) >  ( amax - zat_i_1d(ji) ) ) THEN
-               zda_res(ji)   = za_newice(ji) - ( amax - zat_i_1d(ji) )
+            IF ( za_newice(ji) >  ( rn_amax - zat_i_1d(ji) ) ) THEN
+               zda_res(ji)   = za_newice(ji) - ( rn_amax - zat_i_1d(ji) )
                zdv_res(ji)   = zda_res  (ji) * zh_newice(ji) 
                za_newice(ji) = za_newice(ji) - zda_res  (ji)
@@ -459,5 +459,5 @@
             DO jk = 1, nlay_i
                DO ji = 1, nbpac
-                  h_i_old (ji,jk) = zv_i_1d(ji,jl) / REAL( nlay_i )
+                  h_i_old (ji,jk) = zv_i_1d(ji,jl) * r1_nlay_i
                   qh_i_old(ji,jk) = ze_i_1d(ji,jk,jl) * h_i_old(ji,jk)
                END DO
@@ -478,14 +478,4 @@
          ENDDO
 
-         !------------
-         ! Update age 
-         !------------
-         DO jl = 1, jpl
-            DO ji = 1, nbpac
-               rswitch          = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_1d(ji,jl) + epsi20 ) )  ! 0 if no ice and 1 if yes
-               zoa_i_1d(ji,jl)  = za_b(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * rswitch   
-            END DO 
-         END DO   
-
          !-----------------
          ! Update salinity
@@ -504,5 +494,4 @@
             CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj )
             CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj )
-            CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_1d(1:nbpac,jl), jpi, jpj )
             CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj )
             DO jk = 1, nlay_i
@@ -525,6 +514,6 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  ! heat content in Joules
-                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ,wp ) * unit_fac ) 
+                  ! heat content in J/m2
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 
                END DO
             END DO
@@ -536,6 +525,6 @@
       CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
       CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )
-      CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d )
-      CALL wrk_dealloc( jpij,nlay_i+1,jpl, ze_i_1d )
+      CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )
+      CALL wrk_dealloc( jpij,nlay_i,jpl, ze_i_1d )
       CALL wrk_dealloc( jpi,jpj, zvrel )
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90	(revision 5682)
@@ -18,5 +18,4 @@
    USE sbc_oce        ! Surface boundary condition: ocean fields
    USE ice            ! LIM variables
-   USE par_ice        ! LIM parameters
    USE thd_ice        ! LIM thermodynamics
    USE limvar         ! LIM variables
@@ -30,5 +29,5 @@
 
    PUBLIC   lim_thd_sal        ! called by limthd module
-   PUBLIC   lim_thd_sal_init   ! called by iceini module
+   PUBLIC   lim_thd_sal_init   ! called by sbc_lim_init
 
    !!----------------------------------------------------------------------
@@ -46,7 +45,7 @@
       !!
       !! ** Method  :  3 possibilities
-      !!               -> num_sal = 1 -> Sice = cst    [ice salinity constant in both time & space] 
-      !!               -> num_sal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005]
-      !!               -> num_sal = 3 -> Sice = S(z)   [multiyear ice]
+      !!               -> nn_icesal = 1 -> Sice = cst    [ice salinity constant in both time & space] 
+      !!               -> nn_icesal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005]
+      !!               -> nn_icesal = 3 -> Sice = S(z)   [multiyear ice]
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kideb, kiut   ! thickness category index
@@ -66,10 +65,10 @@
       ! 1) Constant salinity, constant in time                                       |
       !------------------------------------------------------------------------------|
-!!gm comment: if num_sal = 1 s_i_new, s_i_1d and sm_i_1d can be set to bulk_sal one for all in the initialisation phase !!
-!!gm           ===>>>   simplification of almost all test on num_sal value
-      IF(  num_sal == 1  ) THEN
-            s_i_1d (kideb:kiut,1:nlay_i) =  bulk_sal
-            sm_i_1d(kideb:kiut)          =  bulk_sal 
-            s_i_new(kideb:kiut)          =  bulk_sal
+!!gm comment: if nn_icesal = 1 s_i_new, s_i_1d and sm_i_1d can be set to rn_icesal one for all in the initialisation phase !!
+!!gm           ===>>>   simplification of almost all test on nn_icesal value
+      IF(  nn_icesal == 1  ) THEN
+            s_i_1d (kideb:kiut,1:nlay_i) =  rn_icesal
+            sm_i_1d(kideb:kiut)          =  rn_icesal 
+            s_i_new(kideb:kiut)          =  rn_icesal
       ENDIF
 
@@ -77,5 +76,5 @@
       !  Module 2 : Constant salinity varying in time                                |
       !------------------------------------------------------------------------------|
-      IF(  num_sal == 2  ) THEN
+      IF(  nn_icesal == 2  ) THEN
 
          DO ji = kideb, kiut
@@ -83,5 +82,5 @@
             ! Switches 
             !----------
-            iflush  = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rtt )        )     ! =1 if summer 
+            iflush  = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0 )        )     ! =1 if summer 
             igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )    ! =1 if t_su < t_bo
 
@@ -90,7 +89,7 @@
             !---------------------
             ! drainage by gravity drainage
-            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - sal_G , 0._wp ) / time_G * rdt_ice 
+            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice 
             ! drainage by flushing  
-            dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_1d(ji) - sal_F , 0._wp ) / time_F * rdt_ice
+            dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice
 
             !-----------------
@@ -116,5 +115,5 @@
       !  Module 3 : Profile of salinity, constant in time                            |
       !------------------------------------------------------------------------------|
-      IF(  num_sal == 3  )   CALL lim_var_salprof1d( kideb, kiut )
+      IF(  nn_icesal == 3  )   CALL lim_var_salprof1d( kideb, kiut )
 
       !
@@ -134,6 +133,6 @@
       !!-------------------------------------------------------------------
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namicesal/ num_sal, bulk_sal, sal_G, time_G, sal_F, time_F,   &
-         &                s_i_max, s_i_min, s_i_0, s_i_1
+      NAMELIST/namicesal/ nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd, rn_sal_fl, rn_time_fl,   &
+         &                rn_simax, rn_simin 
       !!-------------------------------------------------------------------
       !
@@ -151,14 +150,12 @@
          WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity '
          WRITE(numout,*) '~~~~~~~~~~~~~~~~'
-         WRITE(numout,*) ' switch for salinity num_sal        : ', num_sal
-         WRITE(numout,*) ' bulk salinity value if num_sal = 1 : ', bulk_sal
-         WRITE(numout,*) ' restoring salinity for GD          : ', sal_G
-         WRITE(numout,*) ' restoring time for GD              : ', time_G
-         WRITE(numout,*) ' restoring salinity for flushing    : ', sal_F
-         WRITE(numout,*) ' restoring time for flushing        : ', time_F
-         WRITE(numout,*) ' Maximum tolerated ice salinity     : ', s_i_max
-         WRITE(numout,*) ' Minimum tolerated ice salinity     : ', s_i_min
-         WRITE(numout,*) ' 1st salinity for salinity profile  : ', s_i_0
-         WRITE(numout,*) ' 2nd salinity for salinity profile  : ', s_i_1
+         WRITE(numout,*) '   switch for salinity nn_icesal        = ', nn_icesal
+         WRITE(numout,*) '   bulk salinity value if nn_icesal = 1 = ', rn_icesal
+         WRITE(numout,*) '   restoring salinity for GD            = ', rn_sal_gd
+         WRITE(numout,*) '   restoring time for GD                = ', rn_time_gd
+         WRITE(numout,*) '   restoring salinity for flushing      = ', rn_sal_fl
+         WRITE(numout,*) '   restoring time for flushing          = ', rn_time_fl
+         WRITE(numout,*) '   Maximum tolerated ice salinity       = ', rn_simax
+         WRITE(numout,*) '   Minimum tolerated ice salinity       = ', rn_simin
       ENDIF
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 5682)
@@ -17,9 +17,10 @@
    USE dom_oce        ! ocean domain
    USE sbc_oce        ! ocean surface boundary condition
-   USE par_ice        ! ice parameter
    USE dom_ice        ! ice domain
    USE ice            ! ice variables
    USE limadv         ! ice advection
    USE limhdf         ! ice horizontal diffusion
+   USE limvar         ! 
+   !
    USE in_out_manager ! I/O manager
    USE lbclnk         ! lateral boundary conditions -- MPP exchanges
@@ -28,12 +29,14 @@
    USE prtctl         ! Print control
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE limvar          ! clem for ice thickness correction
-   USE timing          ! Timing
+   USE timing         ! Timing
    USE limcons        ! conservation tests
+   USE limctl         ! control prints
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_trp    ! called by ice_step
+   PUBLIC   lim_trp    ! called by sbcice_lim
+
+   INTEGER  ::   ncfl                 ! number of ice time step with CFL>1/2  
 
    !! * Substitution
@@ -58,27 +61,28 @@
       !! ** action :
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! number of iteration
+      INTEGER, INTENT(in) ::   kt           ! number of iteration
       !
-      INTEGER  ::   ji, jj, jk, jl, jn      ! dummy loop indices
+      INTEGER  ::   ji, jj, jk, jl, jt      ! dummy loop indices
       INTEGER  ::   initad                  ! number of sub-timestep for the advection
       REAL(wp) ::   zcfl , zusnit           !   -      -
+      CHARACTER(len=80) ::   cltmp
       !
-      REAL(wp), POINTER, DIMENSION(:,:)      ::   zui_u, zvi_v, zsm, zs0at, zs0ow
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi
-      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   zs0e
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zviold, zvsold   ! old ice volume...
-      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zaiold, zhimax   ! old ice concentration and thickness
-      REAL(wp), POINTER, DIMENSION(:,:)      ::   zeiold, zesold   ! old enthalpies
-      REAL(wp) :: zdv, zda, zvi, zvs, zsmv, zes, zei
-      !
-      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
+      REAL(wp), POINTER, DIMENSION(:,:)      ::   zsm
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z0ice, z0snw, z0ai, z0es , z0smi , z0oi
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z0opw
+      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   z0ei
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zviold, zvsold, zsmvold  ! old ice volume...
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhimax                   ! old ice thickness
+      REAL(wp), POINTER, DIMENSION(:,:)      ::   zatold, zeiold, zesold   ! old concentration, enthalpies
+      REAL(wp) ::    zdv, zvi, zvs, zsmv, zes, zei
+      REAL(wp) ::    zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
       !!---------------------------------------------------------------------
       IF( nn_timing == 1 )  CALL timing_start('limtrp')
 
-      CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold )
-      CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi )
-      CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, zs0e )
-
-      CALL wrk_alloc( jpi, jpj, jpl, zaiold, zhimax, zviold, zvsold )   ! clem
+      CALL wrk_alloc( jpi,jpj,            zsm, zatold, zeiold, zesold )
+      CALL wrk_alloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi )
+      CALL wrk_alloc( jpi,jpj,1,          z0opw )
+      CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei )
+      CALL wrk_alloc( jpi,jpj,jpl,        zhimax, zviold, zvsold, zsmvold )
 
       IF( numit == nstart .AND. lwp ) THEN
@@ -88,8 +92,9 @@
          ENDIF
          WRITE(numout,*) '~~~~~~~~~~~~'
+         ncfl = 0                ! nb of time step with CFL > 1/2
       ENDIF
+
+      zsm(:,:) = e12t(:,:)
       
-      zsm(:,:) = area(:,:)
-
       !                             !-------------------------------------!
       IF( ln_limdyn ) THEN          !   Advection of sea ice properties   !
@@ -97,27 +102,33 @@
 
          ! conservation test
-         IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
-         ! mass and salt flux init (clem)
+         IF( ln_limdiahsb )   CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+         ! mass and salt flux init
          zviold(:,:,:)  = v_i(:,:,:)
-         zeiold(:,:)  = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) 
-         zesold(:,:)  = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) 
-
-         !--- Thickness correction init. (clem) -------------------------------
-         CALL lim_var_glo2eqv
-         zaiold(:,:,:) = a_i(:,:,:)
+         zvsold(:,:,:)  = v_s(:,:,:)
+         zsmvold(:,:,:) = smv_i(:,:,:)
+         zeiold(:,:)    = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) 
+         zesold(:,:)    = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) 
+
+         !--- Thickness correction init. -------------------------------
+         zatold(:,:) = SUM( a_i(:,:,:), dim=3 )
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )
+                  ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+                  ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+               END DO
+            END DO
+         END DO
          !---------------------------------------------------------------------
-         ! Record max of the surrounding ice thicknesses for correction in limupdate
+         ! Record max of the surrounding ice thicknesses for correction
          ! in case advection creates ice too thick.
          !---------------------------------------------------------------------
-         zhimax(:,:,:) = ht_i(:,:,:)
+         zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:)
          DO jl = 1, jpl
             DO jj = 2, jpjm1
                DO ji = 2, jpim1
-                  zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) )
-                  !zhimax(ji,jj,jl) = ( ht_i(ji  ,jj  ,jl) * tmask(ji,  jj  ,1) + ht_i(ji-1,jj-1,jl) * tmask(ji-1,jj-1,1) + ht_i(ji+1,jj+1,jl) * tmask(ji+1,jj+1,1) &
-                  !     &             + ht_i(ji-1,jj  ,jl) * tmask(ji-1,jj  ,1) + ht_i(ji  ,jj-1,jl) * tmask(ji  ,jj-1,1) &
-                  !     &             + ht_i(ji+1,jj  ,jl) * tmask(ji+1,jj  ,1) + ht_i(ji  ,jj+1,jl) * tmask(ji  ,jj+1,1) &
-                  !     &             + ht_i(ji-1,jj+1,jl) * tmask(ji-1,jj+1,1) + ht_i(ji+1,jj-1,jl) * tmask(ji+1,jj-1,1) )
+                  zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) + ht_s(ji-1:ji+1,jj-1:jj+1,jl) )
                END DO
             END DO
@@ -125,74 +136,80 @@
          END DO
          
+         !=============================!
+         !==      Prather scheme     ==!
+         !=============================!
+
+         ! If ice drift field is too fast, use an appropriate time step for advection.         
+         zcfl  =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) )         ! CFL test for stability
+         zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) )
+         IF(lk_mpp )   CALL mpp_max( zcfl )
+
+         IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp
+         ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp
+         ENDIF
+
+         IF( zcfl > 0.5_wp .AND. lwp )   ncfl = ncfl + 1
+!!         IF( lwp ) THEN
+!!            IF( ncfl > 0 ) THEN   
+!!               WRITE(cltmp,'(i6.1)') ncfl
+!!               CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ')
+!!            ELSE
+!!            !  WRITE(numout,*) 'lim_trp : CFL criterion for ice advection is always smaller than 1/2 '
+!!            ENDIF
+!!         ENDIF
+
          !-------------------------
          ! transported fields                                        
          !-------------------------
-         ! Snow vol, ice vol, salt and age contents, area
-         zs0ow(:,:) = ato_i(:,:) * area(:,:)               ! Open water area 
-         DO jl = 1, jpl
-            zs0sn (:,:,jl)   = v_s  (:,:,jl) * area(:,:)    ! Snow volume
-            zs0ice(:,:,jl)   = v_i  (:,:,jl) * area(:,:)    ! Ice  volume
-            zs0a  (:,:,jl)   = a_i  (:,:,jl) * area(:,:)    ! Ice area
-            zs0sm (:,:,jl)   = smv_i(:,:,jl) * area(:,:)    ! Salt content
-            zs0oi (:,:,jl)   = oa_i (:,:,jl) * area(:,:)    ! Age content
-            zs0c0 (:,:,jl)   = e_s  (:,:,1,jl)              ! Snow heat content
-            zs0e  (:,:,:,jl) = e_i  (:,:,:,jl)              ! Ice  heat content
-         END DO
-
-         !--------------------------
-         ! Advection of Ice fields  (Prather scheme)                                            
-         !--------------------------
-         ! If ice drift field is too fast, use an appropriate time step for advection.         
-         ! CFL test for stability
-         zcfl  =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice / e1u(:,:) )
-         zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice / e2v(:,:) ) )
-         IF(lk_mpp )   CALL mpp_max( zcfl )
-!!gm more readability:
-!         IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp
-!         ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp
-!         ENDIF
-!!gm end
-         initad = 1 + NINT( MAX( 0._wp, SIGN( 1._wp, zcfl-0.5 ) ) )
-         zusnit = 1.0 / REAL( initad ) 
-         IF( zcfl > 0.5 .AND. lwp )   &
-            WRITE(numout,*) 'lim_trp   : CFL violation at day ', nday, ', cfl = ', zcfl,   &
-               &                        ': the ice time stepping is split in two'
+         z0opw(:,:,1) = ato_i(:,:) * e12t(:,:)             ! Open water area 
+         DO jl = 1, jpl
+            z0snw (:,:,jl)  = v_s  (:,:,jl) * e12t(:,:)    ! Snow volume
+            z0ice(:,:,jl)   = v_i  (:,:,jl) * e12t(:,:)    ! Ice  volume
+            z0ai  (:,:,jl)  = a_i  (:,:,jl) * e12t(:,:)    ! Ice area
+            z0smi (:,:,jl)  = smv_i(:,:,jl) * e12t(:,:)    ! Salt content
+            z0oi (:,:,jl)   = oa_i (:,:,jl) * e12t(:,:)    ! Age content
+            z0es (:,:,jl)   = e_s  (:,:,1,jl) * e12t(:,:)  ! Snow heat content
+            DO jk = 1, nlay_i
+               z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e12t(:,:) ! Ice  heat content
+            END DO
+         END DO
+
 
          IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==!
-            DO jn = 1,initad
-               CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area
-                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
-               CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:),   &
-                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+            DO jt = 1, initad
+               CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area
+                  &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+               CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0opw (:,:,1), sxopw(:,:),   &
+                  &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
                DO jl = 1, jpl
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
                      &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &
                      &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
                      &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &
                      &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
                      &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &
                      &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---     
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &    !--- ice age      ---     
                      &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &
                      &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations ---
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &    !--- ice concentrations ---
                      &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   & 
                      &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents ---
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0es  (:,:,jl), sxc0 (:,:,jl),   &    !--- snow heat contents ---
                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0es  (:,:,jl), sxc0 (:,:,jl),   &
                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
-                  DO jk = 1, nlay_i                                                           !--- ice heat contents ---
-                     CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                  DO jk = 1, nlay_i                                                                !--- ice heat contents ---
+                     CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
                         &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
                         &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) )
-                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
                         &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
                         &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) )
@@ -201,40 +218,39 @@
             END DO
          ELSE
-            DO jn = 1, initad
-               CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area
-                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
-               CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:),   &
-                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+            DO jt = 1, initad
+               CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area
+                  &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+               CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0opw (:,:,1), sxopw(:,:),   &
+                  &                                       sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
                DO jl = 1, jpl
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
                      &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl),   &
                      &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
                      &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl),   &
                      &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
                      &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl),   &
                      &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
-
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---
                      &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0oi  (:,:,jl), sxage(:,:,jl),   &
                      &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations ---
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations ---
                      &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ai  (:,:,jl), sxa  (:,:,jl),   &
                      &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
-                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents ---
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0es  (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents ---
                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
-                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0es  (:,:,jl), sxc0 (:,:,jl),   &
                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
                   DO jk = 1, nlay_i                                                           !--- ice heat contents ---
-                     CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                     CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
                         &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
                         &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) )
-                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
                         &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
                         &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) )
@@ -247,37 +263,41 @@
          ! Recover the properties from their contents
          !-------------------------------------------
-         zs0ow(:,:) = zs0ow(:,:) / area(:,:)
-         DO jl = 1, jpl
-            zs0ice(:,:,jl) = zs0ice(:,:,jl) / area(:,:)
-            zs0sn (:,:,jl) = zs0sn (:,:,jl) / area(:,:)
-            zs0sm (:,:,jl) = zs0sm (:,:,jl) / area(:,:)
-            zs0oi (:,:,jl) = zs0oi (:,:,jl) / area(:,:)
-            zs0a  (:,:,jl) = zs0a  (:,:,jl) / area(:,:)
-            !
+         ato_i(:,:) = z0opw(:,:,1) * r1_e12t(:,:)
+         DO jl = 1, jpl
+            v_i  (:,:,jl)   = z0ice(:,:,jl) * r1_e12t(:,:)
+            v_s  (:,:,jl)   = z0snw(:,:,jl) * r1_e12t(:,:)
+            smv_i(:,:,jl)   = z0smi(:,:,jl) * r1_e12t(:,:)
+            oa_i (:,:,jl)   = z0oi (:,:,jl) * r1_e12t(:,:)
+            a_i  (:,:,jl)   = z0ai (:,:,jl) * r1_e12t(:,:)
+            e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e12t(:,:)
+            DO jk = 1, nlay_i
+               e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e12t(:,:)
+            END DO
+         END DO
+
+         at_i(:,:) = a_i(:,:,1)      ! total ice fraction
+         DO jl = 2, jpl
+            at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
          END DO
 
          !------------------------------------------------------------------------------!
-         ! 4) Diffusion of Ice fields                  
+         ! Diffusion of Ice fields                  
          !------------------------------------------------------------------------------!
 
+         !
          !--------------------------------
          !  diffusion of open water area
          !--------------------------------
-         zs0at(:,:) = zs0a(:,:,1)      ! total ice fraction
-         DO jl = 2, jpl
-            zs0at(:,:) = zs0at(:,:) + zs0a(:,:,jl)
-         END DO
-         !
          !                             ! Masked eddy diffusivity coefficient at ocean U- and V-points
          DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row
             DO ji = 1 , fs_jpim1   ! vector opt.
-               pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji  ,jj) ) ) )   &
-                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj)
-               pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji,jj  ) ) ) )   &
-                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj)
+               pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji  ,jj) ) ) )   &
+                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj)
+               pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj  ) ) ) )   &
+                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj)
             END DO
          END DO
          !
-         CALL lim_hdf( zs0ow (:,:) )   ! Diffusion
+         CALL lim_hdf( ato_i (:,:) )
 
          !------------------------------------
@@ -288,93 +308,64 @@
             DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row
                DO ji = 1 , fs_jpim1   ! vector opt.
-                  pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji  ,jj,jl) ) ) )   &
-                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)
-                  pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji,jj  ,jl) ) ) )   &
-                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)
-               END DO
-            END DO
-
-            CALL lim_hdf( zs0ice (:,:,jl) )
-            CALL lim_hdf( zs0sn  (:,:,jl) )
-            CALL lim_hdf( zs0sm  (:,:,jl) )
-            CALL lim_hdf( zs0oi  (:,:,jl) )
-            CALL lim_hdf( zs0a   (:,:,jl) )
-            CALL lim_hdf( zs0c0  (:,:,jl) )
+                  pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji  ,jj,jl) ) ) )   &
+                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)
+                  pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj  ,jl) ) ) )   &
+                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)
+               END DO
+            END DO
+
+            CALL lim_hdf( v_i  (:,:,  jl) )
+            CALL lim_hdf( v_s  (:,:,  jl) )
+            CALL lim_hdf( smv_i(:,:,  jl) )
+            CALL lim_hdf( oa_i (:,:,  jl) )
+            CALL lim_hdf( a_i  (:,:,  jl) )
+            CALL lim_hdf( e_s  (:,:,1,jl) )
             DO jk = 1, nlay_i
-               CALL lim_hdf( zs0e (:,:,jk,jl) )
+               CALL lim_hdf( e_i(:,:,jk,jl) )
             END DO
          END DO
 
          !------------------------------------------------------------------------------!
-         ! 5) Update and limit ice properties after transport                           
+         ! limit ice properties after transport                           
          !------------------------------------------------------------------------------!
-
-         !--------------------------------------------------
-         ! 5.1) Recover mean values over the grid squares.
-         !--------------------------------------------------
-         zs0at(:,:) = 0._wp
+!!gm & cr   :  MAX should not be active if adv scheme is positive !
          DO jl = 1, jpl
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zs0sn (ji,jj,jl) = MAX( 0._wp, zs0sn (ji,jj,jl) )
-                  zs0ice(ji,jj,jl) = MAX( 0._wp, zs0ice(ji,jj,jl) )
-                  zs0sm (ji,jj,jl) = MAX( 0._wp, zs0sm (ji,jj,jl) )
-                  zs0oi (ji,jj,jl) = MAX( 0._wp, zs0oi (ji,jj,jl) )
-                  zs0a  (ji,jj,jl) = MAX( 0._wp, zs0a  (ji,jj,jl) )
-                  zs0c0 (ji,jj,jl) = MAX( 0._wp, zs0c0 (ji,jj,jl) )
-                  zs0at (ji,jj)    = zs0at(ji,jj) + zs0a(ji,jj,jl)
-               END DO
-            END DO
-         END DO
-
-         !---------------------------------------------------------
-         ! 5.2) Update and mask variables
-         !---------------------------------------------------------
-         DO jl = 1, jpl          
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  rswitch = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) )
-
-                  zvi  = zs0ice(ji,jj,jl)
-                  zvs  = zs0sn (ji,jj,jl)
-                  zes  = zs0c0 (ji,jj,jl)      
-                  zsmv = zs0sm (ji,jj,jl)
-                  !
-                  ! Remove very small areas
-                  v_s(ji,jj,jl)   = rswitch * zs0sn (ji,jj,jl) 
-                  v_i(ji,jj,jl)   = rswitch * zs0ice(ji,jj,jl)
-                  a_i(ji,jj,jl)   = rswitch * zs0a  (ji,jj,jl)
-                  e_s(ji,jj,1,jl) = rswitch * zs0c0 (ji,jj,jl)      
-                  ! Ice salinity and age
-                  IF(  num_sal == 2  ) THEN
-                     smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) )
-                  ENDIF
-                  oa_i(ji,jj,jl) = MAX( rswitch * zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ), 0._wp ) * a_i(ji,jj,jl)
-
-                 ! Update fluxes
-                  wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 
-                  wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice
-                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 
-                  hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
-              END DO
-            END DO
-         END DO
-
-         DO jl = 1, jpl
+                  v_s  (ji,jj,jl)   = MAX( 0._wp, v_s  (ji,jj,jl) )
+                  v_i  (ji,jj,jl)   = MAX( 0._wp, v_i  (ji,jj,jl) )
+                  smv_i(ji,jj,jl)   = MAX( 0._wp, smv_i(ji,jj,jl) )
+                  oa_i (ji,jj,jl)   = MAX( 0._wp, oa_i (ji,jj,jl) )
+                  a_i  (ji,jj,jl)   = MAX( 0._wp, a_i  (ji,jj,jl) )
+                  e_s  (ji,jj,1,jl) = MAX( 0._wp, e_s  (ji,jj,1,jl) )
+               END DO
+            END DO
+
             DO jk = 1, nlay_i
                DO jj = 1, jpj
                   DO ji = 1, jpi
-                     rswitch          = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) )
-                     zei              = zs0e(ji,jj,jk,jl)      
-                     e_i(ji,jj,jk,jl) = rswitch * MAX( 0._wp, zs0e(ji,jj,jk,jl) )
-                     ! Update fluxes
-                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
-                  END DO !ji
-               END DO ! jj
-            END DO ! jk
-         END DO ! jl
-
-         !--- Thickness correction in case too high (clem) --------------------------------------------------------
-         CALL lim_var_glo2eqv
+                     e_i(ji,jj,jk,jl) = MAX( 0._wp, e_i(ji,jj,jk,jl) )
+                  END DO
+               END DO
+            END DO
+         END DO
+!!gm & cr 
+
+         ! --- diags ---
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice
+               diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice
+
+               diag_trp_vi (ji,jj) = SUM(   v_i(ji,jj,:) -  zviold(ji,jj,:) ) * r1_rdtice
+               diag_trp_vs (ji,jj) = SUM(   v_s(ji,jj,:) -  zvsold(ji,jj,:) ) * r1_rdtice
+               diag_trp_smv(ji,jj) = SUM( smv_i(ji,jj,:) - zsmvold(ji,jj,:) ) * r1_rdtice
+            END DO
+         END DO
+
+         ! zap small areas
+         CALL lim_var_zapsmall
+
+         !--- Thickness correction in case too high --------------------------------------------------------
          DO jl = 1, jpl
             DO jj = 1, jpj
@@ -382,4 +373,9 @@
 
                   IF ( v_i(ji,jj,jl) > 0._wp ) THEN
+
+                     rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )
+                     ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+                     ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+                     
                      zvi  = v_i  (ji,jj,jl)
                      zvs  = v_s  (ji,jj,jl)
@@ -387,48 +383,47 @@
                      zes  = e_s  (ji,jj,1,jl)
                      zei  = SUM( e_i(ji,jj,1:nlay_i,jl) )
-                     zdv  = v_i(ji,jj,jl) - zviold(ji,jj,jl)   
-                     !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl)   
-                     
-                     rswitch = 1._wp
-                     IF ( ( zdv > 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) .AND. SUM( zaiold(ji,jj,1:jpl) ) < 0.80 ) .OR. &
-                        & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN                                          
-                        ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) )
-                        rswitch        = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) )
-                        a_i(ji,jj,jl)  = rswitch * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 )
-                     ELSE
-                        ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) )
-                        rswitch        = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) )
-                        a_i(ji,jj,jl)  = rswitch * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 )
+
+                     zdv  = v_i(ji,jj,jl) + v_s(ji,jj,jl) - zviold(ji,jj,jl) - zvsold(ji,jj,jl)  
+
+                     IF ( ( zdv >  0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) .AND. zatold(ji,jj) < 0.80 ) .OR. &
+                        & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN
+
+                        rswitch        = MAX( 0._wp, SIGN( 1._wp, zhimax(ji,jj,jl) - epsi20 ) )
+                        a_i(ji,jj,jl)  = rswitch * ( v_i(ji,jj,jl) + v_s(ji,jj,jl) ) / MAX( zhimax(ji,jj,jl), epsi20 )
+
+                        ! small correction due to *rswitch for a_i
+                        v_i  (ji,jj,jl)        = rswitch * v_i  (ji,jj,jl)
+                        v_s  (ji,jj,jl)        = rswitch * v_s  (ji,jj,jl)
+                        smv_i(ji,jj,jl)        = rswitch * smv_i(ji,jj,jl)
+                        e_s(ji,jj,1,jl)        = rswitch * e_s(ji,jj,1,jl)
+                        e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl)
+
+                        ! Update mass fluxes
+                        wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice
+                        wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice
+                        sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 
+                        hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0
+                        hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * r1_rdtice ! W.m-2 <0
+
                      ENDIF
 
-                     ! small correction due to *rswitch for a_i
-                     v_i  (ji,jj,jl) = rswitch * v_i  (ji,jj,jl)
-                     v_s  (ji,jj,jl) = rswitch * v_s  (ji,jj,jl)
-                     smv_i(ji,jj,jl) = rswitch * smv_i(ji,jj,jl)
-                     e_s(ji,jj,1,jl) = rswitch * e_s(ji,jj,1,jl)
-                     e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl)
-
-                     ! Update mass fluxes
-                     wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice
-                     wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice
-                     sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 
-                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
-                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
                   ENDIF
+
                END DO
             END DO
          END DO
          ! -------------------------------------------------
-
-         ! --- diags ---
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice
-               diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice
-
-               diag_trp_vi(ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice
-               diag_trp_vs(ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice
-            END DO
-         END DO
+         
+         !--------------------------------------
+         ! Impose a_i < amax in mono-category
+         !--------------------------------------
+         !
+         IF ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) THEN ! simple conservative piling, comparable with LIM2
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  a_i(ji,jj,1)  = MIN( a_i(ji,jj,1), rn_amax )
+               END DO
+            END DO
+         ENDIF
 
          ! --- agglomerate variables -----------------
@@ -436,23 +431,19 @@
          vt_s (:,:) = 0._wp
          at_i (:,:) = 0._wp
-         !
          DO jl = 1, jpl
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  !
-                  vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume
-                  vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume
-                  at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration
-               END DO
-            END DO
-         END DO
-         ! -------------------------------------------------
-
-         ! open water
+                  vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl)
+                  vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl)
+                  at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl)
+               END DO
+            END DO
+         END DO
+
+         ! --- open water = 1 if at_i=0 --------------------------------
          DO jj = 1, jpj
             DO ji = 1, jpi
-               ! open water = 1 if at_i=0
                rswitch      = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) )
-               ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * zs0ow(ji,jj)
+               ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj)
             END DO
          END DO      
@@ -463,43 +454,17 @@
       ENDIF
 
-      IF(ln_ctl) THEN   ! Control print
-         CALL prt_ctl_info(' ')
-         CALL prt_ctl_info(' - Cell values : ')
-         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=area , clinfo1=' lim_trp  : cell area :')
-         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_trp  : at_i      :')
-         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_trp  : vt_i      :')
-         CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_trp  : vt_s      :')
-         DO jl = 1, jpl
-            CALL prt_ctl_info(' ')
-            CALL prt_ctl_info(' - Category : ', ivar1=jl)
-            CALL prt_ctl_info('   ~~~~~~~~~~')
-            CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_trp  : a_i      : ')
-            CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_trp  : ht_i     : ')
-            CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_trp  : ht_s     : ')
-            CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_trp  : v_i      : ')
-            CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_trp  : v_s      : ')
-            CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_trp  : e_s      : ')
-            CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_trp  : t_su     : ')
-            CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_trp  : t_snow   : ')
-            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_trp  : sm_i     : ')
-            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_trp  : smv_i    : ')
-            DO jk = 1, nlay_i
-               CALL prt_ctl_info(' ')
-               CALL prt_ctl_info(' - Layer : ', ivar1=jk)
-               CALL prt_ctl_info('   ~~~~~~~')
-               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_trp  : t_i      : ')
-               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_trp  : e_i      : ')
-            END DO
-         END DO
-      ENDIF
+      ! -------------------------------------------------
+      ! control prints
+      ! -------------------------------------------------
+      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' )
       !
-      CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold )
-      CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi )
-      CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, zs0e )
-
-      CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zaiold, zhimax )   ! clem
+      CALL wrk_dealloc( jpi,jpj,            zsm, zatold, zeiold, zesold )
+      CALL wrk_dealloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi )
+      CALL wrk_dealloc( jpi,jpj,1,          z0opw )
+      CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei )
+      CALL wrk_dealloc( jpi,jpj,jpl,        zviold, zvsold, zhimax, zsmvold )
       !
       IF( nn_timing == 1 )  CALL timing_stop('limtrp')
+
    END SUBROUTINE lim_trp
 
@@ -512,5 +477,4 @@
    END SUBROUTINE lim_trp
 #endif
-
    !!======================================================================
 END MODULE limtrp
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90	(revision 5682)
@@ -5,5 +5,5 @@
    !!======================================================================
    !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code
-   !!            3.6  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
+   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -13,40 +13,25 @@
    !!    lim_update1   : computes update of sea-ice global variables from trend terms
    !!----------------------------------------------------------------------
-   USE limrhg          ! ice rheology
-
-   USE dom_oce
-   USE oce             ! dynamics and tracers variables
-   USE in_out_manager
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice fields
    USE dom_ice
+   USE dom_oce
    USE phycst          ! physical constants
    USE ice
-   USE limdyn
-   USE limtrp
-   USE limthd
-   USE limsbc
-   USE limdiahsb
-   USE limwri
-   USE limrst
    USE thd_ice         ! LIM thermodynamic sea-ice variables
-   USE par_ice
    USE limitd_th
-   USE limitd_me
    USE limvar
-   USE prtctl           ! Print control
-   USE lbclnk           ! lateral boundary condition - MPP exchanges
-   USE wrk_nemo         ! work arrays
-   USE lib_fortran     ! glob_sum
-   USE in_out_manager   ! I/O manager
-   USE iom              ! I/O manager
-   USE lib_mpp          ! MPP library
+   USE prtctl          ! Print control
+   USE wrk_nemo        ! work arrays
    USE timing          ! Timing
-   USE limcons        ! conservation tests
+   USE limcons         ! conservation tests
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE in_out_manager  ! I/O manager
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_update1   ! routine called by ice_step
+   PUBLIC   lim_update1
 
    !! * Substitutions
@@ -54,10 +39,10 @@
    !!----------------------------------------------------------------------
    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE lim_update1
+   SUBROUTINE lim_update1( kt )
       !!-------------------------------------------------------------------
       !!               ***  ROUTINE lim_update1  ***
@@ -67,9 +52,8 @@
       !!                
       !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! number of iteration
       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      INTEGER  ::   i_ice_switch
       REAL(wp) ::   zsal
-      !
-      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
+      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
       !!-------------------------------------------------------------------
       IF( nn_timing == 1 )  CALL timing_start('limupdate1')
@@ -77,19 +61,15 @@
       IF( ln_limdyn ) THEN 
 
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*) ' lim_update1 ' 
+         WRITE(numout,*) ' ~~~~~~~~~~~ '
+      ENDIF
+
       ! conservation test
       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
-      !-----------------
-      ! zap small values
-      !-----------------
-      CALL lim_itd_me_zapsmall
-
-      CALL lim_var_glo2eqv
-     
       !----------------------------------------------------
-      ! Rebin categories with thickness out of bounds
-      !----------------------------------------------------
-      IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl)
-
+      ! ice concentration should not exceed amax 
+      !-----------------------------------------------------
       at_i(:,:) = 0._wp
       DO jl = 1, jpl
@@ -97,45 +77,26 @@
       END DO
 
-      !----------------------------------------------------
-      ! ice concentration should not exceed amax 
-      !-----------------------------------------------------
       DO jl  = 1, jpl
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
-                  a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) )
-                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+               IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
+                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
                ENDIF
             END DO
          END DO
       END DO
-
-      at_i(:,:) = 0._wp
-      DO jl = 1, jpl
-         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
-      END DO
     
-      ! --------------------------------------
-      ! Final thickness distribution rebinning
-      ! --------------------------------------
-      IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl)
-
-      !-----------------
-      ! zap small values
-      !-----------------
-      CALL lim_itd_me_zapsmall
-
       !---------------------
       ! Ice salinity bounds
       !---------------------
-      IF (  num_sal == 2  ) THEN 
+      IF (  nn_icesal == 2  ) THEN 
          DO jl = 1, jpl
             DO jj = 1, jpj 
                DO ji = 1, jpi
                   zsal            = smv_i(ji,jj,jl)
-                  smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl)
                   ! salinity stays in bounds
-                  i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
-                  smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) )
+                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
+                  smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) )
                   ! associated salt flux
                   sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
@@ -145,26 +106,45 @@
       ENDIF
 
+      !----------------------------------------------------
+      ! Rebin categories with thickness out of bounds
+      !----------------------------------------------------
+      IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl)
+
+      !-----------------
+      ! zap small values
+      !-----------------
+      CALL lim_var_zapsmall
+
       ! -------------------------------------------------
       ! Diagnostics
       ! -------------------------------------------------
-      d_u_ice_dyn(:,:)     = u_ice(:,:)     - u_ice_b(:,:)
-      d_v_ice_dyn(:,:)     = v_ice(:,:)     - v_ice_b(:,:)
-      d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - a_i_b  (:,:,:)
-      d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - v_s_b  (:,:,:)  
-      d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - v_i_b  (:,:,:)   
-      d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - e_s_b  (:,:,:,:)  
-      d_e_i_trp  (:,:,1:nlay_i,:) = e_i  (:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:)
-      d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - oa_i_b (:,:,:)
-      d_smv_i_trp(:,:,:)   = 0._wp
-      IF(  num_sal == 2  ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:)
+      DO jl  = 1, jpl
+         afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi            
+            ! heat content variation (W.m-2)
+            diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  & 
+               &                   SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    &
+               &                 ) * r1_rdtice
+            ! salt, volume
+            diag_smvi(ji,jj) = SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
+            diag_vice(ji,jj) = SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice
+            diag_vsnw(ji,jj) = SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice
+         END DO
+      END DO
 
       ! conservation test
       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
+      ! -------------------------------------------------
+      ! control prints
+      ! -------------------------------------------------
       IF(ln_ctl) THEN   ! Control print
          CALL prt_ctl_info(' ')
          CALL prt_ctl_info(' - Cell values : ')
          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=area       , clinfo1=' lim_update1  : cell area   :')
+         CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update1  : cell area   :')
          CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update1  : at_i        :')
          CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update1  : vt_i        :')
@@ -172,5 +152,4 @@
          CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update1  : strength    :')
          CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update1  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :')
-         CALL prt_ctl(tab2d_1=d_u_ice_dyn, clinfo1=' lim_update1  : d_u_ice_dyn :', tab2d_2=d_v_ice_dyn, clinfo2=' d_v_ice_dyn :')
          CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update1  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :')
 
@@ -187,26 +166,18 @@
             CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update1  : a_i         : ')
             CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : a_i_b       : ')
-            CALL prt_ctl(tab2d_1=d_a_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_a_i_trp   : ')
             CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update1  : v_i         : ')
             CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_i_b       : ')
-            CALL prt_ctl(tab2d_1=d_v_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_i_trp   : ')
             CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update1  : v_s         : ')
             CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_s_b       : ')
-            CALL prt_ctl(tab2d_1=d_v_s_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_s_trp   : ')
-            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1        : ')
-            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1_b      : ')
-            CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : de_i1_trp   : ')
-            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2        : ')
-            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2_b      : ')
-            CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : de_i2_trp   : ')
+            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_i1        : ')
+            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_i1_b      : ')
+            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)      , clinfo1= ' lim_update1  : e_i2        : ')
+            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)      , clinfo1= ' lim_update1  : e_i2_b      : ')
             CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow      : ')
             CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow_b    : ')
-            CALL prt_ctl(tab2d_1=d_e_s_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : d_e_s_trp   : ')
             CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update1  : smv_i       : ')
             CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update1  : smv_i_b     : ')
-            CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl)        , clinfo1= ' lim_update1  : d_smv_i_trp : ')
             CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update1  : oa_i        : ')
             CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update1  : oa_i_b      : ')
-            CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl)        , clinfo1= ' lim_update1  : d_oa_i_trp  : ')
 
             DO jk = 1, nlay_i
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90	(revision 5682)
@@ -5,5 +5,5 @@
    !!======================================================================
    !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code
-   !!            3.6  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
+   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -13,32 +13,22 @@
    !!    lim_update2   : computes update of sea-ice global variables from trend terms
    !!----------------------------------------------------------------------
-   USE limrhg          ! ice rheology
-
-   USE dom_oce
-   USE oce             ! dynamics and tracers variables
-   USE in_out_manager
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice fields
    USE dom_ice
+   USE dom_oce
    USE phycst          ! physical constants
    USE ice
-   USE limdyn
-   USE limtrp
-   USE limthd
-   USE limsbc
-   USE limdiahsb
-   USE limwri
-   USE limrst
    USE thd_ice         ! LIM thermodynamic sea-ice variables
-   USE par_ice
    USE limitd_th
-   USE limitd_me
    USE limvar
-   USE prtctl           ! Print control
-   USE lbclnk           ! lateral boundary condition - MPP exchanges
-   USE wrk_nemo         ! work arrays
-   USE lib_fortran     ! glob_sum
+   USE prtctl          ! Print control
+   USE lbclnk          ! lateral boundary condition - MPP exchanges
+   USE wrk_nemo        ! work arrays
    USE timing          ! Timing
-   USE limcons        ! conservation tests
+   USE limcons         ! conservation tests
+   USE limctl
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE in_out_manager
 
    IMPLICIT NONE
@@ -51,10 +41,10 @@
    !!----------------------------------------------------------------------
    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
-   !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE lim_update2
+   SUBROUTINE lim_update2( kt )
       !!-------------------------------------------------------------------
       !!               ***  ROUTINE lim_update2  ***
@@ -64,37 +54,29 @@
       !!
       !!---------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk, jl    ! dummy loop indices
-      INTEGER  ::   i_ice_switch
-      REAL(wp) ::   zh, zsal
-      !
-      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
+      INTEGER, INTENT(in) ::   kt    ! number of iteration
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      REAL(wp) ::   zsal
+      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
       !!-------------------------------------------------------------------
       IF( nn_timing == 1 )  CALL timing_start('limupdate2')
 
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*) ' lim_update2 '
+         WRITE(numout,*) ' ~~~~~~~~~~~ '
+      ENDIF
+
       ! conservation test
       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
-      !-----------------
-      ! zap small values
-      !-----------------
-      CALL lim_itd_me_zapsmall
-
-      CALL lim_var_glo2eqv
-
-      !----------------------------------------------------
-      ! Rebin categories with thickness out of bounds
-      !----------------------------------------------------
-      IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl)
-
       !----------------------------------------------------------------------
-      ! Constrain the thickness of the smallest category above hiclim
+      ! Constrain the thickness of the smallest category above himin
       !----------------------------------------------------------------------
       DO jj = 1, jpj 
          DO ji = 1, jpi
-            IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < hiclim ) THEN
-               zh             = hiclim / ht_i(ji,jj,1)
-               ht_s(ji,jj,1) = ht_s(ji,jj,1) * zh
-               ht_i(ji,jj,1) = ht_i(ji,jj,1) * zh
-               a_i (ji,jj,1) = a_i(ji,jj,1)  / zh
+            rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,1) - epsi20 ) )   !0 if no ice and 1 if yes
+            ht_i(ji,jj,1) = v_i (ji,jj,1) / MAX( a_i(ji,jj,1) , epsi20 ) * rswitch
+            IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < rn_himin ) THEN
+               a_i (ji,jj,1) = a_i (ji,jj,1) * ht_i(ji,jj,1) / rn_himin
+               oa_i(ji,jj,1) = oa_i(ji,jj,1) * ht_i(ji,jj,1) / rn_himin
             ENDIF
          END DO
@@ -112,7 +94,7 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
-                  a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) )
-                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+               IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
+                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
                ENDIF
             END DO
@@ -120,40 +102,34 @@
       END DO
 
-      at_i(:,:) = 0.0
-      DO jl = 1, jpl
-         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
-      END DO
-
-      ! --------------------------------------
-      ! Final thickness distribution rebinning
-      ! --------------------------------------
-      IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl )
-
-      !-----------------
-      ! zap small values
-      !-----------------
-      CALL lim_itd_me_zapsmall
-
       !---------------------
-      ! 2.11) Ice salinity
+      ! Ice salinity
       !---------------------
-      IF (  num_sal == 2  ) THEN 
+      IF (  nn_icesal == 2  ) THEN 
          DO jl = 1, jpl
             DO jj = 1, jpj 
                DO ji = 1, jpi
                   zsal            = smv_i(ji,jj,jl)
-                  smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl)
                   ! salinity stays in bounds
-                  i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
-                  smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl)
+                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
+                  smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) )
                   ! associated salt flux
                   sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
-               END DO ! ji
-            END DO ! jj
-         END DO !jl
+               END DO
+            END DO
+         END DO
       ENDIF
 
+      !----------------------------------------------------
+      ! Rebin categories with thickness out of bounds
+      !----------------------------------------------------
+      IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl )
+
+      !-----------------
+      ! zap small values
+      !-----------------
+      CALL lim_var_zapsmall
+
       !------------------------------------------------------------------------------
-      ! 2) Corrections to avoid wrong values                                        |
+      ! Corrections to avoid wrong values                                        |
       !------------------------------------------------------------------------------
       ! Ice drift
@@ -173,32 +149,41 @@
       CALL lbc_lnk( v_ice(:,:), 'V', -1. )
       !mask velocities
-      u_ice(:,:) = u_ice(:,:) * tmu(:,:)
-      v_ice(:,:) = v_ice(:,:) * tmv(:,:)
+      u_ice(:,:) = u_ice(:,:) * umask(:,:,1)
+      v_ice(:,:) = v_ice(:,:) * vmask(:,:,1)
  
       ! -------------------------------------------------
       ! Diagnostics
       ! -------------------------------------------------
-      d_a_i_thd(:,:,:)   = a_i(:,:,:)   - a_i_b(:,:,:) 
-      d_v_s_thd(:,:,:)   = v_s(:,:,:)   - v_s_b(:,:,:)
-      d_v_i_thd(:,:,:)   = v_i(:,:,:)   - v_i_b(:,:,:)  
-      d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - e_s_b(:,:,:,:) 
-      d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:)
-      !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - oa_i_b (:,:,:)
-      d_smv_i_thd(:,:,:) = 0._wp
-      IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:)
-      ! diag only (clem)
-      dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday
-
-      ! heat content variation (W.m-2)
+      DO jl  = 1, jpl
+         oa_i(:,:,jl) = oa_i(:,:,jl) + a_i(:,:,jl) * rdt_ice / rday   ! ice natural aging
+         afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice
+      END DO
+      afx_tot = afx_thd + afx_dyn
+
       DO jj = 1, jpj
          DO ji = 1, jpi            
-            diag_heat_dhc(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) +  & 
-               &                     SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) )    &
-               &                   ) * unit_fac * r1_rdtice / area(ji,jj)   
+            ! heat content variation (W.m-2)
+            diag_heat(ji,jj) = diag_heat(ji,jj) -  &
+               &               ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  & 
+               &                 SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    &
+               &               ) * r1_rdtice   
+            ! salt, volume
+            diag_smvi(ji,jj) = diag_smvi(ji,jj) + SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
+            diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice
+            diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice
          END DO
       END DO
 
       ! conservation test
-      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      ! necessary calls (at least for coupling)
+      CALL lim_var_glo2eqv
+      CALL lim_var_agg(2)
+
+      ! -------------------------------------------------
+      ! control prints
+      ! -------------------------------------------------
+      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' )   ! control print
 
       IF(ln_ctl) THEN   ! Control print
@@ -206,5 +191,5 @@
          CALL prt_ctl_info(' - Cell values : ')
          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
-         CALL prt_ctl(tab2d_1=area       , clinfo1=' lim_update2  : cell area   :')
+         CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update2  : cell area   :')
          CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update2  : at_i        :')
          CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update2  : vt_i        :')
@@ -226,26 +211,18 @@
             CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update2  : a_i         : ')
             CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : a_i_b       : ')
-            CALL prt_ctl(tab2d_1=d_a_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_a_i_thd   : ')
             CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update2  : v_i         : ')
             CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_i_b       : ')
-            CALL prt_ctl(tab2d_1=d_v_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_i_thd   : ')
             CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update2  : v_s         : ')
             CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_s_b       : ')
-            CALL prt_ctl(tab2d_1=d_v_s_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_s_thd   : ')
-            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1        : ')
-            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1_b      : ')
-            CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : de_i1_thd   : ')
-            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2        : ')
-            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2_b      : ')
-            CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : de_i2_thd   : ')
+            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_i1        : ')
+            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_i1_b      : ')
+            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)      , clinfo1= ' lim_update2  : e_i2        : ')
+            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)      , clinfo1= ' lim_update2  : e_i2_b      : ')
             CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow      : ')
             CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow_b    : ')
-            CALL prt_ctl(tab2d_1=d_e_s_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : d_e_s_thd   : ')
             CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update2  : smv_i       : ')
             CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update2  : smv_i_b     : ')
-            CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl)        , clinfo1= ' lim_update2  : d_smv_i_thd : ')
             CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update2  : oa_i        : ')
             CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update2  : oa_i_b      : ')
-            CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl)        , clinfo1= ' lim_update2  : d_oa_i_thd  : ')
 
             DO jk = 1, nlay_i
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 5682)
@@ -30,5 +30,5 @@
    !!======================================================================
    !! History :   -   ! 2006-01 (M. Vancoppenolle) Original code
-   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -36,16 +36,8 @@
    !!   'key_lim3'                                      LIM3 sea-ice model
    !!----------------------------------------------------------------------
-   !!   lim_var_agg       : 
-   !!   lim_var_glo2eqv   :
-   !!   lim_var_eqv2glo   :
-   !!   lim_var_salprof   : 
-   !!   lim_var_salprof1d :
-   !!   lim_var_bv        :
-   !!----------------------------------------------------------------------
    USE par_oce        ! ocean parameters
    USE phycst         ! physical constants (ocean directory) 
    USE sbc_oce        ! Surface boundary condition: ocean fields
    USE ice            ! ice variables
-   USE par_ice        ! ice parameters
    USE thd_ice        ! ice variables (thermodynamics)
    USE dom_ice        ! ice domain
@@ -58,14 +50,16 @@
    PRIVATE
 
-   PUBLIC   lim_var_agg          !
-   PUBLIC   lim_var_glo2eqv      !
-   PUBLIC   lim_var_eqv2glo      !
-   PUBLIC   lim_var_salprof      !
-   PUBLIC   lim_var_icetm        !
-   PUBLIC   lim_var_bv           !
-   PUBLIC   lim_var_salprof1d    !
+   PUBLIC   lim_var_agg          
+   PUBLIC   lim_var_glo2eqv      
+   PUBLIC   lim_var_eqv2glo      
+   PUBLIC   lim_var_salprof      
+   PUBLIC   lim_var_icetm        
+   PUBLIC   lim_var_bv           
+   PUBLIC   lim_var_salprof1d    
+   PUBLIC   lim_var_zapsmall
+   PUBLIC   lim_var_itd
 
    !!----------------------------------------------------------------------
-   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! NEMO/LIM3 3.5 , UCL - NEMO Consortium (2011)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -129,9 +123,9 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                       ! snow heat content
-                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
-                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * rswitch   ! ice salinity
-                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
-                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi10 ) * rswitch   ! ice age
+                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                           ! snow heat content
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi20 ) ) 
+                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi20 ) * rswitch   ! ice salinity
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi20 ) ) 
+                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi20 ) * rswitch   ! ice age
                END DO
             END DO
@@ -167,18 +161,20 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes
-               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
-               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
-               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
-            END DO
-         END DO
-      END DO
-
-      IF(  num_sal == 2  )THEN
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes
+               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+            END DO
+         END DO
+      END DO
+
+      IF(  nn_icesal == 2  )THEN
          DO jl = 1, jpl
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes
-                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * rswitch
+                  rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes
+                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * rswitch
+                  !                                      ! bounding salinity
+                  sm_i(ji,jj,jl) = MAX( sm_i(ji,jj,jl), rn_simin )
                END DO
             END DO
@@ -191,24 +187,19 @@
       ! Ice temperatures
       !-------------------
-!CDIR NOVERRCHK
-      DO jl = 1, jpl
-!CDIR NOVERRCHK
+      DO jl = 1, jpl
          DO jk = 1, nlay_i
-!CDIR NOVERRCHK
             DO jj = 1, jpj
-!CDIR NOVERRCHK
                DO ji = 1, jpi
                   !                                                              ! Energy of melting q(S,T) [J.m-3]
-                  rswitch   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )     ! rswitch = 0 if no ice and 1 if yes
-                  zq_i    = rswitch * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp) 
-                  zq_i    = zq_i * unit_fac                             !convert units
-                  ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt                       ! Ice layer melt temperature
+                  rswitch = MAX( 0.0 , SIGN( 1.0 , v_i(ji,jj,jl) - epsi20 ) )     ! rswitch = 0 if no ice and 1 if yes
+                  zq_i    = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL(nlay_i,wp) 
+                  ztmelts = -tmut * s_i(ji,jj,jk,jl) + rt0              ! Ice layer melt temperature
                   !
                   zaaa       =  cpic                  ! Conversion q(S,T) -> T (second order equation)
-                  zbbb       =  ( rcp - cpic ) * ( ztmelts - rtt ) + zq_i / rhoic - lfus
-                  zccc       =  lfus * (ztmelts-rtt)
+                  zbbb       =  ( rcp - cpic ) * ( ztmelts - rt0 ) + zq_i * r1_rhoic - lfus
+                  zccc       =  lfus * (ztmelts-rt0)
                   zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) )
-                  t_i(ji,jj,jk,jl) = rtt + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )
-                  t_i(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) )       ! 100-rtt < t_i < rtt
+                  t_i(ji,jj,jk,jl) = rt0 + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )
+                  t_i(ji,jj,jk,jl) = MIN( ztmelts, MAX( rt0 - 100._wp, t_i(ji,jj,jk,jl) ) )  ! -100 < t_i < ztmelts
                END DO
             END DO
@@ -226,10 +217,9 @@
                DO ji = 1, jpi
                   !Energy of melting q(S,T) [J.m-3]
-                  rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) )     ! rswitch = 0 if no ice and 1 if yes
-                  zq_s  = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp)
-                  zq_s  = zq_s * unit_fac                                    ! convert units
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 ) )     ! rswitch = 0 if no ice and 1 if yes
+                  zq_s  = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL(nlay_s,wp)
                   !
-                  t_s(ji,jj,jk,jl) = rtt + rswitch * ( - zfac1 * zq_s + zfac2 )
-                  t_s(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15, t_s(ji,jj,jk,jl) ) )     ! 100-rtt < t_i < rtt
+                  t_s(ji,jj,jk,jl) = rt0 + rswitch * ( - zfac1 * zq_s + zfac2 )
+                  t_s(ji,jj,jk,jl) = MIN( rt0, MAX( rt0 - 100._wp , t_s(ji,jj,jk,jl) ) )     ! -100 < t_s < rt0
                END DO
             END DO
@@ -240,4 +230,9 @@
       ! Mean temperature
       !-------------------
+      vt_i (:,:) = 0._wp
+      DO jl = 1, jpl
+         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl)
+      END DO
+
       tm_i(:,:) = 0._wp
       DO jl = 1, jpl
@@ -245,11 +240,12 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  )
-                  tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   &
-                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  )
-               END DO
-            END DO
-         END DO
-      END DO
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
+                  tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  &
+                     &            / MAX( vt_i(ji,jj) , epsi10 )
+               END DO
+            END DO
+         END DO
+      END DO
+      tm_i = tm_i + rt0
       !
    END SUBROUTINE lim_var_glo2eqv
@@ -270,5 +266,4 @@
       v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:)
       smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
-      oa_i (:,:,:) = o_i (:,:,:) * a_i(:,:,:)
       !
    END SUBROUTINE lim_var_eqv2glo
@@ -281,17 +276,19 @@
       !! ** Purpose :   computes salinity profile in function of bulk salinity     
       !!
-      !! ** Method  : If bulk salinity greater than s_i_1, 
+      !! ** Method  : If bulk salinity greater than zsi1, 
       !!              the profile is assumed to be constant (S_inf)
-      !!              If bulk salinity lower than s_i_0,
+      !!              If bulk salinity lower than zsi0,
       !!              the profile is linear with 0 at the surface (S_zero)
-      !!              If it is between s_i_0 and s_i_1, it is a
+      !!              If it is between zsi0 and zsi1, it is a
       !!              alpha-weighted linear combination of s_inf and s_zero
       !!
-      !! ** References : Vancoppenolle et al., 2007 (in preparation)
+      !! ** References : Vancoppenolle et al., 2007
       !!------------------------------------------------------------------
       INTEGER  ::   ji, jj, jk, jl   ! dummy loop index
-      REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac, zsal      ! local scalar
-      REAL(wp) ::   zswi0, zswi01, zswibal, zargtemp , zs_zero   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha   ! 3D pointer
+      REAL(wp) ::   zfac0, zfac1, zsal
+      REAL(wp) ::   zswi0, zswi01, zargtemp , zs_zero   
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha
+      REAL(wp), PARAMETER :: zsi0 = 3.5_wp
+      REAL(wp), PARAMETER :: zsi1 = 4.5_wp
       !!------------------------------------------------------------------
 
@@ -301,10 +298,10 @@
       ! Vertically constant, constant in time
       !---------------------------------------
-      IF(  num_sal == 1  )   s_i(:,:,:,:) = bulk_sal
+      IF(  nn_icesal == 1  )   s_i(:,:,:,:) = rn_icesal
 
       !-----------------------------------
       ! Salinity profile, varying in time
       !-----------------------------------
-      IF(  num_sal == 2  ) THEN
+      IF(  nn_icesal == 2  ) THEN
          !
          DO jk = 1, nlay_i
@@ -315,11 +312,12 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) )
-               END DO
-            END DO
-         END DO
-         !
-         dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 )       ! Weighting factor between zs_zero and zs_inf
-         dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,jl) - epsi20 ) )
+                  z_slope_s(ji,jj,jl) = rswitch * 2._wp * sm_i(ji,jj,jl) / MAX( epsi20 , ht_i(ji,jj,jl) )
+               END DO
+            END DO
+         END DO
+         !
+         zfac0 = 1._wp / ( zsi0 - zsi1 )       ! Weighting factor between zs_zero and zs_inf
+         zfac1 = zsi1  / ( zsi1 - zsi0 )
          !
          zalpha(:,:,:) = 0._wp
@@ -327,18 +325,18 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise
-                  zswi0  = MAX( 0._wp   , SIGN( 1._wp  , s_i_0 - sm_i(ji,jj,jl) ) ) 
-                  ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws 
-                  zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp   , SIGN( 1._wp  , s_i_1 - sm_i(ji,jj,jl) ) ) 
-                  ! If 2.sm_i GE sss_m then zswibal = 1
+                  ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
+                  zswi0  = MAX( 0._wp   , SIGN( 1._wp  , zsi0 - sm_i(ji,jj,jl) ) ) 
+                  ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws 
+                  zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp   , SIGN( 1._wp  , zsi1 - sm_i(ji,jj,jl) ) ) 
+                  ! If 2.sm_i GE sss_m then rswitch = 1
                   ! this is to force a constant salinity profile in the Baltic Sea
-                  zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
-                  zalpha(ji,jj,jl) = zswi0  + zswi01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 )
-                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zswibal )
-               END DO
-            END DO
-         END DO
-
-         dummy_fac = 1._wp / REAL( nlay_i )                   ! Computation of the profile
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
+                  zalpha(ji,jj,jl) = zswi0  + zswi01 * ( sm_i(ji,jj,jl) * zfac0 + zfac1 )
+                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - rswitch )
+               END DO
+            END DO
+         END DO
+
+         ! Computation of the profile
          DO jl = 1, jpl
             DO jk = 1, nlay_i
@@ -346,13 +344,15 @@
                   DO ji = 1, jpi
                      !                                      ! linear profile with 0 at the surface
-                     zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * dummy_fac
+                     zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * r1_nlay_i
                      !                                      ! weighting the profile
                      s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl)
-                  END DO ! ji
-               END DO ! jj
-            END DO ! jk
-         END DO ! jl
-         !
-      ENDIF ! num_sal
+                     !                                      ! bounding salinity
+                     s_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( s_i(ji,jj,jk,jl), rn_simin ) )
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF ! nn_icesal
 
       !-------------------------------------------------------
@@ -360,12 +360,11 @@
       !-------------------------------------------------------
 
-      IF(  num_sal == 3  ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
+      IF(  nn_icesal == 3  ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
          !
          sm_i(:,:,:) = 2.30_wp
          !
          DO jl = 1, jpl
-!CDIR NOVERRCHK
             DO jk = 1, nlay_i
-               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)
+               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
                zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  )
                s_i(:,:,jk,jl) =  zsal
@@ -373,5 +372,5 @@
          END DO
          !
-      ENDIF ! num_sal
+      ENDIF ! nn_icesal
       !
       CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha )
@@ -390,4 +389,9 @@
 
       ! Mean sea ice temperature
+      vt_i (:,:) = 0._wp
+      DO jl = 1, jpl
+         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl)
+      END DO
+
       tm_i(:,:) = 0._wp
       DO jl = 1, jpl
@@ -395,11 +399,12 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  )
-                  tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   &
-                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  )
-               END DO
-            END DO
-         END DO
-      END DO
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
+                  tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  &
+                     &            / MAX( vt_i(ji,jj) , epsi10 )
+               END DO
+            END DO
+         END DO
+      END DO
+      tm_i = tm_i + rt0
 
    END SUBROUTINE lim_var_icetm
@@ -420,4 +425,9 @@
       !!------------------------------------------------------------------
       !
+      vt_i (:,:) = 0._wp
+      DO jl = 1, jpl
+         vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl)
+      END DO
+
       bv_i(:,:) = 0._wp
       DO jl = 1, jpl
@@ -425,9 +435,9 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) )  )
-                  zbvi  = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 )   &
-                     &                   * v_i(ji,jj,jl)    / REAL(nlay_i,wp)
-                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  )
-                  bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi  / MAX( vt_i(ji,jj) , epsi10 )
+                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) )  )
+                  zbvi  = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 )   &
+                     &                   * v_i(ji,jj,jl) * r1_nlay_i
+                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi20 ) )  )
+                  bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi  / MAX( vt_i(ji,jj) , epsi20 )
                END DO
             END DO
@@ -448,9 +458,11 @@
       !
       INTEGER  ::   ji, jk    ! dummy loop indices
-      INTEGER  ::   ii, ij  ! local integers
-      REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal   ! local scalars
-      REAL(wp) ::   zalpha, zswi0, zswi01, zswibal, zs_zero              !   -      -
+      INTEGER  ::   ii, ij    ! local integers
+      REAL(wp) ::   zfac0, zfac1, zargtemp, zsal   ! local scalars
+      REAL(wp) ::   zalpha, zswi0, zswi01, zs_zero              !   -      -
       !
       REAL(wp), POINTER, DIMENSION(:) ::   z_slope_s
+      REAL(wp), PARAMETER :: zsi0 = 3.5_wp
+      REAL(wp), PARAMETER :: zsi1 = 4.5_wp
       !!---------------------------------------------------------------------
 
@@ -460,5 +472,5 @@
       ! Vertically constant, constant in time
       !---------------------------------------
-      IF( num_sal == 1 )   s_i_1d(:,:) = bulk_sal
+      IF( nn_icesal == 1 )   s_i_1d(:,:) = rn_icesal
 
       !------------------------------------------------------
@@ -466,39 +478,38 @@
       !------------------------------------------------------
 
-      IF(  num_sal == 2  ) THEN
+      IF(  nn_icesal == 2  ) THEN
          !
          DO ji = kideb, kiut          ! Slope of the linear profile zs_zero
-            z_slope_s(ji) = 2._wp * sm_i_1d(ji) / MAX( epsi10 , ht_i_1d(ji) )
+            rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) )
+            z_slope_s(ji) = rswitch * 2._wp * sm_i_1d(ji) / MAX( epsi20 , ht_i_1d(ji) )
          END DO
 
          ! Weighting factor between zs_zero and zs_inf
          !---------------------------------------------
-         dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 )
-         dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )
-         dummy_fac2 = 1._wp / REAL(nlay_i,wp)
-
-!CDIR NOVERRCHK
+         zfac0 = 1._wp / ( zsi0 - zsi1 )
+         zfac1 = zsi1 / ( zsi1 - zsi0 )
          DO jk = 1, nlay_i
-!CDIR NOVERRCHK
             DO ji = kideb, kiut
                ii =  MOD( npb(ji) - 1 , jpi ) + 1
                ij =     ( npb(ji) - 1 ) / jpi + 1
-               ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise
-               zswi0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_1d(ji) ) ) 
-               ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws 
-               zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_1d(ji) ) ) 
-               ! if 2.sm_i GE sss_m then zswibal = 1
+               ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
+               zswi0  = MAX( 0._wp , SIGN( 1._wp  , zsi0 - sm_i_1d(ji) ) ) 
+               ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws 
+               zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i_1d(ji) ) ) 
+               ! if 2.sm_i GE sss_m then rswitch = 1
                ! this is to force a constant salinity profile in the Baltic Sea
-               zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) )
+               rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) )
                !
-               zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zswibal )
+               zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * zfac0 + zfac1 )  ) * ( 1._wp - rswitch )
                !
-               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * dummy_fac2
+               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * r1_nlay_i
                ! weighting the profile
                s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji)
-            END DO ! ji
-         END DO ! jk
-
-      ENDIF ! num_sal
+               ! bounding salinity
+               s_i_1d(ji,jk) = MIN( rn_simax, MAX( s_i_1d(ji,jk), rn_simin ) )
+            END DO 
+         END DO 
+
+      ENDIF 
 
       !-------------------------------------------------------
@@ -506,12 +517,11 @@
       !-------------------------------------------------------
 
-      IF( num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
+      IF( nn_icesal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
          !
          sm_i_1d(:) = 2.30_wp
          !
-!CDIR NOVERRCHK
          DO jk = 1, nlay_i
-            zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)
-            zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  )
+            zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
+            zsal =  1.6_wp * ( 1._wp - COS( rpi * zargtemp**( 0.407_wp / ( 0.573_wp + zargtemp ) ) ) )
             DO ji = kideb, kiut
                s_i_1d(ji,jk) = zsal
@@ -524,4 +534,252 @@
       !
    END SUBROUTINE lim_var_salprof1d
+
+   SUBROUTINE lim_var_zapsmall
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_var_zapsmall ***
+      !!
+      !! ** Purpose :   Remove too small sea ice areas and correct fluxes
+      !!
+      !! history : LIM3.5 - 01-2014 (C. Rousset) original code
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices
+      REAL(wp) ::   zsal, zvi, zvs, zei, zes
+      !!-------------------------------------------------------------------
+      at_i (:,:) = 0._wp
+      DO jl = 1, jpl
+         at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
+      END DO
+
+      DO jl = 1, jpl
+
+         !-----------------------------------------------------------------
+         ! Zap ice energy and use ocean heat to melt ice
+         !-----------------------------------------------------------------
+         DO jk = 1, nlay_i
+            DO jj = 1 , jpj
+               DO ji = 1 , jpi
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch  &
+                     &                                       / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch
+                  zei              = e_i(ji,jj,jk,jl)
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * rswitch
+                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * rswitch + rt0 * ( 1._wp - rswitch )
+                  ! update exchanges with ocean
+                  hfx_res(ji,jj)   = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * r1_rdtice ! W.m-2 <0
+               END DO
+            END DO
+         END DO
+
+         DO jj = 1 , jpj
+            DO ji = 1 , jpi
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
+               rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch
+               rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch
+               rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch  &
+                  &                              / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch
+               zsal = smv_i(ji,jj,  jl)
+               zvi  = v_i  (ji,jj,  jl)
+               zvs  = v_s  (ji,jj,  jl)
+               zes  = e_s  (ji,jj,1,jl)
+               !-----------------------------------------------------------------
+               ! Zap snow energy 
+               !-----------------------------------------------------------------
+               t_s(ji,jj,1,jl) = t_s(ji,jj,1,jl) * rswitch + rt0 * ( 1._wp - rswitch )
+               e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * rswitch
+
+               !-----------------------------------------------------------------
+               ! zap ice and snow volume, add water and salt to ocean
+               !-----------------------------------------------------------------
+               ato_i(ji,jj)    = a_i  (ji,jj,jl) * ( 1._wp - rswitch ) + ato_i(ji,jj)
+               a_i  (ji,jj,jl) = a_i  (ji,jj,jl) * rswitch
+               v_i  (ji,jj,jl) = v_i  (ji,jj,jl) * rswitch
+               v_s  (ji,jj,jl) = v_s  (ji,jj,jl) * rswitch
+               t_su (ji,jj,jl) = t_su (ji,jj,jl) * rswitch + t_bo(ji,jj) * ( 1._wp - rswitch )
+               oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * rswitch
+               smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * rswitch
+
+               ! update exchanges with ocean
+               sfx_res(ji,jj)  = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
+               wfx_res(ji,jj)  = wfx_res(ji,jj) - ( v_i(ji,jj,jl)   - zvi  ) * rhoic * r1_rdtice
+               wfx_snw(ji,jj)  = wfx_snw(ji,jj) - ( v_s(ji,jj,jl)   - zvs  ) * rhosn * r1_rdtice
+               hfx_res(ji,jj)  = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0
+            END DO
+         END DO
+      END DO 
+
+      ! to be sure that at_i is the sum of a_i(jl)
+      at_i (:,:) = 0._wp
+      DO jl = 1, jpl
+         at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
+      END DO
+
+      ! open water = 1 if at_i=0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            rswitch      = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) )
+            ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj)
+         END DO
+      END DO
+
+      !
+   END SUBROUTINE lim_var_zapsmall
+
+   SUBROUTINE lim_var_itd( zhti, zhts, zai, zht_i, zht_s, za_i )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_var_itd   ***
+      !!
+      !! ** Purpose :  converting 1-cat ice to multiple ice categories
+      !!
+      !!                  ice thickness distribution follows a gaussian law
+      !!               around the concentration of the most likely ice thickness
+      !!                           (similar as limistate.F90)
+      !!
+      !! ** Method:   Iterative procedure
+      !!                
+      !!               1) Try to fill the jpl ice categories (bounds hi_max(0:jpl)) with a gaussian
+      !!
+      !!               2) Check whether the distribution conserves area and volume, positivity and
+      !!                  category boundaries
+      !!              
+      !!               3) If not (input ice is too thin), the last category is empty and
+      !!                  the number of categories is reduced (jpl-1)
+      !!
+      !!               4) Iterate until ok (SUM(itest(:) = 4)
+      !!
+      !! ** Arguments : zhti: 1-cat ice thickness
+      !!                zhts: 1-cat snow depth
+      !!                zai : 1-cat ice concentration
+      !!
+      !! ** Output    : jpl-cat 
+      !!
+      !!  (Example of application: BDY forcings when input are cell averaged)  
+      !!
+      !!-------------------------------------------------------------------
+      !! History : LIM3.5 - 2012    (M. Vancoppenolle)  Original code
+      !!                    2014    (C. Rousset)        Rewriting
+      !!-------------------------------------------------------------------
+      !! Local variables
+      INTEGER  :: ji, jk, jl             ! dummy loop indices
+      INTEGER  :: ijpij, i_fill, jl0  
+      REAL(wp) :: zarg, zV, zconv, zdh
+      REAL(wp), DIMENSION(:),   INTENT(in)    ::   zhti, zhts, zai    ! input ice/snow variables
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zht_i, zht_s, za_i ! output ice/snow variables
+      INTEGER , POINTER, DIMENSION(:)         ::   itest
+ 
+      CALL wrk_alloc( 4, itest )
+      !--------------------------------------------------------------------
+      ! initialisation of variables
+      !--------------------------------------------------------------------
+      ijpij = SIZE(zhti,1)
+      zht_i(1:ijpij,1:jpl) = 0._wp
+      zht_s(1:ijpij,1:jpl) = 0._wp
+      za_i (1:ijpij,1:jpl) = 0._wp
+
+      ! ----------------------------------------
+      ! distribution over the jpl ice categories
+      ! ----------------------------------------
+      DO ji = 1, ijpij
+         
+         IF( zhti(ji) > 0._wp ) THEN
+
+         ! initialisation of tests
+         itest(:)  = 0
+         
+         i_fill = jpl + 1                                             !====================================
+         DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories  
+            ! iteration                                               !====================================
+            i_fill = i_fill - 1
+            
+            ! initialisation of ice variables for each try
+            zht_i(ji,1:jpl) = 0._wp
+            za_i (ji,1:jpl) = 0._wp
+            
+            ! *** case very thin ice: fill only category 1
+            IF ( i_fill == 1 ) THEN
+               zht_i(ji,1) = zhti(ji)
+               za_i (ji,1) = zai (ji)
+
+            ! *** case ice is thicker: fill categories >1
+            ELSE
+
+               ! Fill ice thicknesses except the last one (i_fill) by hmean 
+               DO jl = 1, i_fill - 1
+                  zht_i(ji,jl) = hi_mean(jl)
+               END DO
+               
+               ! find which category (jl0) the input ice thickness falls into
+               jl0 = i_fill
+               DO jl = 1, i_fill
+                  IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN
+                     jl0 = jl
+		     CYCLE
+                  ENDIF
+               END DO
+               
+               ! Concentrations in the (i_fill-1) categories 
+               za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl))
+               DO jl = 1, i_fill - 1
+                  IF ( jl == jl0 ) CYCLE
+                  zarg        = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp )
+                  za_i(ji,jl) =   za_i (ji,jl0) * EXP(-zarg**2)
+               END DO
+               
+               ! Concentration in the last (i_fill) category
+               za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) )
+               
+               ! Ice thickness in the last (i_fill) category
+               zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) )
+               zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / za_i(ji,i_fill) 
+               
+            ENDIF ! case ice is thick or thin
+            
+            !---------------------
+            ! Compatibility tests
+            !--------------------- 
+            ! Test 1: area conservation
+            zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) )
+            IF ( zconv < epsi06 ) itest(1) = 1
+            
+            ! Test 2: volume conservation
+            zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) )
+            IF ( zconv < epsi06 ) itest(2) = 1
+            
+            ! Test 3: thickness of the last category is in-bounds ?
+            IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1
+            
+            ! Test 4: positivity of ice concentrations
+            itest(4) = 1
+            DO jl = 1, i_fill
+               IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0
+            END DO            
+                                                           !============================
+         END DO                                            ! end iteration on categories
+                                                           !============================
+         ENDIF ! if zhti > 0
+      END DO ! i loop
+
+      ! ------------------------------------------------
+      ! Adding Snow in each category where za_i is not 0
+      ! ------------------------------------------------ 
+      DO jl = 1, jpl
+         DO ji = 1, ijpij
+            IF( za_i(ji,jl) > 0._wp ) THEN
+               zht_s(ji,jl) = zht_i(ji,jl) * ( zhts(ji) / zhti(ji) )
+               ! In case snow load is in excess that would lead to transformation from snow to ice
+               ! Then, transfer the snow excess into the ice (different from limthd_dh)
+               zdh = MAX( 0._wp, ( rhosn * zht_s(ji,jl) + ( rhoic - rau0 ) * zht_i(ji,jl) ) * r1_rau0 ) 
+               ! recompute ht_i, ht_s avoiding out of bounds values
+               zht_i(ji,jl) = MIN( hi_max(jl), zht_i(ji,jl) + zdh )
+               zht_s(ji,jl) = MAX( 0._wp, zht_s(ji,jl) - zdh * rhoic * r1_rhosn )
+            ENDIF
+         ENDDO
+      ENDDO
+
+      CALL wrk_dealloc( 4, itest )
+      !
+    END SUBROUTINE lim_var_itd
+
 
 #else
@@ -542,4 +800,8 @@
    SUBROUTINE lim_var_salprof1d    ! Emtpy routines
    END SUBROUTINE lim_var_salprof1d
+   SUBROUTINE lim_var_zapsmall
+   END SUBROUTINE lim_var_zapsmall
+   SUBROUTINE lim_var_itd
+   END SUBROUTINE lim_var_itd
 #endif
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 5682)
@@ -24,5 +24,4 @@
    USE lib_mpp         ! MPP library
    USE wrk_nemo        ! work arrays
-   USE par_ice
    USE iom
    USE timing          ! Timing
@@ -61,5 +60,5 @@
       REAL(wp) ::  z1_365
       REAL(wp) ::  ztmp
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei, zt_i, zt_s
       REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, z2da, z2db, zswi    ! 2D workspace
       !!-------------------------------------------------------------------
@@ -67,5 +66,5 @@
       IF( nn_timing == 1 )  CALL timing_start('limwri')
 
-      CALL wrk_alloc( jpi, jpj, jpl, zoi, zei )
+      CALL wrk_alloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s )
       CALL wrk_alloc( jpi, jpj     , z2d, z2da, z2db, zswi )
 
@@ -73,4 +72,5 @@
       ! Mean category values
       !-----------------------------
+      z1_365 = 1._wp / 365._wp
 
       CALL lim_var_icetm      ! mean sea ice temperature
@@ -107,12 +107,12 @@
          DO jj = 2 , jpjm1
             DO ji = 2 , jpim1
-               z2da(ji,jj)  = (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp
-               z2db(ji,jj)  = (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp
+               z2da(ji,jj)  = (  u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp
+               z2db(ji,jj)  = (  v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp
            END DO
          END DO
          CALL lbc_lnk( z2da, 'T', -1. )
          CALL lbc_lnk( z2db, 'T', -1. )
-         CALL iom_put( "uice_ipa"     , z2da                )       ! ice velocity u component
-         CALL iom_put( "vice_ipa"     , z2db                )       ! ice velocity v component
+         CALL iom_put( "uice_ipa"     , z2da             )       ! ice velocity u component
+         CALL iom_put( "vice_ipa"     , z2db             )       ! ice velocity v component
          DO jj = 1, jpj                                 
             DO ji = 1, jpi
@@ -120,5 +120,5 @@
             END DO
          END DO
-         CALL iom_put( "icevel"       , z2d                 )       ! ice velocity module
+         CALL iom_put( "icevel"       , z2d              )       ! ice velocity module
       ENDIF
       !
@@ -128,10 +128,10 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * oa_i(ji,jj,jl)
+                  rswitch    = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) )
+                  z2d(ji,jj) = z2d(ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj), 0.1 )
                END DO
             END DO
          END DO
-         z1_365 = 1._wp / 365._wp
-         CALL iom_put( "miceage"     , z2d * z1_365         )        ! mean ice age
+         CALL iom_put( "miceage"     , z2d * z1_365      )        ! mean ice age
       ENDIF
 
@@ -139,8 +139,8 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               z2d(ji,jj) = ( tm_i(ji,jj) - rtt ) * zswi(ji,jj)
-            END DO
-         END DO
-         CALL iom_put( "micet"       , z2d                  )        ! mean ice temperature
+               z2d(ji,jj) = ( tm_i(ji,jj) - rt0 ) * zswi(ji,jj)
+            END DO
+         END DO
+         CALL iom_put( "micet"       , z2d               )        ! mean ice temperature
       ENDIF
       !
@@ -150,9 +150,9 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rtt ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 )
+                  z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 )
                END DO
             END DO
          END DO
-         CALL iom_put( "icest"       , z2d                 )        ! ice surface temperature
+         CALL iom_put( "icest"       , z2d              )        ! ice surface temperature
       ENDIF
 
@@ -164,5 +164,5 @@
             END DO
          END DO
-         CALL iom_put( "icecolf"     , z2d                 )        ! frazil ice collection thickness
+         CALL iom_put( "icecolf"     , z2d              )        ! frazil ice collection thickness
       ENDIF
 
@@ -176,5 +176,5 @@
       CALL iom_put( "utau_ice"    , utau_ice            )        ! wind stress over ice along i-axis at I-point
       CALL iom_put( "vtau_ice"    , vtau_ice            )        ! wind stress over ice along j-axis at I-point
-      CALL iom_put( "snowpre"     , sprecip             )        ! snow precipitation 
+      CALL iom_put( "snowpre"     , sprecip * 86400.    )        ! snow precipitation 
       CALL iom_put( "micesalt"    , smt_i               )        ! mean ice salinity
 
@@ -186,4 +186,5 @@
       CALL iom_put( "icetrp"      , diag_trp_vi * rday  )        ! ice volume transport
       CALL iom_put( "snwtrp"      , diag_trp_vs * rday  )        ! snw volume transport
+      CALL iom_put( "saltrp"      , diag_trp_smv * rday * rhoic ) ! salt content transport
       CALL iom_put( "deitrp"      , diag_trp_ei         )        ! advected ice enthalpy (W/m2)
       CALL iom_put( "destrp"      , diag_trp_es         )        ! advected snw enthalpy (W/m2)
@@ -200,34 +201,38 @@
 
       ztmp = rday / rhoic
-      CALL iom_put( "vfxres"     , wfx_res * ztmp  )             ! daily prod./melting due to limupdate 
-      CALL iom_put( "vfxopw"     , wfx_opw * ztmp  )             ! daily lateral thermodynamic ice production
-      CALL iom_put( "vfxsni"     , wfx_sni * ztmp  )             ! daily snowice ice production
-      CALL iom_put( "vfxbog"     , wfx_bog * ztmp  )             ! daily bottom thermodynamic ice production
-      CALL iom_put( "vfxdyn"     , wfx_dyn * ztmp  )             ! daily dynamic ice production (rid/raft)
-      CALL iom_put( "vfxsum"     , wfx_sum * ztmp  )             ! surface melt 
-      CALL iom_put( "vfxbom"     , wfx_bom * ztmp  )             ! bottom melt 
-      CALL iom_put( "vfxice"     , wfx_ice * ztmp  )             ! total ice growth/melt 
-      CALL iom_put( "vfxsnw"     , wfx_snw * ztmp  )             ! total snw growth/melt 
-      CALL iom_put( "vfxsub"     , wfx_sub * ztmp  )             ! sublimation (snow) 
-      CALL iom_put( "vfxspr"     , wfx_spr * ztmp  )             ! precip (snow) 
-
-      CALL iom_put ('hfxthd', hfx_thd(:,:) )   !  
-      CALL iom_put ('hfxdyn', hfx_dyn(:,:) )   !  
-      CALL iom_put ('hfxres', hfx_res(:,:) )   !  
-      CALL iom_put ('hfxout', hfx_out(:,:) )   !  
-      CALL iom_put ('hfxin' , hfx_in(:,:) )   !  
-      CALL iom_put ('hfxsnw', hfx_snw(:,:) )   !  
-      CALL iom_put ('hfxsub', hfx_sub(:,:) )   !  
-      CALL iom_put ('hfxerr', hfx_err(:,:) )   !  
-      CALL iom_put ('hfxerr_rem', hfx_err_rem(:,:) )   !  
-      
-      CALL iom_put ('hfxsum', hfx_sum(:,:) )   !  
-      CALL iom_put ('hfxbom', hfx_bom(:,:) )   !  
-      CALL iom_put ('hfxbog', hfx_bog(:,:) )   !  
-      CALL iom_put ('hfxdif', hfx_dif(:,:) )   !  
-      CALL iom_put ('hfxopw', hfx_opw(:,:) )   !  
-      CALL iom_put ('hfxtur', fhtur(:,:) * at_i(:,:) )   ! turbulent heat flux at ice base 
-      CALL iom_put ('hfxdhc', diag_heat_dhc(:,:) )          ! Heat content variation in snow and ice 
-      CALL iom_put ('hfxspr', hfx_spr(:,:) )          ! Heat content of snow precip 
+      CALL iom_put( "vfxres"     , wfx_res * ztmp       )        ! daily prod./melting due to limupdate 
+      CALL iom_put( "vfxopw"     , wfx_opw * ztmp       )        ! daily lateral thermodynamic ice production
+      CALL iom_put( "vfxsni"     , wfx_sni * ztmp       )        ! daily snowice ice production
+      CALL iom_put( "vfxbog"     , wfx_bog * ztmp       )        ! daily bottom thermodynamic ice production
+      CALL iom_put( "vfxdyn"     , wfx_dyn * ztmp       )        ! daily dynamic ice production (rid/raft)
+      CALL iom_put( "vfxsum"     , wfx_sum * ztmp       )        ! surface melt 
+      CALL iom_put( "vfxbom"     , wfx_bom * ztmp       )        ! bottom melt 
+      CALL iom_put( "vfxice"     , wfx_ice * ztmp       )        ! total ice growth/melt 
+      CALL iom_put( "vfxsnw"     , wfx_snw * ztmp       )        ! total snw growth/melt 
+      CALL iom_put( "vfxsub"     , wfx_sub * ztmp       )        ! sublimation (snow) 
+      CALL iom_put( "vfxspr"     , wfx_spr * ztmp       )        ! precip (snow)
+      
+      CALL iom_put( "afxtot"     , afx_tot * rday       )        ! concentration tendency (total)
+      CALL iom_put( "afxdyn"     , afx_dyn * rday       )        ! concentration tendency (dynamics)
+      CALL iom_put( "afxthd"     , afx_thd * rday       )        ! concentration tendency (thermo)
+
+      CALL iom_put ('hfxthd'     , hfx_thd(:,:)         )   !  
+      CALL iom_put ('hfxdyn'     , hfx_dyn(:,:)         )   !  
+      CALL iom_put ('hfxres'     , hfx_res(:,:)         )   !  
+      CALL iom_put ('hfxout'     , hfx_out(:,:)         )   !  
+      CALL iom_put ('hfxin'      , hfx_in(:,:)          )   !  
+      CALL iom_put ('hfxsnw'     , hfx_snw(:,:)         )   !  
+      CALL iom_put ('hfxsub'     , hfx_sub(:,:)         )   !  
+      CALL iom_put ('hfxerr'     , hfx_err(:,:)         )   !  
+      CALL iom_put ('hfxerr_rem' , hfx_err_rem(:,:)     )   !  
+      
+      CALL iom_put ('hfxsum'     , hfx_sum(:,:)         )   !  
+      CALL iom_put ('hfxbom'     , hfx_bom(:,:)         )   !  
+      CALL iom_put ('hfxbog'     , hfx_bog(:,:)         )   !  
+      CALL iom_put ('hfxdif'     , hfx_dif(:,:)         )   !  
+      CALL iom_put ('hfxopw'     , hfx_opw(:,:)         )   !  
+      CALL iom_put ('hfxtur'     , fhtur(:,:) * SUM(a_i_b(:,:,:), dim=3) ) ! turbulent heat flux at ice base 
+      CALL iom_put ('hfxdhc'     , diag_heat(:,:)       )   ! Heat content variation in snow and ice 
+      CALL iom_put ('hfxspr'     , hfx_spr(:,:)         )   ! Heat content of snow precip 
       
       !--------------------------------
@@ -239,4 +244,16 @@
       CALL iom_put( "salinity_cat"     , sm_i        )        ! salinity for categories
 
+      ! ice temperature
+      IF ( iom_use( "icetemp_cat" ) ) THEN 
+         zt_i(:,:,:) = SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i
+         CALL iom_put( "icetemp_cat"   , zt_i - rt0  )
+      ENDIF
+      
+      ! snow temperature
+      IF ( iom_use( "snwtemp_cat" ) ) THEN 
+         zt_s(:,:,:) = SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s
+         CALL iom_put( "snwtemp_cat"   , zt_s - rt0  )
+      ENDIF
+
       ! Compute ice age
       IF ( iom_use( "iceage_cat" ) ) THEN 
@@ -244,10 +261,11 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
-                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * rswitch
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) )
+                  rswitch = rswitch * MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - 0.1 ) )
+                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , 0.1 ) * rswitch
                END DO
             END DO
          END DO
-         CALL iom_put( "iceage_cat"     , zoi         )        ! ice age for categories
+         CALL iom_put( "iceage_cat"   , zoi * z1_365 )        ! ice age for categories
       ENDIF
 
@@ -260,12 +278,12 @@
                   DO ji = 1, jpi
                      rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
-                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* &
-                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * &
-                        rswitch / nlay_i
+                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0 *  &
+                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt0 ), - epsi06 ) ) * &
+                        rswitch * r1_nlay_i
                   END DO
                END DO
             END DO
          END DO
-         CALL iom_put( "brinevol_cat"     , zei         )        ! brine volume for categories
+         CALL iom_put( "brinevol_cat"     , zei      )        ! brine volume for categories
       ENDIF
 
@@ -274,5 +292,5 @@
       !     not yet implemented
       
-      CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei )
+      CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s )
       CALL wrk_dealloc( jpi, jpj     , z2d, zswi, z2da, z2db )
 
@@ -348,5 +366,5 @@
       CALL histwrite( kid, "iicethic", kt, icethi        , jpi*jpj, (/1/) )    
       CALL histwrite( kid, "iiceconc", kt, at_i          , jpi*jpj, (/1/) )
-      CALL histwrite( kid, "iicetemp", kt, tm_i - rtt    , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "iicetemp", kt, tm_i - rt0    , jpi*jpj, (/1/) )
       CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) )
       CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90	(revision 5682)
@@ -92,5 +92,5 @@
          zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
          zindb  = zindh * zinda
-         ztmu   = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
+         ztmu   = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) ) 
          zcmo(ji,jj,1)  = ht_s (ji,jj,1)
          zcmo(ji,jj,2)  = ht_i (ji,jj,1)
@@ -99,10 +99,10 @@
          zcmo(ji,jj,5)  = sist  (ji,jj)
          zcmo(ji,jj,6)  = fhtur  (ji,jj)
-         zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
-            + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+         zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * umask(ji,jj,1) + u_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
+            + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
             / ztmu 
 
-         zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
-            + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+         zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * umask(ji,jj,1) + v_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
+            + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
             / ztmu
          zcmo(ji,jj,9)  = sst_m(ji,jj)
@@ -135,5 +135,5 @@
                zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
                zindb  = zindh * zinda
-               ztmu   = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )
+               ztmu   = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) )
                rcmoy(ji,jj,1)  = ht_s (ji,jj,1)
                rcmoy(ji,jj,2)  = ht_i (ji,jj,1)
@@ -142,10 +142,10 @@
                rcmoy(ji,jj,5)  = sist  (ji,jj)
                rcmoy(ji,jj,6)  = fhtur  (ji,jj)
-               rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
-                  + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+               rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * umask(ji,jj,1) + u_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
+                  + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
                   / ztmu
 
-               rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
-                  + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+               rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * umask(ji,jj,1) + v_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
+                  + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
                   / ztmu
                rcmoy(ji,jj,9)  = sst_m(ji,jj)
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90	(revision 5659)
+++ 	(revision )
@@ -1,25 +1,0 @@
-MODULE par_ice
-   !!======================================================================
-   !!                       ***  MODULE par_ice   ***
-   !! LIM-3 Sea Ice :   definition of parameters
-   !!======================================================================
-   !! History :  3.0  ! 2003-08  (M. Vancoppenolle)  LIM-3
-   !!----------------------------------------------------------------------
-   USE par_oce
-
-   IMPLICIT NONE
-   PUBLIC          
-
-   !                                             !!! ice thermodynamics
-   INTEGER, PUBLIC, PARAMETER ::   nlay_i   = 5   !: number of ice layers
-   INTEGER, PUBLIC, PARAMETER ::   nlay_s   = 1   !: number of snow layers
-
-   !                                             !!! ice mechanical redistribution
-   INTEGER, PUBLIC, PARAMETER ::   jpl      = 5   !: number of ice categories
-
-   !!----------------------------------------------------------------------
-   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!======================================================================
-END MODULE par_ice
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 5682)
@@ -6,7 +6,7 @@
    !! History :  3.0  !  2002-11  (C. Ethe)  F90: Free form and module
    !!----------------------------------------------------------------------
-   USE par_ice        ! LIM-3 parameters
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
+   USE ice, ONLY :   nlay_i, nlay_s
 
    IMPLICIT NONE
@@ -19,14 +19,11 @@
    !!---------------------------
    !                               !!! ** ice-thermo namelist (namicethd) **
-   REAL(wp), PUBLIC ::   hmelt       !: maximum melting at the bottom; active only for one category
-   REAL(wp), PUBLIC ::   hiclim      !: minimum ice thickness
-   REAL(wp), PUBLIC ::   hnzst       !: thick. of the surf. layer in temp. comp.
-   REAL(wp), PUBLIC ::   parsub      !: switch for snow sublimation or not
-   REAL(wp), PUBLIC ::   maxfrazb    !: maximum portion of frazil ice collecting at the ice bottom
-   REAL(wp), PUBLIC ::   vfrazb      !: threshold drift speed for collection of bottom frazil ice
-   REAL(wp), PUBLIC ::   Cfrazb      !: squeezing coefficient for collection of bottom frazil ice
-   REAL(wp), PUBLIC ::   hiccrit     !: ice th. for lateral accretion in the NH (SH) (m)
+   REAL(wp), PUBLIC ::   rn_himin    !: minimum ice thickness
+   REAL(wp), PUBLIC ::   rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom
+   REAL(wp), PUBLIC ::   rn_vfrazb   !: threshold drift speed for collection of bottom frazil ice
+   REAL(wp), PUBLIC ::   rn_Cfrazb   !: squeezing coefficient for collection of bottom frazil ice
+   REAL(wp), PUBLIC ::   rn_hnewice  !: thickness for new ice formation (m)
 
-   INTEGER , PUBLIC ::   fraz_swi    !: use of frazil ice collection in function of wind (1) or not (0)
+   LOGICAL , PUBLIC ::   ln_frazil   !: use of frazil ice collection as function of wind (T) or not (F)
 
    !!-----------------------------
@@ -37,6 +34,7 @@
    !: are the variables corresponding to 2d vectors
 
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: number of points where computations has to be done
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: correspondance between points (lateral accretion)
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: address vector for 1d vertical thermo computations
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nplm   !: address vector for mono-category lateral melting
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: address vector for new ice formation
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d     
@@ -56,4 +54,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_1d
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_dif_1d
 
    ! heat flux associated with ice-atmosphere mass exchange
@@ -90,7 +89,6 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qla_ice_1d    !: <==> the 2D  qla_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqla_ice_1d   !: <==> the 2D  dqla_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tatm_ice_1d   !: <==> the 2D  tatm_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   evap_ice_1d   !: <==> the 2D  evap_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qprec_ice_1d  !: <==> the 2D  qprec_ice
    !                                                     ! to reintegrate longwave flux inside the ice thermodynamics
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice
@@ -140,35 +138,31 @@
       !!---------------------------------------------------------------------!
 
-      ALLOCATE( npb      (jpij) , npac     (jpij),                          &
-         !                                                                  !
-         &      qlead_1d (jpij) , ftr_ice_1d  (jpij) ,     &
-         &      qsr_ice_1d (jpij) ,     &
-         &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) ,     &
-         &      t_bo_1d   (jpij) ,                                          &
-         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,     & 
-         &      hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , &
-         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , &
-         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , &
-         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij),       STAT=ierr(1) )
+      ALLOCATE( npb      (jpij) , nplm      (jpij) , npac       (jpij) ,   &
+         &      qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) ,   &
+         &      fr1_i0_1d(jpij) , fr2_i0_1d (jpij) , qns_ice_1d(jpij)  ,   &
+         &      t_bo_1d   (jpij) ,                                         &
+         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,    & 
+         &      hfx_dif_1d(jpij) , hfx_opw_1d(jpij) ,                      &
+         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) ,                      &
+         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) ,   &
+         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(1) )
       !
-      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d     (jpij) ,     &
-         &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,     &
-         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , &
-         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) ,  wfx_res_1d (jpij) ,  &
-         &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,     &
-         &      tatm_ice_1d(jpij) ,      &   
-         &      i0         (jpij) ,     &  
-         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) ,   &
-         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , &
-         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,     &     
+      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d    (jpij) ,                     &
+         &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,                     &
+         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) ,  &
+         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) ,  &
+         &      dqns_ice_1d(jpij) , evap_ice_1d (jpij),                                         &
+         &      qprec_ice_1d(jpij), i0         (jpij) ,                                         &  
+         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij),  &
+         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) ,                     &
+         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,                     &     
          &      dsm_i_si_1d(jpij) , hicol_1d    (jpij)                     , STAT=ierr(2) )
       !
-      ALLOCATE( t_su_1d    (jpij) , a_i_1d    (jpij) , ht_i_1d   (jpij) ,    &   
-         &      ht_s_1d    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &    
+      ALLOCATE( t_su_1d   (jpij) , a_i_1d   (jpij) , ht_i_1d  (jpij) ,    &   
+         &      ht_s_1d   (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &    
          &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &    
-         &      dh_snowice(jpij) , sm_i_1d   (jpij) , s_i_new  (jpij) ,    &
-         &      t_s_1d(jpij,nlay_s),                                       &
-         &      t_i_1d(jpij,nlay_i+1), s_i_1d(jpij,nlay_i+1)                ,     &            
-         &      q_i_1d(jpij,nlay_i+1), q_s_1d(jpij,nlay_i+1)                ,     &
+         &      dh_snowice(jpij) , sm_i_1d  (jpij) , s_i_new  (jpij) ,    &
+         &      t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) ,  &            
+         &      q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) ,                        &
          &      qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3))
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif2model.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 5682)
@@ -1,62 +1,64 @@
 #if defined key_agrif
-   !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-   SUBROUTINE Agrif2Model
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif2Model ***
-      !!--------------------------------------------- 
-   END SUBROUTINE Agrif2model
+!!----------------------------------------------------------------------
+!! NEMO/NST 3.6 , NEMO Consortium (2010)
+!! $Id$
+!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+!!----------------------------------------------------------------------
+SUBROUTINE Agrif2Model
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif2Model ***
+   !!--------------------------------------------- 
+END SUBROUTINE Agrif2model
 
-   SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr)
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_Set_numberofcells ***
-      !!--------------------------------------------- 
-      USE Agrif_Types
-      IMPLICIT NONE
+SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr)
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_Set_numberofcells ***
+   !!--------------------------------------------- 
+   USE Agrif_Grids
+   IMPLICIT NONE
 
-      Type(Agrif_Grid), Pointer :: Agrif_Gr
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
 
-      IF ( associated(Agrif_Curgrid) )THEN
+   IF ( ASSOCIATED(Agrif_Curgrid) )THEN
 #include "SetNumberofcells.h"
-      ENDIF
+   ENDIF
 
-   END SUBROUTINE Agrif_Set_numberofcells
+END SUBROUTINE Agrif_Set_numberofcells
 
-   SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr)
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_Get_numberofcells ***
-      !!--------------------------------------------- 
-      USE Agrif_Types
-      IMPLICIT NONE
+SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr)
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_Get_numberofcells ***
+   !!--------------------------------------------- 
+   USE Agrif_Grids
+   IMPLICIT NONE
 
-      Type(Agrif_Grid), Pointer :: Agrif_Gr
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
 
+   IF ( ASSOCIATED(Agrif_Curgrid) ) THEN
 #include "GetNumberofcells.h"
+   ENDIF
 
-   END SUBROUTINE Agrif_Get_numberofcells
+END SUBROUTINE Agrif_Get_numberofcells
 
-   SUBROUTINE Agrif_Allocationcalls(Agrif_Gr)
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_Allocationscalls ***
-      !!--------------------------------------------- 
-      USE Agrif_Types 
+SUBROUTINE Agrif_Allocationcalls(Agrif_Gr)
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_Allocationscalls ***
+   !!--------------------------------------------- 
+   USE Agrif_Grids 
 #include "include_use_Alloc_agrif.h"
-      IMPLICIT NONE
+   IMPLICIT NONE
 
-      Type(Agrif_Grid), Pointer :: Agrif_Gr
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
 
 #include "allocations_calls_agrif.h"
 
-   END SUBROUTINE Agrif_Allocationcalls
+END SUBROUTINE Agrif_Allocationcalls
 
-   SUBROUTINE Agrif_probdim_modtype_def()
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_probdim_modtype_def ***
-      !!--------------------------------------------- 
-      USE Agrif_Types
-      IMPLICIT NONE
+SUBROUTINE Agrif_probdim_modtype_def()
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_probdim_modtype_def ***
+   !!--------------------------------------------- 
+   USE Agrif_Types
+   IMPLICIT NONE
 
 #include "modtype_agrif.h"
@@ -64,43 +66,24 @@
 #include "keys_agrif.h"
 
-      Return
+   RETURN
 
-   END SUBROUTINE Agrif_probdim_modtype_def
+END SUBROUTINE Agrif_probdim_modtype_def
 
-   SUBROUTINE Agrif_clustering_def()
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_clustering_def ***
-      !!--------------------------------------------- 
-      Use Agrif_Types
-      IMPLICIT NONE
+SUBROUTINE Agrif_clustering_def()
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_clustering_def ***
+   !!--------------------------------------------- 
+   IMPLICIT NONE
 
-      Return
+   RETURN
 
-   END SUBROUTINE Agrif_clustering_def
+END SUBROUTINE Agrif_clustering_def
 
-   SUBROUTINE Agrif_comm_def(modelcomm)
-
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif_clustering_def ***
-      !!--------------------------------------------- 
-      Use Agrif_Types
-      Use lib_mpp
-
-      IMPLICIT NONE
-
-      INTEGER :: modelcomm
-
-#if defined key_mpp_mpi
-      modelcomm = mpi_comm_opa
+#else
+SUBROUTINE Agrif2Model
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif2Model ***
+   !!--------------------------------------------- 
+   WRITE(*,*) 'Impossible to bet here'
+END SUBROUTINE Agrif2model
 #endif
-      Return
-
-   END SUBROUTINE Agrif_comm_def
-#else
-   SUBROUTINE Agrif2Model
-      !!---------------------------------------------
-      !!   *** ROUTINE Agrif2Model ***
-      !!--------------------------------------------- 
-      WRITE(*,*) 'Impossible to bet here'
-   END SUBROUTINE Agrif2model
-#endif
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90	(revision 5682)
@@ -9,5 +9,5 @@
    !!            3.4   !  09-2012  (R. Benshila, C. Herbaut) update and EVP
    !!----------------------------------------------------------------------
-#if defined key_agrif && defined key_lim2
+#if defined key_agrif && defined key_lim2 
    !!----------------------------------------------------------------------
    !!   'key_lim2'  :                                 LIM 2.0 sea-ice model
@@ -41,4 +41,8 @@
    PUBLIC interp_adv_ice
 
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PRIVATE :: uice_agr, vice_agr
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PRIVATE :: tabice_agr 
+
+
    !!----------------------------------------------------------------------
    !! NEMO/NST 3.4 , NEMO Consortium (2012)
@@ -65,6 +69,6 @@
       u_ice_nst(:,:) = 0.
       v_ice_nst(:,:) = 0.
-      CALL Agrif_Bc_variable( u_ice_nst, u_ice_id ,procname=interp_u_ice, calledweight=1. )
-      CALL Agrif_Bc_variable( v_ice_nst, v_ice_id ,procname=interp_v_ice, calledweight=1. )
+      CALL Agrif_Bc_variable( u_ice_id ,procname=interp_u_ice, calledweight=1. )
+      CALL Agrif_Bc_variable( v_ice_id ,procname=interp_v_ice, calledweight=1. )
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .FALSE.
@@ -138,5 +142,4 @@
       !!  we are in inside a new parent ice time step
       !!-----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj) :: zuice, zvice
       INTEGER :: ji,jj
       REAL(wp) :: zrhox, zrhoy
@@ -155,33 +158,36 @@
          Agrif_SpecialValue=-9999.
          Agrif_UseSpecialValue = .TRUE.
-         zuice = 0.
-         zvice = 0.
-         CALL Agrif_Bc_variable(zuice,u_ice_id,procname=interp_u_ice, calledweight=1.)
-         CALL Agrif_Bc_variable(zvice,v_ice_id,procname=interp_v_ice, calledweight=1.)
+         IF( .NOT. ALLOCATED(uice_agr) )THEN
+            ALLOCATE(uice_agr(jpi,jpj), vice_agr(jpi,jpj))
+         ENDIF
+         uice_agr = 0.
+         vice_agr = 0.
+         CALL Agrif_Bc_variable(u_ice_id,procname=interp_u_ice, calledweight=1.)
+         CALL Agrif_Bc_variable(v_ice_id,procname=interp_v_ice, calledweight=1.)
          Agrif_SpecialValue=0.
          Agrif_UseSpecialValue = .FALSE.
          !  
          zrhox = agrif_rhox() ;    zrhoy = agrif_rhoy()      
-         zuice(:,:) =  zuice(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)
-         zvice(:,:) =  zvice(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)
+         uice_agr(:,:) =  uice_agr(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)
+         vice_agr(:,:) =  vice_agr(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)
          ! fill  boundaries
          DO jj = 1, jpj
             DO ji = 1, 2
-               u_ice_oe(ji,  jj,2) = zuice(ji       ,jj) 
-               u_ice_oe(ji+2,jj,2) = zuice(nlci+ji-3,jj)
+               u_ice_oe(ji,  jj,2) = uice_agr(ji       ,jj) 
+               u_ice_oe(ji+2,jj,2) = uice_agr(nlci+ji-3,jj)
             END DO
          END DO
          DO jj = 1, jpj
-            v_ice_oe(2,jj,2) = zvice(2     ,jj) 
-            v_ice_oe(4,jj,2) = zvice(nlci-1,jj)
+            v_ice_oe(2,jj,2) = vice_agr(2     ,jj) 
+            v_ice_oe(4,jj,2) = vice_agr(nlci-1,jj)
          END DO
          DO ji = 1, jpi
-            u_ice_sn(ji,2,2) = zuice(ji,2     ) 
-            u_ice_sn(ji,4,2) = zuice(ji,nlcj-1)
+            u_ice_sn(ji,2,2) = uice_agr(ji,2     ) 
+            u_ice_sn(ji,4,2) = uice_agr(ji,nlcj-1)
          END DO
          DO jj = 1, 2
             DO ji = 1, jpi
-               v_ice_sn(ji,jj  ,2) = zvice(ji,jj       ) 
-               v_ice_sn(ji,jj+2,2) = zvice(ji,nlcj+jj-3)
+               v_ice_sn(ji,jj  ,2) = vice_agr(ji,jj       ) 
+               v_ice_sn(ji,jj+2,2) = vice_agr(ji,nlcj+jj-3)
             END DO
          END DO
@@ -334,5 +340,4 @@
       !!  we are in inside a new parent ice time step
      !!-----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 
       INTEGER :: ji,jj,jn
       !!-----------------------------------------------------------------------
@@ -345,8 +350,11 @@
          adv_ice_sn(:,:,:,1) =  adv_ice_sn(:,:,:,2)
          ! interpolation of boundaries
-         ztab(:,:,:) = 0.
+         IF(.NOT.ALLOCATED(tabice_agr))THEN
+            ALLOCATE(tabice_agr(jpi,jpj,7))   
+         ENDIF
+         tabice_agr(:,:,:) = 0.
          Agrif_SpecialValue=-9999.
          Agrif_UseSpecialValue = .TRUE.
-         CALL Agrif_Bc_variable( ztab, adv_ice_id ,procname=interp_adv_ice,calledweight=1. )
+         CALL Agrif_Bc_variable( adv_ice_id ,procname=interp_adv_ice,calledweight=1. )
          Agrif_SpecialValue=0.
          Agrif_UseSpecialValue = .FALSE.
@@ -356,6 +364,6 @@
             DO jj = 1, jpj
                DO ji=1,2
-                  adv_ice_oe(ji  ,jj,jn,2) = ztab(ji       ,jj,jn) 
-                  adv_ice_oe(ji+2,jj,jn,2) = ztab(nlci-2+ji,jj,jn)
+                  adv_ice_oe(ji  ,jj,jn,2) = tabice_agr(ji       ,jj,jn) 
+                  adv_ice_oe(ji+2,jj,jn,2) = tabice_agr(nlci-2+ji,jj,jn)
                END DO
             END DO
@@ -365,6 +373,6 @@
             Do jj =1,2
                DO ji = 1, jpi
-                  adv_ice_sn(ji,jj  ,jn,2) = ztab(ji,jj       ,jn) 
-                  adv_ice_sn(ji,jj+2,jn,2) = ztab(ji,nlcj-2+jj,jn)
+                  adv_ice_sn(ji,jj  ,jn,2) = tabice_agr(ji,jj       ,jn) 
+                  adv_ice_sn(ji,jj+2,jn,2) = tabice_agr(ji,nlcj-2+jj,jn)
                END DO
             END DO
@@ -384,5 +392,5 @@
       INTEGER :: ji,jj,jn
       REAL(wp) :: zalpha
-      REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 
+      REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr 
       !!-----------------------------------------------------------------------      
       !
@@ -391,10 +399,10 @@
       zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc))
       !
-      ztab(:,:,:) = 0.e0
+      tabice_agr(:,:,:) = 0.e0
       DO jn =1,7
          DO jj =1,2
             DO ji = 1, jpi
-               ztab(ji,jj        ,jn) = (1-zalpha)*adv_ice_sn(ji,jj  ,jn,1) + zalpha*adv_ice_sn(ji,jj  ,jn,2) 
-               ztab(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) 
+               tabice_agr(ji,jj        ,jn) = (1-zalpha)*adv_ice_sn(ji,jj  ,jn,1) + zalpha*adv_ice_sn(ji,jj  ,jn,2) 
+               tabice_agr(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) 
             END DO
          END DO
@@ -404,17 +412,17 @@
          DO jj = 1, jpj
             DO ji=1,2
-               ztab(ji       ,jj,jn) = (1-zalpha)*adv_ice_oe(ji  ,jj,jn,1) + zalpha*adv_ice_oe(ji  ,jj,jn,2) 
-               ztab(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) 
+               tabice_agr(ji       ,jj,jn) = (1-zalpha)*adv_ice_oe(ji  ,jj,jn,1) + zalpha*adv_ice_oe(ji  ,jj,jn,2) 
+               tabice_agr(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) 
             END DO
          END DO
       END DO
       !
-      CALL parcoursT( ztab(:,:, 1), frld  )
-      CALL parcoursT( ztab(:,:, 2), hicif )
-      CALL parcoursT( ztab(:,:, 3), hsnif )
-      CALL parcoursT( ztab(:,:, 4), tbif(:,:,1) )
-      CALL parcoursT( ztab(:,:, 5), tbif(:,:,2) )
-      CALL parcoursT( ztab(:,:, 6), tbif(:,:,3) )
-      CALL parcoursT( ztab(:,:, 7), qstoif )
+      CALL parcoursT( tabice_agr(:,:, 1), frld  )
+      CALL parcoursT( tabice_agr(:,:, 2), hicif )
+      CALL parcoursT( tabice_agr(:,:, 3), hsnif )
+      CALL parcoursT( tabice_agr(:,:, 4), tbif(:,:,1) )
+      CALL parcoursT( tabice_agr(:,:, 5), tbif(:,:,2) )
+      CALL parcoursT( tabice_agr(:,:, 6), tbif(:,:,3) )
+      CALL parcoursT( tabice_agr(:,:, 7), qstoif )
       !
    END SUBROUTINE agrif_trp_lim2
@@ -499,5 +507,5 @@
 
 
-   SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2 )
+   SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2, before )
       !!-----------------------------------------------------------------------
       !!                     *** ROUTINE interp_u_ice ***
@@ -505,4 +513,5 @@
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
       !!
       INTEGER :: ji,jj
@@ -510,28 +519,32 @@
       !
 #if defined key_lim2_vp
-      DO jj=MAX(j1,2),j2
-         DO ji=MAX(i1,2),i2
-            IF( tmu(ji,jj) == 0. ) THEN
-               tabres(ji,jj) = -9999.
-            ELSE
-               tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
-            ENDIF
-         END DO
-      END DO
+      IF( before ) THEN
+         DO jj=MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               IF( tmu(ji,jj) == 0. ) THEN
+                  tabres(ji,jj) = -9999.
+               ELSE
+                  tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
+               ENDIF
+            END DO
+         END DO
+      ENDIF
 #else
-      DO jj= j1, j2
-         DO ji= i1, i2
-            IF( umask(ji,jj,1) == 0. ) THEN
-               tabres(ji,jj) = -9999.
-            ELSE
-               tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
-            ENDIF
-         END DO
-      END DO
+      IF( before ) THEN
+         DO jj= j1, j2
+            DO ji= i1, i2
+               IF( umask(ji,jj,1) == 0. ) THEN
+                  tabres(ji,jj) = -9999.
+               ELSE
+                  tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
+               ENDIF
+            END DO
+         END DO
+      ENDIF
 #endif
    END SUBROUTINE interp_u_ice
 
 
-   SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2 )
+   SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2, before )
       !!-----------------------------------------------------------------------
       !!                    *** ROUTINE interp_v_ice ***
@@ -539,4 +552,5 @@
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
       !!
       INTEGER :: ji, jj
@@ -544,28 +558,32 @@
       !
 #if defined key_lim2_vp
-      DO jj=MAX(j1,2),j2
-         DO ji=MAX(i1,2),i2
-            IF( tmu(ji,jj) == 0. ) THEN
-               tabres(ji,jj) = -9999.
-            ELSE
-               tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
-            ENDIF
-         END DO
-      END DO
+      IF( before ) THEN
+         DO jj=MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               IF( tmu(ji,jj) == 0. ) THEN
+                  tabres(ji,jj) = -9999.
+               ELSE
+                  tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
+               ENDIF
+            END DO
+         END DO
+      ENDIF   
 #else
-      DO jj= j1 ,j2
-         DO ji = i1, i2
-            IF( vmask(ji,jj,1) == 0. ) THEN
-               tabres(ji,jj) = -9999.
-            ELSE
-               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
-            ENDIF
-         END DO
-      END DO
+      IF( before ) THEN
+	      DO jj= j1 ,j2
+	         DO ji = i1, i2
+	            IF( vmask(ji,jj,1) == 0. ) THEN
+	               tabres(ji,jj) = -9999.
+	            ELSE
+	               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
+	            ENDIF
+	         END DO
+	      END DO
+      ENDIF
 #endif
    END SUBROUTINE interp_v_ice
 
 
-   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2 )
+   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, before )
       !!-----------------------------------------------------------------------
       !!                    *** ROUTINE interp_adv_ice ***                           
@@ -577,23 +595,26 @@
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
       !!
       INTEGER :: ji, jj, jk
       !!-----------------------------------------------------------------------
       !
-      DO jj=j1,j2
-         DO ji=i1,i2
-            IF( tms(ji,jj) == 0. ) THEN
-               tabres(ji,jj,:) = -9999. 
-            ELSE
-               tabres(ji,jj, 1) = frld  (ji,jj)
-               tabres(ji,jj, 2) = hicif (ji,jj)
-               tabres(ji,jj, 3) = hsnif (ji,jj)
-               tabres(ji,jj, 4) = tbif  (ji,jj,1)
-               tabres(ji,jj, 5) = tbif  (ji,jj,2)
-               tabres(ji,jj, 6) = tbif  (ji,jj,3)
-               tabres(ji,jj, 7) = qstoif(ji,jj)
-            ENDIF
-         END DO
-      END DO
+      IF( before ) THEN
+	      DO jj=j1,j2
+	         DO ji=i1,i2
+	            IF( tms(ji,jj) == 0. ) THEN
+	               tabres(ji,jj,:) = -9999. 
+	            ELSE
+	               tabres(ji,jj, 1) = frld  (ji,jj)
+	               tabres(ji,jj, 2) = hicif (ji,jj)
+	               tabres(ji,jj, 3) = hsnif (ji,jj)
+	               tabres(ji,jj, 4) = tbif  (ji,jj,1)
+	               tabres(ji,jj, 5) = tbif  (ji,jj,2)
+	               tabres(ji,jj, 6) = tbif  (ji,jj,3)
+	               tabres(ji,jj, 7) = qstoif(ji,jj)
+	            ENDIF
+	         END DO
+	      END DO
+      ENDIF
       !
    END SUBROUTINE interp_adv_ice
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90	(revision 5682)
@@ -52,6 +52,4 @@
       INTEGER, INTENT(in) :: kt
       !!
-      REAL(wp), DIMENSION(jpi,jpj)  :: zvel
-      REAL(wp), DIMENSION(jpi,jpj,7):: zadv
       !!----------------------------------------------------------------------
       !
@@ -60,14 +58,13 @@
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
-
 # if defined TWO_WAY
       IF( MOD(nbcline,nbclineupdate) == 0) THEN
-         CALL Agrif_Update_Variable( zadv , adv_ice_id , procname = update_adv_ice  )
-         CALL Agrif_Update_Variable( zvel , u_ice_id   , procname = update_u_ice    )
-         CALL Agrif_Update_Variable( zvel , v_ice_id   , procname = update_v_ice    )
-      ELSE
-         CALL Agrif_Update_Variable( zadv , adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  )
-         CALL Agrif_Update_Variable( zvel , u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
-         CALL Agrif_Update_Variable( zvel , v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
+         CALL Agrif_Update_Variable( adv_ice_id , procname = update_adv_ice  )
+         CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
+         CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
+      ELSE
+         CALL Agrif_Update_Variable( adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  )
+         CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
+         CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
       ENDIF
 # endif
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 5682)
@@ -12,5 +12,5 @@
    USE par_oce      ! ocean parameters
    USE dom_oce      ! domain parameters
-   
+
    IMPLICIT NONE
    PRIVATE 
@@ -19,8 +19,10 @@
 
    !                                              !!* Namelist namagrif: AGRIF parameters
-   LOGICAL , PUBLIC ::   ln_spc_dyn      !:
-   INTEGER , PUBLIC ::   nn_cln_update   !: update frequency 
-   REAL(wp), PUBLIC ::   rn_sponge_tra   !: sponge coeff. for tracers
-   REAL(wp), PUBLIC ::   rn_sponge_dyn   !: sponge coeff. for dynamics
+   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !:
+   INTEGER , PUBLIC ::   nn_cln_update = 3         !: update frequency 
+   INTEGER , PUBLIC, PARAMETER ::   nn_sponge_len = 2  !: Sponge width (in number of parent grid points)
+   REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers
+   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics
+   LOGICAL , PUBLIC ::   ln_chk_bathy  = .FALSE.   !: check of parent bathymetry 
 
    !                                              !!! OLD namelist names
@@ -30,16 +32,42 @@
    REAL(wp), PUBLIC ::   visc_dyn                  !: sponge coeff. for dynamics
 
-   LOGICAL , PUBLIC :: spongedoneT = .FALSE.   !: tracer   sponge layer indicator
-   LOGICAL , PUBLIC :: spongedoneU = .FALSE.   !: dynamics sponge layer indicator
-   LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE. !: if true: first step
+   LOGICAL , PUBLIC :: spongedoneT = .FALSE.       !: tracer   sponge layer indicator
+   LOGICAL , PUBLIC :: spongedoneU = .FALSE.       !: dynamics sponge layer indicator
+   LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE.     !: if true: first step
+   LOGICAL , PUBLIC :: lk_agrif_doupd = .TRUE.     !: if true: send update from current grid
+   LOGICAL , PUBLIC :: lk_agrif_debug = .FALSE.    !: if true: print debugging info
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur , spe2vr , spbtr2   !: ???
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur2, spe2vr2, spbtr3   !: ???
-   
-   INTEGER :: tsn_id,tsb_id,tsa_id
-   INTEGER :: un_id, vn_id, ua_id, va_id
-   INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id
-   INTEGER :: trn_id, trb_id, tra_id
-   INTEGER :: unb_id, vnb_id, ub2b_id, vb2b_id
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_tsn
+# if defined key_top
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_trn
+# endif
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_u
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_v
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) :: fsaht_spu, fsaht_spv !: sponge diffusivities
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) :: fsahm_spt, fsahm_spf !: sponge viscosities
+
+   ! Barotropic arrays used to store open boundary data during
+   ! time-splitting loop:
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_w, vbdy_w, hbdy_w
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_e, vbdy_e, hbdy_e
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_n, vbdy_n, hbdy_n
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_s, vbdy_s, hbdy_s
+
+   INTEGER :: tsn_id                                                  ! AGRIF profile for tracers interpolation and update
+   INTEGER :: un_interp_id, vn_interp_id                              ! AGRIF profiles for interpolations
+   INTEGER :: un_update_id, vn_update_id                              ! AGRIF profiles for udpates
+   INTEGER :: tsn_sponge_id, un_sponge_id, vn_sponge_id               ! AGRIF profiles for sponge layers
+# if defined key_top
+   INTEGER :: trn_id, trn_sponge_id
+# endif  
+   INTEGER :: unb_id, vnb_id, ub2b_interp_id, vb2b_interp_id
+   INTEGER :: ub2b_update_id, vb2b_update_id
+   INTEGER :: e3t_id, e1u_id, e2v_id, sshn_id
+   INTEGER :: scales_t_id
+# if defined key_zdftke
+   INTEGER :: avt_id, avm_id, en_id
+# endif  
+   INTEGER :: umsk_id, vmsk_id
+   INTEGER :: kindic_agr
 
    !!----------------------------------------------------------------------
@@ -54,6 +82,24 @@
       !!                ***  FUNCTION agrif_oce_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( spe1ur (jpi,jpj) , spe2vr (jpi,jpj) , spbtr2(jpi,jpj) ,      &
-         &      spe1ur2(jpi,jpj) , spe2vr2(jpi,jpj) , spbtr3(jpi,jpj) , STAT = agrif_oce_alloc ) 
+      INTEGER, DIMENSION(2) :: ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( fsaht_spu(jpi,jpj), fsaht_spv(jpi,jpj),   &
+         &      fsahm_spt(jpi,jpj), fsahm_spf(jpi,jpj),   &
+         &      tabspongedone_tsn(jpi,jpj),           &
+# if defined key_top         
+         &      tabspongedone_trn(jpi,jpj),           &
+# endif         
+         &      tabspongedone_u  (jpi,jpj),           &
+         &      tabspongedone_v  (jpi,jpj), STAT = ierr(1) )
+
+      ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj),   &
+         &      ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj),   & 
+         &      ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi),   & 
+         &      ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi), STAT = ierr(2) )
+
+      agrif_oce_alloc = MAXVAL(ierr)
+      !
    END FUNCTION agrif_oce_alloc
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 5682)
@@ -7,4 +7,5 @@
    !!             -   !  2005-11  (XXX) 
    !!            3.2  !  2009-04  (R. Benshila) 
+   !!            3.6  !  2014-09  (R. Benshila) 
    !!----------------------------------------------------------------------
 #if defined key_agrif && ! defined key_offline
@@ -29,139 +30,42 @@
    USE wrk_nemo
    USE dynspg_oce
-
+   USE zdf_oce
+ 
    IMPLICIT NONE
    PRIVATE
 
-   ! Barotropic arrays used to store open boundary data during
-   ! time-splitting loop:
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_w, vbdy_w, hbdy_w
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_e, vbdy_e, hbdy_e
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_n, vbdy_n, hbdy_n
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_s, vbdy_s, hbdy_s
-    
+   INTEGER :: bdy_tinterp = 0
+
    PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts
-   PUBLIC   interpu, interpv, interpunb, interpvnb, interpsshn
+   PUBLIC   interpun, interpvn, interpun2d, interpvn2d 
+   PUBLIC   interptsn,  interpsshn
+   PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b
+   PUBLIC   interpe3t, interpumsk, interpvmsk
+# if defined key_zdftke
+   PUBLIC   Agrif_tke, interpavm
+# endif
 
 #  include "domzgr_substitute.h90"  
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.6 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
-   CONTAINS
-   
+CONTAINS
+
    SUBROUTINE Agrif_tra
       !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_Tra  ***
-      !!----------------------------------------------------------------------
-      !!
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3
-      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsa
+      !!                  ***  ROUTINE Agrif_tra  ***
       !!----------------------------------------------------------------------
       !
       IF( Agrif_Root() )   RETURN
-
-      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztsa ) 
 
       Agrif_SpecialValue    = 0.e0
       Agrif_UseSpecialValue = .TRUE.
-      ztsa(:,:,:,:) = 0.e0
-
-      CALL Agrif_Bc_variable( ztsa, tsn_id, procname=interptsn )
+
+      CALL Agrif_Bc_variable( tsn_id, procname=interptsn )
       Agrif_UseSpecialValue = .FALSE.
-
-      zrhox = Agrif_Rhox()
-
-      alpha1 = ( zrhox - 1. ) * 0.5
-      alpha2 = 1. - alpha1
-
-      alpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
-      alpha4 = 1. - alpha3
-
-      alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
-      alpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
-      alpha5 = 1. - alpha6 - alpha7
-
-      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
-
-         DO jn = 1, jpts
-            tsa(nlci,:,:,jn) = alpha1 * ztsa(nlci,:,:,jn) + alpha2 * ztsa(nlci-1,:,:,jn)
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
-                     tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
-                  ELSE
-                     tsa(nlci-1,jj,jk,jn)=(alpha4*tsa(nlci,jj,jk,jn)+alpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
-                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
-                        tsa(nlci-1,jj,jk,jn)=( alpha6*tsa(nlci-2,jj,jk,jn)+alpha5*tsa(nlci,jj,jk,jn)  &
-                           &                 + alpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         ENDDO
-      ENDIF
-
-      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
-
-         DO jn = 1, jpts
-            tsa(:,nlcj,:,jn) = alpha1 * ztsa(:,nlcj,:,jn) + alpha2 * ztsa(:,nlcj-1,:,jn)
-            DO jk = 1, jpkm1
-               DO ji = 1, jpi
-                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
-                     tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
-                  ELSE
-                     tsa(ji,nlcj-1,jk,jn)=(alpha4*tsa(ji,nlcj,jk,jn)+alpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
-                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
-                        tsa(ji,nlcj-1,jk,jn)=( alpha6*tsa(ji,nlcj-2,jk,jn)+alpha5*tsa(ji,nlcj,jk,jn)  &
-                           &                 + alpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         ENDDO 
-      ENDIF
-
-      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
-         DO jn = 1, jpts
-            tsa(1,:,:,jn) = alpha1 * ztsa(1,:,:,jn) + alpha2 * ztsa(2,:,:,jn)
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  IF( umask(2,jj,jk) == 0.e0 ) THEN
-                     tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
-                  ELSE
-                     tsa(2,jj,jk,jn)=(alpha4*tsa(1,jj,jk,jn)+alpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
-                     IF( un(2,jj,jk) < 0.e0 ) THEN
-                        tsa(2,jj,jk,jn)=(alpha6*tsa(3,jj,jk,jn)+alpha5*tsa(1,jj,jk,jn)+alpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      ENDIF
-
-      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
-         DO jn = 1, jpts
-            tsa(:,1,:,jn) = alpha1 * ztsa(:,1,:,jn) + alpha2 * ztsa(:,2,:,jn)
-            DO jk=1,jpk      
-               DO ji=1,jpi
-                  IF( vmask(ji,2,jk) == 0.e0 ) THEN
-                     tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
-                  ELSE
-                     tsa(ji,2,jk,jn)=(alpha4*tsa(ji,1,jk,jn)+alpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
-                     IF( vn(ji,2,jk) < 0.e0 ) THEN
-                        tsa(ji,2,jk,jn)=(alpha6*tsa(ji,3,jk,jn)+alpha5*tsa(ji,1,jk,jn)+alpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         ENDDO
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztsa ) 
       !
    END SUBROUTINE Agrif_tra
@@ -175,16 +79,27 @@
       INTEGER, INTENT(in) ::   kt
       !!
-      INTEGER :: ji,jj,jk
+      INTEGER :: ji,jj,jk, j1,j2, i1,i2
       REAL(wp) :: timeref
       REAL(wp) :: z2dt, znugdt
       REAL(wp) :: zrhox, zrhoy
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zua, zva
-      REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1, zua2d, zva2d
+      REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1
       !!----------------------------------------------------------------------  
 
       IF( Agrif_Root() )   RETURN
 
-      CALL wrk_alloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d )
-      CALL wrk_alloc( jpi, jpj, jpk, zua, zva )
+      CALL wrk_alloc( jpi, jpj, spgv1, spgu1 )
+
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+
+      CALL Agrif_Bc_variable(un_interp_id,procname=interpun)
+      CALL Agrif_Bc_variable(vn_interp_id,procname=interpvn)
+
+#if defined key_dynspg_flt
+      CALL Agrif_Bc_variable(e1u_id,calledweight=1., procname=interpun2d)
+      CALL Agrif_Bc_variable(e2v_id,calledweight=1., procname=interpvn2d)
+#endif
+
+      Agrif_UseSpecialValue = .FALSE.
 
       zrhox = Agrif_Rhox()
@@ -192,5 +107,4 @@
 
       timeref = 1.
-
       ! time step: leap-frog
       z2dt = 2. * rdt
@@ -200,50 +114,28 @@
       znugdt =  grav * z2dt    
 
-      Agrif_SpecialValue=0.
-      Agrif_UseSpecialValue = ln_spc_dyn
-
-      zua = 0.
-      zva = 0.
-      CALL Agrif_Bc_variable(zua,un_id,procname=interpu)
-      CALL Agrif_Bc_variable(zva,vn_id,procname=interpv)
-      zua2d = 0.
-      zva2d = 0.
-
+      ! prevent smoothing in ghost cells
+      i1=1
+      i2=jpi
+      j1=1
+      j2=jpj
+      IF((nbondj == -1).OR.(nbondj == 2)) j1 = 3
+      IF((nbondj == +1).OR.(nbondj == 2)) j2 = nlcj-2
+      IF((nbondi == -1).OR.(nbondi == 2)) i1 = 3
+      IF((nbondi == +1).OR.(nbondi == 2)) i2 = nlci-2
+
+
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
 #if defined key_dynspg_flt
-      Agrif_SpecialValue=0.
-      Agrif_UseSpecialValue = ln_spc_dyn
-      CALL Agrif_Bc_variable(zua2d,e1u_id,calledweight=1.,procname=interpu2d)
-      CALL Agrif_Bc_variable(zva2d,e2v_id,calledweight=1.,procname=interpv2d)
-#endif
-      Agrif_UseSpecialValue = .FALSE.
-
-
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-
-#if defined key_dynspg_flt
-         DO jj=1,jpj
-            laplacu(2,jj) = timeref * (zua2d(2,jj)/(zrhoy*e2u(2,jj)))*umask(2,jj,1)
-         END DO
-#endif
+         DO jk=1,jpkm1
+            DO jj=j1,j2
+               ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk)
+            END DO
+         END DO
+
+         spgu(2,:)=0.
 
          DO jk=1,jpkm1
             DO jj=1,jpj
-               ua(1:2,jj,jk) = (zua(1:2,jj,jk)/(zrhoy*e2u(1:2,jj)))
-               ua(1:2,jj,jk) = ua(1:2,jj,jk) / fse3u_a(1:2,jj,jk)
-            END DO
-         END DO
-
-#if defined key_dynspg_flt
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk)
-            END DO
-         END DO
-
-         spgu(2,:)=0.
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               spgu(2,jj)=spgu(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk)
+               spgu(2,jj)=spgu(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk)
             END DO
          END DO
@@ -251,5 +143,5 @@
          DO jj=1,jpj
             IF (umask(2,jj,1).NE.0.) THEN
-               spgu(2,jj)=spgu(2,jj)*hur_a(2,jj)
+               spgu(2,jj)=spgu(2,jj)/hu(2,jj)
             ENDIF
          END DO
@@ -259,5 +151,5 @@
 
          DO jk=1,jpkm1
-            DO jj=1,jpj
+            DO jj=j1,j2
                ua(2,jj,jk) = 0.25*(ua(1,jj,jk)+2.*ua(2,jj,jk)+ua(3,jj,jk))
                ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
@@ -269,5 +161,5 @@
          DO jk=1,jpkm1
             DO jj=1,jpj
-               spgu1(2,jj)=spgu1(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk)
+               spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk)
             END DO
          END DO
@@ -275,18 +167,11 @@
          DO jj=1,jpj
             IF (umask(2,jj,1).NE.0.) THEN
-               spgu1(2,jj)=spgu1(2,jj)*hur_a(2,jj)
-            ENDIF
-         END DO
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
+               spgu1(2,jj)=spgu1(2,jj)/hu(2,jj)
+            ENDIF
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=j1,j2
                ua(2,jj,jk) = (ua(2,jj,jk)+spgu(2,jj)-spgu1(2,jj))*umask(2,jj,jk)
-            END DO
-         END DO
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               va(2,jj,jk) = (zva(2,jj,jk)/(zrhox*e1v(2,jj)))*vmask(2,jj,jk)
-               va(2,jj,jk) = va(2,jj,jk) / fse3v_a(2,jj,jk)
             END DO
          END DO
@@ -300,9 +185,7 @@
             END DO
          END DO
-
          DO jj=1,jpj
             spgv1(2,jj)=spgv1(2,jj)*hvr_a(2,jj)
          END DO
-
          DO jk=1,jpkm1
             DO jj=1,jpj
@@ -316,35 +199,18 @@
       IF((nbondi == 1).OR.(nbondi == 2)) THEN
 #if defined key_dynspg_flt
-         DO jj=1,jpj
-            laplacu(nlci-2,jj) = timeref * (zua2d(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj)))
-         END DO
-#endif
-
+         DO jk=1,jpkm1
+            DO jj=j1,j2
+               ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk)
+            END DO
+         END DO
+         spgu(nlci-2,:)=0.
          DO jk=1,jpkm1
             DO jj=1,jpj
-               ua(nlci-2:nlci-1,jj,jk) = (zua(nlci-2:nlci-1,jj,jk)/(zrhoy*e2u(nlci-2:nlci-1,jj)))
-               ua(nlci-2:nlci-1,jj,jk) = ua(nlci-2:nlci-1,jj,jk) / fse3u_a(nlci-2:nlci-1,jj,jk)
-            END DO
-         END DO
-
-#if defined key_dynspg_flt
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk)
-            END DO
-         END DO
-
-
-         spgu(nlci-2,:)=0.
-
-         do jk=1,jpkm1
-            do jj=1,jpj
-               spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk)
-            enddo
-         enddo
-
+               spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)
+            ENDDO
+         ENDDO
          DO jj=1,jpj
             IF (umask(nlci-2,jj,1).NE.0.) THEN
-               spgu(nlci-2,jj)=spgu(nlci-2,jj)*hur_a(nlci-2,jj)
+               spgu(nlci-2,jj)=spgu(nlci-2,jj)/hu(nlci-2,jj)
             ENDIF
          END DO
@@ -352,38 +218,26 @@
          spgu(nlci-2,:) = ua_b(nlci-2,:)
 #endif
-
+         DO jk=1,jpkm1
+            DO jj=j1,j2
+               ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk))
+
+               ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk)
+
+            END DO
+         END DO
+         spgu1(nlci-2,:)=0.
          DO jk=1,jpkm1
             DO jj=1,jpj
-               ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk))
-
-               ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk)
-
-            END DO
-         END DO
-
-         spgu1(nlci-2,:)=0.
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
-               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk)
-            END DO
-         END DO
-
+               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk)
+            END DO
+         END DO
          DO jj=1,jpj
             IF (umask(nlci-2,jj,1).NE.0.) THEN
-               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*hur_a(nlci-2,jj)
-            ENDIF
-         END DO
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj
+               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj)
+            ENDIF
+         END DO
+         DO jk=1,jpkm1
+            DO jj=j1,j2
                ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+spgu(nlci-2,jj)-spgu1(nlci-2,jj))*umask(nlci-2,jj,jk)
-            END DO
-         END DO
-
-         DO jk=1,jpkm1
-            DO jj=1,jpj-1
-               va(nlci-1,jj,jk) = (zva(nlci-1,jj,jk)/(zrhox*e1v(nlci-1,jj)))*vmask(nlci-1,jj,jk)
-               va(nlci-1,jj,jk) = va(nlci-1,jj,jk) / fse3v_a(nlci-1,jj,jk)
             END DO
          END DO
@@ -414,17 +268,4 @@
 
 #if defined key_dynspg_flt
-         DO ji=1,jpi
-            laplacv(ji,2) = timeref * (zva2d(ji,2)/(zrhox*e1v(ji,2)))
-         END DO
-#endif
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               va(ji,1:2,jk) = (zva(ji,1:2,jk)/(zrhox*e1v(ji,1:2)))
-               va(ji,1:2,jk) = va(ji,1:2,jk) / fse3v_a(ji,1:2,jk)
-            END DO
-         END DO
-
-#if defined key_dynspg_flt
          DO jk=1,jpkm1
             DO ji=1,jpi
@@ -437,5 +278,5 @@
          DO jk=1,jpkm1
             DO ji=1,jpi
-               spgv(ji,2)=spgv(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)
+               spgv(ji,2)=spgv(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)
             END DO
          END DO
@@ -443,5 +284,5 @@
          DO ji=1,jpi
             IF (vmask(ji,2,1).NE.0.) THEN
-               spgv(ji,2)=spgv(ji,2)*hvr_a(ji,2)
+               spgv(ji,2)=spgv(ji,2)/hv(ji,2)
             ENDIF
          END DO
@@ -451,5 +292,5 @@
 
          DO jk=1,jpkm1
-            DO ji=1,jpi
+            DO ji=i1,i2
                va(ji,2,jk)=0.25*(va(ji,1,jk)+2.*va(ji,2,jk)+va(ji,3,jk))
                va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk)
@@ -461,5 +302,5 @@
          DO jk=1,jpkm1
             DO ji=1,jpi
-               spgv1(ji,2)=spgv1(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)
+               spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)
             END DO
          END DO
@@ -467,5 +308,5 @@
          DO ji=1,jpi
             IF (vmask(ji,2,1).NE.0.) THEN
-               spgv1(ji,2)=spgv1(ji,2)*hvr_a(ji,2)
+               spgv1(ji,2)=spgv1(ji,2)/hv(ji,2)
             ENDIF
          END DO
@@ -474,11 +315,4 @@
             DO ji=1,jpi
                va(ji,2,jk) = (va(ji,2,jk)+spgv(ji,2)-spgv1(ji,2))*vmask(ji,2,jk)
-            END DO
-         END DO
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               ua(ji,2,jk) = (zua(ji,2,jk)/(zrhoy*e2u(ji,2)))*umask(ji,2,jk) 
-               ua(ji,2,jk) = ua(ji,2,jk) / fse3u_a(ji,2,jk)
             END DO
          END DO
@@ -508,17 +342,4 @@
 
 #if defined key_dynspg_flt
-         DO ji=1,jpi
-            laplacv(ji,nlcj-2) = timeref * (zva2d(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)))
-         END DO
-#endif
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               va(ji,nlcj-2:nlcj-1,jk) = (zva(ji,nlcj-2:nlcj-1,jk)/(zrhox*e1v(ji,nlcj-2:nlcj-1)))
-               va(ji,nlcj-2:nlcj-1,jk) = va(ji,nlcj-2:nlcj-1,jk) / fse3v_a(ji,nlcj-2:nlcj-1,jk)
-            END DO
-         END DO
-
-#if defined key_dynspg_flt
          DO jk=1,jpkm1
             DO ji=1,jpi
@@ -527,9 +348,10 @@
          END DO
 
+
          spgv(:,nlcj-2)=0.
 
          DO jk=1,jpkm1
             DO ji=1,jpi
-               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
+               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
             END DO
          END DO
@@ -537,7 +359,8 @@
          DO ji=1,jpi
             IF (vmask(ji,nlcj-2,1).NE.0.) THEN
-               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*hvr_a(ji,nlcj-2)
-            ENDIF
-         END DO
+               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)/hv(ji,nlcj-2)
+            ENDIF
+         END DO
+
 #else
          spgv(:,nlcj-2)=va_b(:,nlcj-2)
@@ -545,5 +368,5 @@
 
          DO jk=1,jpkm1
-            DO ji=1,jpi
+            DO ji=i1,i2
                va(ji,nlcj-2,jk)=0.25*(va(ji,nlcj-3,jk)+2.*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk))
                va(ji,nlcj-2,jk) = va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk)
@@ -555,5 +378,5 @@
          DO jk=1,jpkm1
             DO ji=1,jpi
-               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
+               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
             END DO
          END DO
@@ -561,5 +384,5 @@
          DO ji=1,jpi
             IF (vmask(ji,nlcj-2,1).NE.0.) THEN
-               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*hvr_a(ji,nlcj-2)
+               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2)
             ENDIF
          END DO
@@ -568,11 +391,4 @@
             DO ji=1,jpi
                va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+spgv(ji,nlcj-2)-spgv1(ji,nlcj-2))*vmask(ji,nlcj-2,jk)
-            END DO
-         END DO
-
-         DO jk=1,jpkm1
-            DO ji=1,jpi
-               ua(ji,nlcj-1,jk) = (zua(ji,nlcj-1,jk)/(zrhoy*e2u(ji,nlcj-1)))*umask(ji,nlcj-1,jk)
-               ua(ji,nlcj-1,jk) = ua(ji,nlcj-1,jk) / fse3u_a(ji,nlcj-1,jk)
             END DO
          END DO
@@ -600,6 +416,5 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d )
-      CALL wrk_dealloc( jpi, jpj, jpk, zua, zva )
+      CALL wrk_dealloc( jpi, jpj, spgv1, spgu1 )
       !
    END SUBROUTINE Agrif_dyn
@@ -620,9 +435,9 @@
          DO jj=1,jpj
             va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj)
-! Specified fluxes:
+            ! Specified fluxes:
             ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj)
-! Characteristics method:
-!alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
-!alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
+            ! Characteristics method:
+            !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
+            !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
          END DO
       ENDIF
@@ -631,9 +446,9 @@
          DO jj=1,jpj
             va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj)
-! Specified fluxes:
+            ! Specified fluxes:
             ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj)
-! Characteristics method:
-!alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
-!alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
+            ! Characteristics method:
+            !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
+            !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
          END DO
       ENDIF
@@ -642,9 +457,9 @@
          DO ji=1,jpi
             ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2)
-! Specified fluxes:
+            ! Specified fluxes:
             va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2)
-! Characteristics method:
-!alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
-!alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
+            ! Characteristics method:
+            !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
+            !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
          END DO
       ENDIF
@@ -653,9 +468,9 @@
          DO ji=1,jpi
             ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1)
-! Specified fluxes:
+            ! Specified fluxes:
             va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2)
-! Characteristics method:
-!alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) &
-!alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
+            ! Characteristics method:
+            !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) &
+            !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
          END DO
       ENDIF
@@ -672,9 +487,5 @@
       INTEGER :: ji, jj
       LOGICAL :: ll_int_cons
-      REAL(wp) :: zrhox, zrhoy, zrhot, zt
-      REAL(wp) :: zaa, zab, zat
-      REAL(wp) :: zt0, zt1
-      REAL(wp), POINTER, DIMENSION(:,:) :: zunb, zvnb, zsshn
-      REAL(wp), POINTER, DIMENSION(:,:) :: zuab, zvab, zubb, zvbb, zutn, zvtn
+      REAL(wp) :: zrhot, zt
       !!----------------------------------------------------------------------  
 
@@ -682,18 +493,7 @@
 
       ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in
-                             ! the forward case only
-
-      zrhox = Agrif_Rhox()
-      zrhoy = Agrif_Rhoy()
+      ! the forward case only
+
       zrhot = Agrif_rhot()
-
-      IF ( kt==nit000 ) THEN ! Allocate boundary data arrays
-         ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj))
-         ALLOCATE( ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj))
-         ALLOCATE( ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi))
-         ALLOCATE( ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi))
-      ENDIF
-
-      CALL wrk_alloc( jpi, jpj, zunb, zvnb, zsshn )
 
       ! "Central" time index for interpolation:
@@ -707,5 +507,5 @@
       Agrif_SpecialValue    = 0.e0
       Agrif_UseSpecialValue = .TRUE.
-      CALL Agrif_Bc_variable(zsshn, sshn_id,calledweight=zt, procname=interpsshn )
+      CALL Agrif_Bc_variable(sshn_id,calledweight=zt, procname=interpsshn )
       Agrif_UseSpecialValue = .FALSE.
 
@@ -715,333 +515,827 @@
 
       IF (ll_int_cons) THEN ! Conservative interpolation
-         CALL wrk_alloc( jpi, jpj, zuab, zvab, zubb, zvbb, zutn, zvtn )
-         zuab(:,:) = 0._wp ; zvab(:,:) = 0._wp
-         zubb(:,:) = 0._wp ; zvbb(:,:) = 0._wp
-         zutn(:,:) = 0._wp ; zvtn(:,:) = 0._wp
-         CALL Agrif_Bc_variable(zubb,unb_id ,calledweight=0._wp, procname=interpunb) ! Before
-         CALL Agrif_Bc_variable(zvbb,vnb_id ,calledweight=0._wp, procname=interpvnb)
-         CALL Agrif_Bc_variable(zuab,unb_id ,calledweight=1._wp, procname=interpunb) ! After
-         CALL Agrif_Bc_variable(zvab,vnb_id ,calledweight=1._wp, procname=interpvnb)
-         CALL Agrif_Bc_variable(zutn,ub2b_id,calledweight=1._wp, procname=interpub2b)! Time integrated
-         CALL Agrif_Bc_variable(zvtn,vb2b_id,calledweight=1._wp, procname=interpvb2b)
-         
+         ! orders matters here !!!!!!
+         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1._wp, procname=interpub2b) ! Time integrated
+         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1._wp, procname=interpvb2b)
+         bdy_tinterp = 1
+         CALL Agrif_Bc_variable(unb_id ,calledweight=1._wp, procname=interpunb) ! After
+         CALL Agrif_Bc_variable(vnb_id ,calledweight=1._wp, procname=interpvnb)
+         bdy_tinterp = 2
+         CALL Agrif_Bc_variable(unb_id ,calledweight=0._wp, procname=interpunb) ! Before
+         CALL Agrif_Bc_variable(vnb_id ,calledweight=0._wp, procname=interpvnb)         
+      ELSE ! Linear interpolation
+         bdy_tinterp = 0
+         ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 
+         ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 
+         ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 
+         ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 
+         CALL Agrif_Bc_variable(unb_id,calledweight=zt, procname=interpunb)
+         CALL Agrif_Bc_variable(vnb_id,calledweight=zt, procname=interpvnb)
+      ENDIF
+      Agrif_UseSpecialValue = .FALSE.
+      ! 
+   END SUBROUTINE Agrif_dta_ts
+
+   SUBROUTINE Agrif_ssh( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_DYN  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) ::   kt
+      !!
+      !!----------------------------------------------------------------------  
+
+      IF( Agrif_Root() )   RETURN
+
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         ssha(2,:)=ssha(3,:)
+         sshn(2,:)=sshn(3,:)
+      ENDIF
+
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         ssha(nlci-1,:)=ssha(nlci-2,:)
+         sshn(nlci-1,:)=sshn(nlci-2,:)
+      ENDIF
+
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         ssha(:,2)=ssha(:,3)
+         sshn(:,2)=sshn(:,3)
+      ENDIF
+
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         ssha(:,nlcj-1)=ssha(:,nlcj-2)
+         sshn(:,nlcj-1)=sshn(:,nlcj-2)
+      ENDIF
+
+   END SUBROUTINE Agrif_ssh
+
+   SUBROUTINE Agrif_ssh_ts( jn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_ssh_ts  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) ::   jn
+      !!
+      INTEGER :: ji,jj
+      !!----------------------------------------------------------------------  
+
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+            ssha_e(2,jj) = hbdy_w(jj)
+         END DO
+      ENDIF
+
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+            ssha_e(nlci-1,jj) = hbdy_e(jj)
+         END DO
+      ENDIF
+
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         DO ji=1,jpi
+            ssha_e(ji,2) = hbdy_s(ji)
+         END DO
+      ENDIF
+
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         DO ji=1,jpi
+            ssha_e(ji,nlcj-1) = hbdy_n(ji)
+         END DO
+      ENDIF
+
+   END SUBROUTINE Agrif_ssh_ts
+
+# if defined key_zdftke
+   SUBROUTINE Agrif_tke
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_tke  ***
+      !!----------------------------------------------------------------------  
+      REAL(wp) ::   zalpha
+      !
+      zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp )
+      IF( zalpha > 1. )   zalpha = 1.
+      
+      Agrif_SpecialValue    = 0.e0
+      Agrif_UseSpecialValue = .TRUE.
+      
+      CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm)       
+              
+      Agrif_UseSpecialValue = .FALSE.
+      !
+   END SUBROUTINE Agrif_tke
+# endif
+
+   SUBROUTINE interptsn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptsn ***
+      !!---------------------------------------------
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER :: imin, imax, jmin, jmax
+      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
+      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+
+      IF (before) THEN         
+         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE
+         !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         !
+         zrhox = Agrif_Rhox()
+         ! 
+         zalpha1 = ( zrhox - 1. ) * 0.5
+         zalpha2 = 1. - zalpha1
+         ! 
+         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
+         zalpha4 = 1. - zalpha3
+         ! 
+         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+         zalpha5 = 1. - zalpha6 - zalpha7
+         !
+         imin = i1
+         imax = i2
+         jmin = j1
+         jmax = j2
+         ! 
+         ! Remove CORNERS
+         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
+         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
+         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
+         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
+         !
+         IF( eastern_side) THEN
+            DO jn = 1, jpts
+               tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO jj = jmin,jmax
+                     IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
+                        tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                     ELSE
+                        tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
+                           tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 
+                                 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         ! 
+         IF( northern_side ) THEN            
+            DO jn = 1, jpts
+               tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO ji = imin,imax
+                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
+                        tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                     ELSE
+                        tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
+                           tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn)  &
+                                 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         !
+         IF( western_side) THEN            
+            DO jn = 1, jpts
+               tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO jj = jmin,jmax
+                     IF( umask(2,jj,jk) == 0.e0 ) THEN
+                        tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
+                     ELSE
+                        tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
+                        IF( un(2,jj,jk) < 0.e0 ) THEN
+                           tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         !
+         IF( southern_side ) THEN           
+            DO jn = 1, jpts
+               tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
+               DO jk=1,jpk      
+                  DO ji=imin,imax
+                     IF( vmask(ji,2,jk) == 0.e0 ) THEN
+                        tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
+                     ELSE
+                        tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
+                        IF( vn(ji,2,jk) < 0.e0 ) THEN
+                           tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         !
+         ! Treatment of corners
+         ! 
+         ! East south
+         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
+         ENDIF
+         ! East north
+         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
+         ENDIF
+         ! West south
+         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tsa(2,2,:,:) = ptab(2,2,:,:)
+         ENDIF
+         ! West north
+         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE interptsn
+
+   SUBROUTINE interpsshn(ptab,i1,i2,j1,j2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      !
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = sshn(i1:i2,j1:j2)
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         IF(western_side)  hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
+         IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
+         IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
+         IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
+      ENDIF
+      !
+   END SUBROUTINE interpsshn
+
+   SUBROUTINE interpun(ptab,i1,i2,j1,j2,k1,k2, before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpun ***
+      !!---------------------------------------------    
+      !!
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: zrhoy	
+      !!---------------------------------------------    
+      !
+      IF (before) THEN 
+         DO jk=1,jpk
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
+                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE
+         zrhoy = Agrif_Rhoy()
+         DO jk=1,jpkm1
+            DO jj=j1,j2
+               ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj)))
+               ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u(i1:i2,jj,jk)
+            END DO
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE interpun
+
+
+   SUBROUTINE interpun2d(ptab,i1,i2,j1,j2,before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpun ***
+      !!---------------------------------------------    
+      !
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !
+      INTEGER :: ji,jj
+      REAL(wp) :: ztref
+      REAL(wp) :: zrhoy	
+      !!---------------------------------------------    
+      !
+      ztref = 1.
+
+      IF (before) THEN 
+         DO jj=j1,j2
+            DO ji=i1,MIN(i2,nlci-1)
+               ptab(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) 
+            END DO
+         END DO
+      ELSE
+         zrhoy = Agrif_Rhoy()
+         DO jj=j1,j2
+            laplacu(i1:i2,jj) = ztref * (ptab(i1:i2,jj)/(zrhoy*e2u(i1:i2,jj))) !*umask(i1:i2,jj,1)
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE interpun2d
+
+
+   SUBROUTINE interpvn(ptab,i1,i2,j1,j2,k1,k2, before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvn ***
+      !!---------------------------------------------    
+      !
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: zrhox	
+      !!---------------------------------------------    
+      !      
+      IF (before) THEN          
+         !interpv entre 1 et k2 et interpv2d en jpkp1
+         DO jk=k1,jpk
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
+                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE          
+         zrhox= Agrif_Rhox()
+         DO jk=1,jpkm1
+            DO jj=j1,j2
+               va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj)))
+               va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v(i1:i2,jj,jk)
+            END DO
+         END DO
+      ENDIF
+      !        
+   END SUBROUTINE interpvn
+
+   SUBROUTINE interpvn2d(ptab,i1,i2,j1,j2,before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvn ***
+      !!---------------------------------------------    
+      !
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !
+      INTEGER :: ji,jj
+      REAL(wp) :: zrhox	
+      REAL(wp) :: ztref
+      !!---------------------------------------------    
+      ! 
+      ztref = 1.    
+      IF (before) THEN 
+         !interpv entre 1 et k2 et interpv2d en jpkp1
+         DO jj=j1,MIN(j2,nlcj-1)
+            DO ji=i1,i2
+               ptab(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) * vmask(ji,jj,1)
+            END DO
+         END DO
+      ELSE           
+         zrhox = Agrif_Rhox()
+         DO ji=i1,i2
+            laplacv(ji,j1:j2) = ztref * (ptab(ji,j1:j2)/(zrhox*e1v(ji,j1:j2)))
+         END DO
+      ENDIF
+      !      
+   END SUBROUTINE interpvn2d
+
+   SUBROUTINE interpunb(ptab,i1,i2,j1,j2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpunb  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !!
+      INTEGER :: ji,jj
+      REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      !
+      IF (before) THEN 
+         DO jj=j1,j2
+            DO ji=i1,i2
+               ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj) 
+            END DO
+         END DO
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhoy = Agrif_Rhoy()
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot      
+         ! Polynomial interpolation coefficients:
+         IF( bdy_tinterp == 1 ) THEN
+            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
+                  &      - zt0**2._wp * (       zt0 - 1._wp)        )
+         ELSEIF( bdy_tinterp == 2 ) THEN
+            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
+                  &      - zt0        * (       zt0 - 1._wp)**2._wp ) 
+
+         ELSE
+            ztcoeff = 1
+         ENDIF
+         !   
+         IF(western_side) THEN
+            ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(eastern_side) THEN
+            ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(southern_side) THEN
+            ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
+         ENDIF
+         IF(northern_side) THEN
+            ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
+         ENDIF
+         !            
+         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
+            IF(western_side) THEN
+               ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2))   &
+                     &                                  * umask(i1,j1:j2,1)
+            ENDIF
+            IF(eastern_side) THEN
+               ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2))   &
+                     &                                  * umask(i1,j1:j2,1)
+            ENDIF
+            IF(southern_side) THEN
+               ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1))   &
+                     &                                  * umask(i1:i2,j1,1)
+            ENDIF
+            IF(northern_side) THEN
+               ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1))   &
+                     &                                  * umask(i1:i2,j1,1)
+            ENDIF
+         ENDIF
+      ENDIF
+      ! 
+   END SUBROUTINE interpunb
+
+   SUBROUTINE interpvnb(ptab,i1,i2,j1,j2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpvnb  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !!
+      INTEGER :: ji,jj
+      REAL(wp) :: zrhox, zrhot, zt0, zt1, ztcoeff   
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      ! 
+      IF (before) THEN 
+         DO jj=j1,j2
+            DO ji=i1,i2
+               ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj) 
+            END DO
+         END DO
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhox = Agrif_Rhox()
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot      
+         IF( bdy_tinterp == 1 ) THEN
+            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
+                  &      - zt0**2._wp * (       zt0 - 1._wp)        )
+         ELSEIF( bdy_tinterp == 2 ) THEN
+            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
+                  &      - zt0        * (       zt0 - 1._wp)**2._wp ) 
+
+         ELSE
+            ztcoeff = 1
+         ENDIF
+         !
+         IF(western_side) THEN
+            vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(eastern_side) THEN
+            vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(southern_side) THEN
+            vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1)
+         ENDIF
+         IF(northern_side) THEN
+            vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
+         ENDIF
+         !            
+         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
+            IF(western_side) THEN
+               vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
+                     &                                  * vmask(i1,j1:j2,1)
+            ENDIF
+            IF(eastern_side) THEN
+               vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
+                     &                                  * vmask(i1,j1:j2,1)
+            ENDIF
+            IF(southern_side) THEN
+               vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
+                     &                                  * vmask(i1:i2,j1,1)
+            ENDIF
+            IF(northern_side) THEN
+               vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
+                     &                                  * vmask(i1:i2,j1,1)
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE interpvnb
+
+   SUBROUTINE interpub2b(ptab,i1,i2,j1,j2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpub2b  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !!
+      INTEGER :: ji,jj
+      REAL(wp) :: zrhot, zt0, zt1,zat
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      IF( before ) THEN
+         DO jj=j1,j2
+            DO ji=i1,i2
+               ptab(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj)
+            END DO
+         END DO
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhot = Agrif_rhot()
          ! Time indexes bounds for integration
          zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
          zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
-
          ! Polynomial interpolation coefficients:
-         zaa = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
-                 &      - zt0**2._wp * (       zt0 - 1._wp)        )
-         zab = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
-                 &      - zt0        * (       zt0 - 1._wp)**2._wp )
          zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        &
-                 &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        ) 
-
-         ! Do time interpolation
-         IF((nbondi == -1).OR.(nbondi == 2)) THEN
-            DO jj=1,jpj
-               zunb(2,jj) = zaa * zuab(2,jj) + zab * zubb(2,jj) + zat * zutn(2,jj)
-               zvnb(2,jj) = zaa * zvab(2,jj) + zab * zvbb(2,jj) + zat * zvtn(2,jj)
-            END DO
-         ENDIF
-         IF((nbondi == 1).OR.(nbondi == 2)) THEN
-            DO jj=1,jpj
-               zunb(nlci-2,jj) = zaa * zuab(nlci-2,jj) + zab * zubb(nlci-2,jj) + zat * zutn(nlci-2,jj)
-               zvnb(nlci-1,jj) = zaa * zvab(nlci-1,jj) + zab * zvbb(nlci-1,jj) + zat * zvtn(nlci-1,jj)
-            END DO
-         ENDIF
-         IF((nbondj == -1).OR.(nbondj == 2)) THEN
-            DO ji=1,jpi
-               zunb(ji,2) = zaa * zuab(ji,2) + zab * zubb(ji,2) + zat * zutn(ji,2)
-               zvnb(ji,2) = zaa * zvab(ji,2) + zab * zvbb(ji,2) + zat * zvtn(ji,2)
-            END DO
-         ENDIF
-         IF((nbondj == 1).OR.(nbondj == 2)) THEN
-            DO ji=1,jpi
-               zunb(ji,nlcj-1) = zaa * zuab(ji,nlcj-1) + zab * zubb(ji,nlcj-1) + zat * zutn(ji,nlcj-1)
-               zvnb(ji,nlcj-2) = zaa * zvab(ji,nlcj-2) + zab * zvbb(ji,nlcj-2) + zat * zvtn(ji,nlcj-2)
-            END DO
-         ENDIF
-         CALL wrk_dealloc( jpi, jpj, zuab, zvab, zubb, zvbb, zutn, zvtn )
-
-      ELSE ! Linear interpolation
-         zunb(:,:) = 0._wp ; zvnb(:,:) = 0._wp
-         CALL Agrif_Bc_variable(zunb,unb_id,calledweight=zt, procname=interpunb)
-         CALL Agrif_Bc_variable(zvnb,vnb_id,calledweight=zt, procname=interpvnb)
-      ENDIF
-      Agrif_UseSpecialValue = .FALSE.
-
-      ! Fill boundary data arrays:
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-               ubdy_w(jj) = (zunb(2,jj)/(zrhoy*e2u(2,jj))) * umask(2,jj,1)
-               vbdy_w(jj) = (zvnb(2,jj)/(zrhox*e1v(2,jj))) * vmask(2,jj,1)
-               hbdy_w(jj) = zsshn(2,jj) * tmask(2,jj,1)
-         END DO
-      ENDIF
-
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-               ubdy_e(jj) = zunb(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj)) * umask(nlci-2,jj,1)
-               vbdy_e(jj) = zvnb(nlci-1,jj)/(zrhox*e1v(nlci-1,jj)) * vmask(nlci-1,jj,1)
-               hbdy_e(jj) = zsshn(nlci-1,jj) * tmask(nlci-1,jj,1)
-         END DO
-      ENDIF
-
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-               ubdy_s(ji) = zunb(ji,2)/(zrhoy*e2u(ji,2)) * umask(ji,2,1)
-               vbdy_s(ji) = zvnb(ji,2)/(zrhox*e1v(ji,2)) * vmask(ji,2,1)
-               hbdy_s(ji) = zsshn(ji,2) * tmask(ji,2,1)
-         END DO
-      ENDIF
-
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-            ubdy_n(ji) = zunb(ji,nlcj-1)/(zrhoy*e2u(ji,nlcj-1)) * umask(ji,nlcj-1,1)
-            vbdy_n(ji) = zvnb(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)) * vmask(ji,nlcj-2,1)
-            hbdy_n(ji) = zsshn(ji,nlcj-1) * tmask(ji,nlcj-1,1)
-         END DO
-      ENDIF
-
-      CALL wrk_dealloc( jpi, jpj, zunb, zvnb, zsshn )
-
-   END SUBROUTINE Agrif_dta_ts
-
-   SUBROUTINE Agrif_ssh( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_DYN  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) ::   kt
-      !!
-      !!----------------------------------------------------------------------  
-
-      IF( Agrif_Root() )   RETURN
-
-
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         ssha(2,:)=ssha(3,:)
-         sshn(2,:)=sshn(3,:)
-      ENDIF
-
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         ssha(nlci-1,:)=ssha(nlci-2,:)
-         sshn(nlci-1,:)=sshn(nlci-2,:)        
-      ENDIF
-
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         ssha(:,2)=ssha(:,3)
-         sshn(:,2)=sshn(:,3)
-      ENDIF
-
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         ssha(:,nlcj-1)=ssha(:,nlcj-2)
-         sshn(:,nlcj-1)=sshn(:,nlcj-2)                
-      ENDIF
-
-   END SUBROUTINE Agrif_ssh
-
-   SUBROUTINE Agrif_ssh_ts( jn )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_ssh_ts  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) ::   jn
+               &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        ) 
+         ! 
+         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j1) 
+         IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) 
+      ENDIF
+      ! 
+   END SUBROUTINE interpub2b
+
+   SUBROUTINE interpvb2b(ptab,i1,i2,j1,j2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpvb2b  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
       !!
       INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      IF((nbondi == -1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-            ssha_e(2,jj) = hbdy_w(jj)
-         END DO
-      ENDIF
-
-      IF((nbondi == 1).OR.(nbondi == 2)) THEN
-         DO jj=1,jpj
-            ssha_e(nlci-1,jj) = hbdy_e(jj)
-         END DO
-      ENDIF
-
-      IF((nbondj == -1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-            ssha_e(ji,2) = hbdy_s(ji)
-         END DO
-      ENDIF
-
-      IF((nbondj == 1).OR.(nbondj == 2)) THEN
-         DO ji=1,jpi
-            ssha_e(ji,nlcj-1) = hbdy_n(ji)
-         END DO
-      ENDIF
-
-   END SUBROUTINE Agrif_ssh_ts
-
-   SUBROUTINE interpsshn(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpsshn  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      tabres(i1:i2,j1:j2) = sshn(i1:i2,j1:j2)
-
-   END SUBROUTINE interpsshn
-
-   SUBROUTINE interpu(tabres,i1,i2,j1,j2,k1,k2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpu  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj,jk
-      !!----------------------------------------------------------------------  
-
-      DO jk=k1,k2
+      REAL(wp) :: zrhot, zt0, zt1,zat
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      !
+      IF( before ) THEN
          DO jj=j1,j2
             DO ji=i1,i2
-               tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
-               tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-   END SUBROUTINE interpu
-
-
-   SUBROUTINE interpu2d(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpu2d  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      DO jj=j1,j2
-         DO ji=i1,i2
-            tabres(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) &
-               * umask(ji,jj,1)
-         END DO
-      END DO
-
-   END SUBROUTINE interpu2d
-
-
-   SUBROUTINE interpv(tabres,i1,i2,j1,j2,k1,k2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpv  ***
-      !!----------------------------------------------------------------------  
+               ptab(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj)
+            END DO
+         END DO
+      ELSE      
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
+         ! Polynomial interpolation coefficients:
+         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        &
+               &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        ) 
+         !
+         IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1) 
+         IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 
+      ENDIF
+      !      
+   END SUBROUTINE interpvb2b
+
+   SUBROUTINE interpe3t(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpe3t  ***
+      !!----------------------------------------------------------------------  
+      ! 
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-      !!
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
       INTEGER :: ji, jj, jk
-      !!----------------------------------------------------------------------  
-
-      DO jk=k1,k2
-         DO jj=j1,j2
-            DO ji=i1,i2
-               tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
-               tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-   END SUBROUTINE interpv
-
-
-   SUBROUTINE interpv2d(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpu2d  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      DO jj=j1,j2
-         DO ji=i1,i2
-            tabres(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) &
-               * vmask(ji,jj,1)
-         END DO
-      END DO
-
-   END SUBROUTINE interpv2d
-
-   SUBROUTINE interpunb(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpunb  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      DO jj=j1,j2
-         DO ji=i1,i2
-            tabres(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj) 
-         END DO
-      END DO
-
-   END SUBROUTINE interpunb
-
-   SUBROUTINE interpvnb(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpvnb  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      DO jj=j1,j2
-         DO ji=i1,i2
-            tabres(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj)
-         END DO
-      END DO
-
-   END SUBROUTINE interpvnb
-
-   SUBROUTINE interpub2b(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpub2b  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      DO jj=j1,j2
-         DO ji=i1,i2
-            tabres(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj)
-         END DO
-      END DO
-
-   END SUBROUTINE interpub2b
-
-   SUBROUTINE interpvb2b(tabres,i1,i2,j1,j2)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interpvb2b  ***
-      !!----------------------------------------------------------------------  
-      INTEGER, INTENT(in) :: i1,i2,j1,j2
-      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
-      !!
-      INTEGER :: ji,jj
-      !!----------------------------------------------------------------------  
-
-      DO jj=j1,j2
-         DO ji=i1,i2
-            tabres(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj)
-         END DO
-      END DO
-
-   END SUBROUTINE interpvb2b
+      LOGICAL :: western_side, eastern_side, northern_side, southern_side
+      REAL(wp) :: ztmpmsk      
+      !!----------------------------------------------------------------------  
+      !    
+      IF (before) THEN
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = tmask(ji,jj,jk) * e3t_0(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ! Get velocity mask at boundary edge points:
+                  IF (western_side)  ztmpmsk = umask(ji    ,jj    ,1)
+                  IF (eastern_side)  ztmpmsk = umask(nlci-2,jj    ,1)
+                  IF (northern_side) ztmpmsk = vmask(ji    ,nlcj-2,1)
+                  IF (southern_side) ztmpmsk = vmask(ji    ,2     ,1)
+
+                  IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk))*ztmpmsk > 1.D-2) THEN
+                     IF (western_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                     ELSEIF (eastern_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                     ELSEIF (southern_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
+                     ELSEIF (northern_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
+                     ENDIF
+                     WRITE(numout,*) '      ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk)
+                     kindic_agr = kindic_agr + 1
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+      ! 
+   END SUBROUTINE interpe3t
+
+   SUBROUTINE interpumsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpumsk  ***
+      !!----------------------------------------------------------------------  
+      ! 
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER :: ji, jj, jk
+      LOGICAL :: western_side, eastern_side   
+      !!----------------------------------------------------------------------  
+      !    
+      IF (before) THEN
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = umask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE
+
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                   ! Velocity mask at boundary edge points:
+                  IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN
+                     IF (western_side) THEN
+                        WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ELSEIF (eastern_side) THEN
+                        WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+      ! 
+   END SUBROUTINE interpumsk
+
+   SUBROUTINE interpvmsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpvmsk  ***
+      !!----------------------------------------------------------------------  
+      ! 
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER :: ji, jj, jk
+      LOGICAL :: northern_side, southern_side     
+      !!----------------------------------------------------------------------  
+      !    
+      IF (before) THEN
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk) = vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE
+
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                   ! Velocity mask at boundary edge points:
+                  IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN
+                     IF (southern_side) THEN
+                        WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ELSEIF (northern_side) THEN
+                        WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+      ! 
+   END SUBROUTINE interpvmsk
+
+# if defined key_zdftke
+
+   SUBROUTINE interpavm(ptab,i1,i2,j1,j2,k1,k2,before)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interavm  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!----------------------------------------------------------------------  
+      !      
+      IF( before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)
+      ENDIF
+      !
+   END SUBROUTINE interpavm
+
+# endif /* key_zdftke */
 
 #else
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 5682)
@@ -1,5 +1,5 @@
 #define SPONGE && define SPONGE_TOP
 
-Module agrif_opa_sponge
+MODULE agrif_opa_sponge
 #if defined key_agrif  && ! defined key_offline
    USE par_oce
@@ -9,11 +9,13 @@
    USE agrif_oce
    USE wrk_nemo  
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn
-
-  !! * Substitutions
+   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn
+   PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge
+
+   !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
@@ -23,5 +25,5 @@
    !!----------------------------------------------------------------------
 
-   CONTAINS
+CONTAINS
 
    SUBROUTINE Agrif_Sponge_Tra
@@ -30,55 +32,17 @@
       !!---------------------------------------------
       !!
-      INTEGER :: ji,jj,jk,jn
       REAL(wp) :: timecoeff
-      REAL(wp) :: ztsa, zabe1, zabe2, zbtr
-      REAL(wp), POINTER, DIMENSION(:,:    ) :: ztu, ztv
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: tsbdiff
 
 #if defined SPONGE
-      CALL wrk_alloc( jpi, jpj, ztu, ztv )
-      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  )
-
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
 
+      CALL Agrif_Sponge
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .TRUE.
-      ztab = 0.e0
-      CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn)
+      tabspongedone_tsn = .FALSE.
+
+      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge)
+
       Agrif_UseSpecialValue = .FALSE.
-
-      tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:)
-
-      CALL Agrif_Sponge
-
-      DO jn = 1, jpts
-         DO jk = 1, jpkm1
-            !
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
-                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
-                  ztu(ji,jj) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) )
-                  ztv(ji,jj) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
-               ENDDO
-            ENDDO
-
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
-                  ! horizontal diffusive trends
-                  ztsa = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  )   &
-                  &              + ztv(ji,jj) - ztv(ji  ,jj-1)  )
-                  ! add it to the general tracer trends
-                  tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa
-               END DO
-            END DO
-            !
-         ENDDO
-      ENDDO
-
-      CALL wrk_dealloc( jpi, jpj, ztu, ztv )
-      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  )
 #endif
 
@@ -90,89 +54,21 @@
       !!---------------------------------------------
       !!
-      INTEGER :: ji,jj,jk
       REAL(wp) :: timecoeff
-      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab
 
 #if defined SPONGE
-      CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )
-
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
 
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = ln_spc_dyn
-      ztab = 0.e0
-      CALL Agrif_Bc_Variable(ztab, ua_id,calledweight=timecoeff,procname=interpun)
+
+      tabspongedone_u = .FALSE.
+      tabspongedone_v = .FALSE.         
+      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge)
+
+      tabspongedone_u = .FALSE.
+      tabspongedone_v = .FALSE.
+      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge)
+
       Agrif_UseSpecialValue = .FALSE.
-
-      ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:) ) * umask(:,:,:)
-
-      ztab = 0.e0
-      Agrif_SpecialValue=0.
-      Agrif_UseSpecialValue = ln_spc_dyn
-      CALL Agrif_Bc_Variable(ztab, va_id,calledweight=timecoeff,procname=interpvn)
-      Agrif_UseSpecialValue = .FALSE.
-
-      vbdiff(:,:,:) = ( vb(:,:,:) - ztab(:,:,:) ) * vmask(:,:,:)
-
-      CALL Agrif_Sponge
-
-      DO jk = 1,jpkm1
-         ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:)
-         vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:)
-      ENDDO
-      
-      hdivdiff = 0.
-      rotdiff = 0.
-
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-
-         !                                             ! --------
-         ! Horizontal divergence                       !   div
-         !                                             ! --------
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vector opt.
-               zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
-               hdivdiff(ji,jj,jk) =  (  e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk) * ubdiff(ji  ,jj  ,jk)     &
-                  &                   - e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk) * ubdiff(ji-1,jj  ,jk)     &
-                  &                   + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * vbdiff(ji  ,jj  ,jk)     &
-                  &                   - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * vbdiff(ji  ,jj-1,jk)  ) * zbtr
-            END DO
-         END DO
-
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1   ! vector opt.
-               zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk)
-               rotdiff(ji,jj,jk) = (  e2v(ji+1,jj  ) * vbdiff(ji+1,jj  ,jk) - e2v(ji,jj) * vbdiff(ji,jj,jk)    &
-                  &                 - e1u(ji  ,jj+1) * ubdiff(ji  ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk)  ) &
-                  &               * fmask(ji,jj,jk) * zbtr
-            END DO
-         END DO
-
-      ENDDO
-
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! vector opt.
-               ! horizontal diffusive trends
-               zua = - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
-                     + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk) ) / e1u(ji,jj)
-
-               zva = + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
-                     + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) / e2v(ji,jj)
-               ! add it to the general momentum trends
-               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
-               va(ji,jj,jk) = va(ji,jj,jk) + zva
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-      CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )
 #endif
 
@@ -199,11 +95,10 @@
          CALL wrk_alloc( jpi, jpj, ztabramp )
 
-         ispongearea  = 2 + 2 * Agrif_irhox()
+         ispongearea  = 2 + nn_sponge_len * Agrif_irhox()
          ilci = nlci - ispongearea
          ilcj = nlcj - ispongearea 
          z1spongearea = 1._wp / REAL( ispongearea - 2 )
-         spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
-
-         ztabramp(:,:) = 0.
+
+         ztabramp(:,:) = 0._wp
 
          IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
@@ -254,54 +149,15 @@
       ! Tracers
       IF( .NOT. spongedoneT ) THEN
-         spe1ur(:,:) = 0.
-         spe2vr(:,:) = 0.
-
-         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
-            spe1ur(2:ispongearea-1,:       ) = visc_tra                                        &
-               &                             *    0.5 * (  ztabramp(2:ispongearea-1,:      )   &
-               &                                         + ztabramp(3:ispongearea  ,:      ) ) &
-               &                             * e2u(2:ispongearea-1,:) / e1u(2:ispongearea-1,:)
-
-            spe2vr(2:ispongearea  ,1:jpjm1 ) = visc_tra                                        &
-               &                             *    0.5 * (  ztabramp(2:ispongearea  ,1:jpjm1)   &
-               &                                         + ztabramp(2:ispongearea,2  :jpj  ) ) &
-               &                             * e1v(2:ispongearea,1:jpjm1) / e2v(2:ispongearea,1:jpjm1)
-         ENDIF
-
-         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
-            spe1ur(ilci+1:nlci-2,:        ) = visc_tra                                   &
-               &                            * 0.5 * (  ztabramp(ilci+1:nlci-2,:      )   & 
-               &                                     + ztabramp(ilci+2:nlci-1,:      ) ) &
-               &                            * e2u(ilci+1:nlci-2,:) / e1u(ilci+1:nlci-2,:)
-
-            spe2vr(ilci+1:nlci-1,1:jpjm1  )  = visc_tra                                  &
-               &                            * 0.5 * (  ztabramp(ilci+1:nlci-1,1:jpjm1)   & 
-               &                                     + ztabramp(ilci+1:nlci-1,2:jpj  ) ) & 
-               &                            * e1v(ilci+1:nlci-1,1:jpjm1) / e2v(ilci+1:nlci-1,1:jpjm1)
-         ENDIF
-
-         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
-            spe1ur(1:jpim1,2:ispongearea  ) = visc_tra                                     &
-               &                            * 0.5 * (  ztabramp(1:jpim1,2:ispongearea  )   & 
-               &                                     + ztabramp(2:jpi  ,2:ispongearea  ) ) &
-               &                            * e2u(1:jpim1,2:ispongearea) / e1u(1:jpim1,2:ispongearea)
-   
-            spe2vr(:      ,2:ispongearea-1) = visc_tra                                     &
-               &                            * 0.5 * (  ztabramp(:      ,2:ispongearea-1)   &
-               &                                     + ztabramp(:      ,3:ispongearea  ) ) &
-               &                            * e1v(:,2:ispongearea-1) / e2v(:,2:ispongearea-1)
-         ENDIF
-
-         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
-            spe1ur(1:jpim1,ilcj+1:nlcj-1) = visc_tra                                   &
-               &                          * 0.5 * (  ztabramp(1:jpim1,ilcj+1:nlcj-1)   &
-               &                                   + ztabramp(2:jpi  ,ilcj+1:nlcj-1) ) &
-               &                                * e2u(1:jpim1,ilcj+1:nlcj-1) / e1u(1:jpim1,ilcj+1:nlcj-1)
-
-            spe2vr(:      ,ilcj+1:nlcj-2) = visc_tra                                   &
-               &                          * 0.5 * (  ztabramp(:      ,ilcj+1:nlcj-2)   &
-               &                                   + ztabramp(:      ,ilcj+2:nlcj-1) ) &
-               &                                * e1v(:,ilcj+1:nlcj-2) / e2v(:,ilcj+1:nlcj-2)
-         ENDIF
+         fsaht_spu(:,:) = 0._wp
+         fsaht_spv(:,:) = 0._wp
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! vector opt.
+               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj  ))
+               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji  ,jj+1))
+            END DO
+         END DO
+
+         CALL lbc_lnk( fsaht_spu, 'U', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( fsaht_spv, 'V', 1. )
          spongedoneT = .TRUE.
       ENDIF
@@ -309,44 +165,17 @@
       ! Dynamics
       IF( .NOT. spongedoneU ) THEN
-         spe1ur2(:,:) = 0.
-         spe2vr2(:,:) = 0.
-
-         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
-            spe1ur2(2:ispongearea-1,:      ) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(2:ispongearea-1,:      ) &
-               &                                      + ztabramp(3:ispongearea  ,:      ) )
-            spe2vr2(2:ispongearea  ,1:jpjm1) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(2:ispongearea  ,1:jpjm1) &
-               &                                      + ztabramp(2:ispongearea  ,2:jpj  ) ) 
-         ENDIF
-
-         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
-            spe1ur2(ilci+1:nlci-2  ,:      ) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(ilci+1:nlci-2, :       ) &
-               &                                      + ztabramp(ilci+2:nlci-1, :       ) )                      
-            spe2vr2(ilci+1:nlci-1  ,1:jpjm1) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(ilci+1:nlci-1,1:jpjm1  ) &
-               &                                      + ztabramp(ilci+1:nlci-1,2:jpj    ) ) 
-         ENDIF
-
-         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
-            spe1ur2(1:jpim1,2:ispongearea  ) = visc_dyn                                   &  
-               &                             * 0.5 * (  ztabramp(1:jpim1,2:ispongearea  ) &
-               &                                      + ztabramp(2:jpi  ,2:ispongearea  ) ) 
-            spe2vr2(:      ,2:ispongearea-1) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(:      ,2:ispongearea-1) &
-               &                                      + ztabramp(:      ,3:ispongearea  ) )
-         ENDIF
-
-         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
-            spe1ur2(1:jpim1,ilcj+1:nlcj-1  ) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(1:jpim1,ilcj+1:nlcj-1  ) &
-               &                                      + ztabramp(2:jpi  ,ilcj+1:nlcj-1  ) ) 
-            spe2vr2(:      ,ilcj+1:nlcj-2  ) = visc_dyn                                   &
-               &                             * 0.5 * (  ztabramp(:      ,ilcj+1:nlcj-2  ) &
-               &                                      + ztabramp(:      ,ilcj+2:nlcj-1  ) )
-         ENDIF
+         fsahm_spt(:,:) = 0._wp
+         fsahm_spf(:,:) = 0._wp
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! vector opt.
+               fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj)
+               fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) &
+                                                     &  +ztabramp(ji,jj) + ztabramp(ji+1,jj  ) )
+            END DO
+         END DO
+
+         CALL lbc_lnk( fsahm_spt, 'T', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( fsahm_spf, 'F', 1. )
          spongedoneU = .TRUE.
-         spbtr3(:,:) = 1. / ( e1f(:,:) * e2f(:,:) )
       ENDIF
       !
@@ -357,36 +186,277 @@
    END SUBROUTINE Agrif_Sponge
 
-   SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
-      !!---------------------------------------------
-      !!   *** ROUTINE interptsn ***
+   SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptsn_sponge ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-
-      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
-
-   END SUBROUTINE interptsn
-
-   SUBROUTINE interpun(tabres,i1,i2,j1,j2,k1,k2)
-      !!---------------------------------------------
-      !!   *** ROUTINE interpun ***
-      !!---------------------------------------------
+      LOGICAL, INTENT(in) :: before
+
+
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::   iku, ikv
+      REAL(wp) :: ztsa, zabe1, zabe2, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff
+      !
+      IF (before) THEN
+         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE   
+   
+         tsbdiff(:,:,:,:) = tsb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)    
+         DO jn = 1, jpts            
+            DO jk = 1, jpkm1
+               DO jj = j1,j2-1
+                  DO ji = i1,i2-1
+                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
+                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
+                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
+                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
+                  ENDDO
+               ENDDO
+
+               IF( ln_zps ) THEN      ! set gradient at partial step level
+                  DO jj = j1,j2-1
+                     DO ji = i1,i2-1
+                        ! last level
+                        iku = mbku(ji,jj)
+                        ikv = mbkv(ji,jj)
+                        IF( iku == jk ) THEN
+                           ztu(ji,jj,jk) = 0._wp
+                        ENDIF
+                        IF( ikv == jk ) THEN
+                           ztv(ji,jj,jk) = 0._wp
+                        ENDIF
+                     END DO
+                  END DO
+               ENDIF
+            ENDDO
+
+            DO jk = 1, jpkm1
+               DO jj = j1+1,j2-1
+                  DO ji = i1+1,i2-1
+
+                     IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 
+                        zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk)
+                        ! horizontal diffusive trends
+                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  )
+                        ! add it to the general tracer trends
+                        tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa
+                     ENDIF
+
+                  ENDDO
+               ENDDO
+
+            ENDDO
+         ENDDO
+
+         tabspongedone_tsn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+
+      ENDIF
+
+   END SUBROUTINE interptsn_sponge
+
+   SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpun_sponge ***
+      !!---------------------------------------------    
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-
-      tabres(i1:i2,j1:j2,k1:k2) = un(i1:i2,j1:j2,k1:k2)
-
-   END SUBROUTINE interpun
-
-   SUBROUTINE interpvn(tabres,i1,i2,j1,j2,k1,k2)
-      !!---------------------------------------------
-      !!   *** ROUTINE interpvn ***
-      !!---------------------------------------------
+      LOGICAL, INTENT(in) :: before
+
+      INTEGER :: ji,jj,jk
+
+      ! sponge parameters 
+      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ubdiff
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff
+      INTEGER :: jmax
+      !
+
+
+      IF (before) THEN
+         tabres = un(i1:i2,j1:j2,:)
+      ELSE
+
+         ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:)
+
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+
+            !                                             ! --------
+            ! Horizontal divergence                       !   div
+            !                                             ! --------
+            DO jj = j1,j2
+               DO ji = i1+1,i2   ! vector opt.
+                  zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
+                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*fse3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) &
+                                     &   -e2u(ji-1,jj)*fse3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr
+               END DO
+            END DO
+
+            DO jj = j1,j2-1
+               DO ji = i1,i2   ! vector opt.
+                  zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)
+                  rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) &
+                                       +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) & 
+                                    & ) * fmask(ji,jj,jk) * zbtr 
+               END DO
+            END DO
+         ENDDO
+
+         !
+
+
+
+         DO jj = j1+1, j2-1
+            DO ji = i1+1, i2-1   ! vector opt.
+
+               IF (.NOT. tabspongedone_u(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+                     ! horizontal diffusive trends
+                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) )   &
+                           + ( hdivdiff(ji+1,jj,jk) - ze1v  ) / e1u(ji,jj)
+
+                     ! add it to the general momentum trends
+                     ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+
+                  END DO
+               ENDIF
+
+            END DO
+         END DO
+
+         tabspongedone_u(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+
+         jmax = j2-1
+         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-3)
+
+         DO jj = j1+1, jmax
+            DO ji = i1+1, i2   ! vector opt.
+
+               IF (.NOT. tabspongedone_v(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+
+                     ! horizontal diffusive trends
+                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) )   &
+                           + ( hdivdiff(ji,jj+1,jk) - ze1v  ) / e2v(ji,jj)
+
+                     ! add it to the general momentum trends
+                     va(ji,jj,jk) = va(ji,jj,jk) + zva
+                  END DO
+               ENDIF
+
+            END DO
+         END DO
+
+
+         tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE.
+
+      ENDIF
+
+
+   END SUBROUTINE interpun_sponge
+
+
+   SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2, before,nb,ndir)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvn_sponge ***
+      !!--------------------------------------------- 
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
-
-      tabres(i1:i2,j1:j2,k1:k2) = vn(i1:i2,j1:j2,k1:k2)
-
-   END SUBROUTINE interpvn
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+
+      INTEGER :: ji,jj,jk
+
+      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
+
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff
+      INTEGER :: imax
+      !
+
+      IF (before) THEN 
+         tabres = vn(i1:i2,j1:j2,:)
+      ELSE
+
+         vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(:,:,:))*vmask(i1:i2,j1:j2,:)
+
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+
+            !                                             ! --------
+            ! Horizontal divergence                       !   div
+            !                                             ! --------
+            DO jj = j1+1,j2
+               DO ji = i1,i2   ! vector opt.
+                  zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
+                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  &
+                                     &  -e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr
+               END DO
+            END DO
+            DO jj = j1,j2
+               DO ji = i1,i2-1   ! vector opt.
+                  zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)
+                  rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 
+                                    &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk) &
+                                    & ) * fmask(ji,jj,jk) * zbtr
+               END DO
+            END DO
+         ENDDO
+
+         !                                                ! ===============
+         !                                                
+
+         imax = i2-1
+         IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-3)
+
+         DO jj = j1+1, j2
+            DO ji = i1+1, imax   ! vector opt.
+               IF (.NOT. tabspongedone_u(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+                     ! horizontal diffusive trends
+                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) &
+                           / e1u(ji,jj)
+
+
+                     ! add it to the general momentum trends
+                     ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+                  END DO
+
+               ENDIF
+            END DO
+         END DO
+
+         tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE.
+
+         DO jj = j1+1, j2-1
+            DO ji = i1+1, i2-1   ! vector opt.
+               IF (.NOT. tabspongedone_v(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+                     ! horizontal diffusive trends
+
+                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) &
+                           / e2v(ji,jj)
+
+                     ! add it to the general momentum trends
+                     va(ji,jj,jk) = va(ji,jj,jk) + zva
+                  END DO
+               ENDIF
+            END DO
+         END DO
+         tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+      ENDIF
+
+   END SUBROUTINE interpvn_sponge
 
 #else
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 5682)
@@ -1,4 +1,5 @@
-#define TWO_WAY
-
+#define TWO_WAY        /* TWO WAY NESTING */
+#undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/
+ 
 MODULE agrif_opa_update
 #if defined key_agrif  && ! defined key_offline
@@ -11,14 +12,15 @@
    USE wrk_nemo  
    USE dynspg_oce
+   USE zdf_oce        ! vertical physics: ocean variables 
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn
-
-   INTEGER, PUBLIC :: nbcline = 0
-
+   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales
+# if defined key_zdftke
+   PUBLIC Agrif_Update_Tke
+# endif
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.6 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
@@ -27,98 +29,151 @@
 CONTAINS
 
-   SUBROUTINE Agrif_Update_Tra( kt )
+   RECURSIVE SUBROUTINE Agrif_Update_Tra( )
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Update_Tra ***
       !!---------------------------------------------
-      !!
-      INTEGER, INTENT(in) :: kt
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab
-
-
-      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
-#if defined TWO_WAY
-      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab )
+      ! 
+      IF (Agrif_Root()) RETURN
+      !
+#if defined TWO_WAY  
+      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed(), 'nbcline', nbcline
 
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
-
+      ! 
       IF (MOD(nbcline,nbclineupdate) == 0) THEN
-         CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS)
-      ELSE
-         CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS)
-      ENDIF
-
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(tsn_id, procname=updateTS)
+# else
+         CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS)
+# endif
+      ELSE
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS)
+# else
+         CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS)
+# endif
+      ENDIF
+      !
       Agrif_UseSpecialValueInUpdate = .FALSE.
-
-      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab )
+      !
+      IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update:
+         CALL Agrif_ChildGrid_To_ParentGrid()
+         CALL Agrif_Update_Tra()
+         CALL Agrif_ParentGrid_To_ChildGrid()
+      ENDIF
+      !
 #endif
-
+      !
    END SUBROUTINE Agrif_Update_Tra
 
-   SUBROUTINE Agrif_Update_Dyn( kt )
+   RECURSIVE SUBROUTINE Agrif_Update_Dyn( )
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Update_Dyn ***
       !!---------------------------------------------
-      !!
-      INTEGER, INTENT(in) :: kt
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab
-
-
-      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) Return
+      ! 
+      IF (Agrif_Root()) RETURN
+      !
 #if defined TWO_WAY
-      CALL wrk_alloc( jpi, jpj,      ztab2d )
-      CALL wrk_alloc( jpi, jpj, jpk, ztab   )
-
+      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed(), 'nbcline', nbcline
+
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+      Agrif_SpecialValueFineGrid = 0.
+      !     
       IF (mod(nbcline,nbclineupdate) == 0) THEN
-         CALL Agrif_Update_Variable(ztab,un_id,procname = updateU)
-         CALL Agrif_Update_Variable(ztab,vn_id,procname = updateV)
-      ELSE
-         CALL Agrif_Update_Variable(ztab,un_id,locupdate=(/0,1/),procname = updateU)
-         CALL Agrif_Update_Variable(ztab,vn_id,locupdate=(/0,1/),procname = updateV)         
-      ENDIF
-
-      CALL Agrif_Update_Variable(ztab2d,e1u_id,procname = updateU2d)
-      CALL Agrif_Update_Variable(ztab2d,e2v_id,procname = updateV2d)
-
-#if defined key_dynspg_ts
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(un_update_id,procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,procname = updateV)
+# else
+         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV)
+# endif
+      ELSE
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(un_update_id,locupdate=(/0,1/),procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,locupdate=(/0,1/),procname = updateV)         
+# else
+         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV)
+# endif
+      ENDIF
+
+# if ! defined DECAL_FEEDBACK
+      CALL Agrif_Update_Variable(e1u_id,procname = updateU2d)
+      CALL Agrif_Update_Variable(e2v_id,procname = updateV2d)  
+# else
+      CALL Agrif_Update_Variable(e1u_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU2d)
+      CALL Agrif_Update_Variable(e2v_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV2d)  
+# endif
+
+# if defined key_dynspg_ts
       IF (ln_bt_fw) THEN
          ! Update time integrated transports
          IF (mod(nbcline,nbclineupdate) == 0) THEN
-            CALL Agrif_Update_Variable(ztab2d,ub2b_id,procname = updateub2b)
-            CALL Agrif_Update_Variable(ztab2d,vb2b_id,procname = updatevb2b)
+#  if ! defined DECAL_FEEDBACK
+            CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b)
+            CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b)
+#  else
+            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateub2b)
+            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updatevb2b)
+#  endif
          ELSE
-            CALL Agrif_Update_Variable(ztab2d,ub2b_id,locupdate=(/0,1/),procname = updateub2b)
-            CALL Agrif_Update_Variable(ztab2d,vb2b_id,locupdate=(/0,1/),procname = updatevb2b)
+#  if ! defined DECAL_FEEDBACK
+            CALL Agrif_Update_Variable(ub2b_update_id,locupdate=(/0,1/),procname = updateub2b)
+            CALL Agrif_Update_Variable(vb2b_update_id,locupdate=(/0,1/),procname = updatevb2b)
+#  else
+            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateub2b)
+            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updatevb2b)
+#  endif
          ENDIF
-      END IF 
+      END IF
+# endif
+      !
+      nbcline = nbcline + 1
+      !
+      Agrif_UseSpecialValueInUpdate = .TRUE.
+      Agrif_SpecialValueFineGrid = 0.
+# if ! defined DECAL_FEEDBACK
+      CALL Agrif_Update_Variable(sshn_id,procname = updateSSH)
+# else
+      CALL Agrif_Update_Variable(sshn_id,locupdate=(/1,0/),procname = updateSSH)
+# endif
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+      ! 
 #endif
-
-      nbcline = nbcline + 1
-
-      Agrif_UseSpecialValueInUpdate = .TRUE. 
+      !
+      ! Do recursive update:
+      IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update:
+         CALL Agrif_ChildGrid_To_ParentGrid()
+         CALL Agrif_Update_Dyn()
+         CALL Agrif_ParentGrid_To_ChildGrid()
+      ENDIF
+      !
+   END SUBROUTINE Agrif_Update_Dyn
+
+# if defined key_zdftke
+   SUBROUTINE Agrif_Update_Tke( kt )
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Update_Tke ***
+      !!---------------------------------------------
+      !!
+      INTEGER, INTENT(in) :: kt
+      !       
+      IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN
+#  if defined TWO_WAY
+
+      Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
-      CALL Agrif_Update_Variable(ztab2d,sshn_id,procname = updateSSH)
+
+      CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN  )
+      CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT )
+      CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM )
+
       Agrif_UseSpecialValueInUpdate = .FALSE.
 
-      CALL wrk_dealloc( jpi, jpj,      ztab2d )
-      CALL wrk_dealloc( jpi, jpj, jpk, ztab   )
-
-!Done in step
-!      CALL Agrif_ChildGrid_To_ParentGrid()
-!      CALL recompute_diags( kt )
-!      CALL Agrif_ParentGrid_To_ChildGrid()
-
-#endif
-
-   END SUBROUTINE Agrif_Update_Dyn
-
-   SUBROUTINE recompute_diags( kt )
-      !!---------------------------------------------
-      !!   *** ROUTINE recompute_diags ***
-      !!---------------------------------------------
-      INTEGER, INTENT(in) :: kt
-
-   END SUBROUTINE recompute_diags
+#  endif
+      
+   END SUBROUTINE Agrif_Update_Tke
+# endif /* key_zdftke */
 
    SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
@@ -127,11 +182,11 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
-
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
-      LOGICAL, iNTENT(in) :: before
-
+      LOGICAL, INTENT(in) :: before
+      !!
       INTEGER :: ji,jj,jk,jn
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          DO jn = n1,n2
@@ -146,5 +201,5 @@
       ELSE
          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
-         ! Add asselin part
+            ! Add asselin part
             DO jn = n1,n2
                DO jk=k1,k2
@@ -153,6 +208,6 @@
                         IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
                            tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 
-                              & + atfp * ( tabres(ji,jj,jk,jn) &
-                              &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
+                                 & + atfp * ( tabres(ji,jj,jk,jn) &
+                                 &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
                         ENDIF
                      ENDDO
@@ -161,5 +216,4 @@
             ENDDO
          ENDIF
-
          DO jn = n1,n2
             DO jk=k1,k2
@@ -174,5 +228,5 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updateTS
 
@@ -182,12 +236,13 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
-
+      !!
       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !! 
       INTEGER :: ji, jj, jk
       REAL(wp) :: zrhoy
-
+      !!---------------------------------------------
+      ! 
       IF (before) THEN
          zrhoy = Agrif_Rhoy()
@@ -209,5 +264,5 @@
                   IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
                      ub(ji,jj,jk) = ub(ji,jj,jk) & 
-                       & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)
+                           & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)
                   ENDIF
                   !
@@ -217,5 +272,5 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updateu
 
@@ -225,12 +280,13 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
-
+      !!
       INTEGER :: i1,i2,j1,j2,k1,k2
       INTEGER :: ji,jj,jk
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres
       LOGICAL :: before
-
+      !!
       REAL(wp) :: zrhox
-
+      !!---------------------------------------------      
+      !
       IF (before) THEN
          zrhox = Agrif_Rhox()
@@ -252,5 +308,5 @@
                   IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
                      vb(ji,jj,jk) = vb(ji,jj,jk) & 
-                       & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)
+                           & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)
                   ENDIF
                   !
@@ -260,5 +316,5 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updatev
 
@@ -268,13 +324,14 @@
       !!---------------------------------------------
 #  include "domzgr_substitute.h90"
-
+      !!
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !! 
       INTEGER :: ji, jj, jk
       REAL(wp) :: zrhoy
       REAL(wp) :: zcorr
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          zrhoy = Agrif_Rhoy()
@@ -326,5 +383,5 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE updateu2d
 
@@ -333,13 +390,13 @@
       !!          *** ROUTINE updatev2d ***
       !!---------------------------------------------
-
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !! 
       INTEGER :: ji, jj, jk
       REAL(wp) :: zrhox
       REAL(wp) :: zcorr
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          zrhox = Agrif_Rhox()
@@ -391,19 +448,19 @@
          END DO
       ENDIF
-
+      ! 
    END SUBROUTINE updatev2d
 
+
    SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before )
       !!---------------------------------------------
       !!          *** ROUTINE updateSSH ***
       !!---------------------------------------------
-#  include "domzgr_substitute.h90"
-
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !!
       INTEGER :: ji, jj
-
+      !!---------------------------------------------
+      ! 
       IF (before) THEN
          DO jj=j1,j2
@@ -413,11 +470,10 @@
          END DO
       ELSE
-
 #if ! defined key_dynspg_ts
          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
             DO jj=j1,j2
                DO ji=i1,i2
-                sshb(ji,jj) =   sshb(ji,jj) &
-                 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)
+                  sshb(ji,jj) =   sshb(ji,jj) &
+                        & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)
                END DO
             END DO
@@ -430,5 +486,5 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE updateSSH
 
@@ -437,12 +493,12 @@
       !!          *** ROUTINE updateub2b ***
       !!---------------------------------------------
-
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !!
       INTEGER :: ji, jj
       REAL(wp) :: zrhoy
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          zrhoy = Agrif_Rhoy()
@@ -460,5 +516,5 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE updateub2b
 
@@ -467,12 +523,12 @@
       !!          *** ROUTINE updatevb2b ***
       !!---------------------------------------------
-
       INTEGER, INTENT(in) :: i1, i2, j1, j2
       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
       LOGICAL, INTENT(in) :: before
-
+      !!
       INTEGER :: ji, jj
       REAL(wp) :: zrhox
-
+      !!---------------------------------------------
+      !
       IF (before) THEN
          zrhox = Agrif_Rhox()
@@ -490,6 +546,112 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE updatevb2b
+
+
+   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before )
+      ! currently not used
+      !!---------------------------------------------
+      !!           *** ROUTINE updateT ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"
+
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      LOGICAL, iNTENT(in) :: before
+
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: ztemp
+
+      IF (before) THEN
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tabres(ji,jj,jk,1) = e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
+                  tabres(ji,jj,jk,2) = e1t(ji,jj)*tmask(ji,jj,jk)
+                  tabres(ji,jj,jk,3) = e2t(ji,jj)*tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         tabres(:,:,:,1)=tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy()
+         tabres(:,:,:,2)=tabres(:,:,:,2)*Agrif_Rhox()
+         tabres(:,:,:,3)=tabres(:,:,:,3)*Agrif_Rhoy()
+      ELSE
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  IF( tabres(ji,jj,jk,1) .NE. 0. ) THEN 
+                     print *,'VAL = ',ji,jj,jk,tabres(ji,jj,jk,1),e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
+                     print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk)
+                     print *,'VAL3 = ',ji,jj,jk,tabres(ji,jj,jk,3),e2t(ji,jj)*tmask(ji,jj,jk)
+                     ztemp = sqrt(tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3)))
+                     print *,'CORR = ',ztemp-1.
+                     print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, &
+                           tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp
+                     e1t(ji,jj) = tabres(ji,jj,jk,2)*ztemp
+                     e2t(ji,jj) = tabres(ji,jj,jk,3)*ztemp
+                  END IF
+               END DO
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE update_scales
+
+# if defined key_zdftke
+   SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateen ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2)
+      ELSE
+         en(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
+      ENDIF
+      !
+   END SUBROUTINE updateEN
+
+
+   SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateavt ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
+      ENDIF
+      !
+   END SUBROUTINE updateAVT
+
+
+   SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateavm ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
+      ENDIF
+      !
+   END SUBROUTINE updateAVM
+
+# endif /* key_zdftke */ 
 
 #else
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 5682)
@@ -7,4 +7,5 @@
    USE agrif_oce
    USE agrif_top_sponge
+   USE par_trc
    USE trc
    USE lib_mpp
@@ -14,10 +15,10 @@
    PRIVATE
 
-   PUBLIC Agrif_trc
+   PUBLIC Agrif_trc, interptrn
 
 #  include "domzgr_substitute.h90"  
 #  include "vectopt_loop_substitute.h90"
   !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.6 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
@@ -28,114 +29,160 @@
    SUBROUTINE Agrif_trc
       !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_Tra  ***
-      !!----------------------------------------------------------------------
-      !!
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3
-      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra
+      !!                  ***  ROUTINE Agrif_trc  ***
       !!----------------------------------------------------------------------
       !
       IF( Agrif_Root() )   RETURN
 
-      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra )
-
       Agrif_SpecialValue    = 0.e0
       Agrif_UseSpecialValue = .TRUE.
-      ztra(:,:,:,:) = 0.e0
 
-      CALL Agrif_Bc_variable( ztra, trn_id, procname=interptrn )
+      CALL Agrif_Bc_variable( trn_id, procname=interptrn )
       Agrif_UseSpecialValue = .FALSE.
+      !
+   END SUBROUTINE Agrif_trc
 
-      zrhox = Agrif_Rhox()
+   SUBROUTINE interptrn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptrn ***
+      !!---------------------------------------------
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER :: imin, imax, jmin, jmax
+      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
+      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
 
-      alpha1 = ( zrhox - 1. ) * 0.5
-      alpha2 = 1. - alpha1
-
-      alpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
-      alpha4 = 1. - alpha3
-
-      alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
-      alpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
-      alpha5 = 1. - alpha6 - alpha7
-      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
-
-         DO jn = 1, jptra
-            tra(nlci,:,:,jn) = alpha1 * ztra(nlci,:,:,jn) + alpha2 * ztra(nlci-1,:,:,jn)
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
-                     tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
-                  ELSE
-                     tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
-                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
-                        tra(nlci-1,jj,jk,jn)=( alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn)  &
-                           &                 + alpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+      IF (before) THEN         
+         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE
+         !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         !
+         zrhox = Agrif_Rhox()
+         ! 
+         zalpha1 = ( zrhox - 1. ) * 0.5
+         zalpha2 = 1. - zalpha1
+         ! 
+         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
+         zalpha4 = 1. - zalpha3
+         ! 
+         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+         zalpha5 = 1. - zalpha6 - zalpha7
+         !
+         imin = i1
+         imax = i2
+         jmin = j1
+         jmax = j2
+         ! 
+         ! Remove CORNERS
+         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
+         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
+         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
+         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
+         !
+         IF( eastern_side) THEN
+            DO jn = 1, jptra
+               tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO jj = jmin,jmax
+                     IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
+                        tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                     ELSE
+                        tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
+                           tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 
+                                 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                        ENDIF
                      ENDIF
-                  ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         ! 
+         IF( northern_side ) THEN            
+            DO jn = 1, jptra
+               tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO ji = imin,imax
+                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
+                        tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                     ELSE
+                        tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
+                           tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn)  &
+                                 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         !
+         IF( western_side) THEN            
+            DO jn = 1, jptra
+               tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO jj = jmin,jmax
+                     IF( umask(2,jj,jk) == 0.e0 ) THEN
+                        tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
+                     ELSE
+                        tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)        
+                        IF( un(2,jj,jk) < 0.e0 ) THEN
+                           tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
                END DO
             END DO
-         ENDDO
-      ENDIF
-
-      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
-
-         DO jn = 1, jptra
-            tra(:,nlcj,:,jn) = alpha1 * ztra(:,nlcj,:,jn) + alpha2 * ztra(:,nlcj-1,:,jn)
-            DO jk = 1, jpkm1
-               DO ji = 1, jpi
-                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
-                     tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
-                  ELSE
-                     tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)
-                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
-                        tra(ji,nlcj-1,jk,jn)=( alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn)  &
-                           &                 + alpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+         ENDIF
+         !
+         IF( southern_side ) THEN           
+            DO jn = 1, jptra
+               tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
+               DO jk=1,jpk      
+                  DO ji=imin,imax
+                     IF( vmask(ji,2,jk) == 0.e0 ) THEN
+                        tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
+                     ELSE
+                        tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
+                        IF( vn(ji,2,jk) < 0.e0 ) THEN
+                           tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
+                        ENDIF
                      ENDIF
-                  ENDIF
+                  END DO
                END DO
-            END DO
-         ENDDO
-      ENDIF
-      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
-         DO jn = 1, jptra
-            tra(1,:,:,jn) = alpha1 * ztra(1,:,:,jn) + alpha2 * ztra(2,:,:,jn)
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  IF( umask(2,jj,jk) == 0.e0 ) THEN
-                     tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
-                  ELSE
-                     tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)
-                     IF( un(2,jj,jk) < 0.e0 ) THEN
-                        tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn)+alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      ENDIF
-
-      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
-         DO jn = 1, jptra
-            tra(:,1,:,jn) = alpha1 * ztra(:,1,:,jn) + alpha2 * ztra(:,2,:,jn)
-            DO jk=1,jpk
-               DO ji=1,jpi
-                  IF( vmask(ji,2,jk) == 0.e0 ) THEN
-                     tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
-                  ELSE
-                     tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
-                     IF( vn(ji,2,jk) < 0.e0 ) THEN
-                        tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)+alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         ENDDO
+            ENDDO
+         ENDIF
+         !
+         ! Treatment of corners
+         ! 
+         ! East south
+         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
+         ENDIF
+         ! East north
+         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
+         ENDIF
+         ! West south
+         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tra(2,2,:,:) = ptab(2,2,:,:)
+         ENDIF
+         ! West north
+         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
+         ENDIF
+         !
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )
-      !
-
-   END SUBROUTINE Agrif_trc
+   END SUBROUTINE interptrn
 
 #else
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 5682)
@@ -1,7 +1,8 @@
 #define SPONGE_TOP
 
-Module agrif_top_sponge
+MODULE agrif_top_sponge
 #if defined key_agrif && defined key_top
    USE par_oce
+   USE par_trc
    USE oce
    USE dom_oce
@@ -16,71 +17,31 @@
    PRIVATE
 
-   PUBLIC Agrif_Sponge_Trc, interptrn
+   PUBLIC Agrif_Sponge_trc, interptrn_sponge
 
-  !! * Substitutions
+   !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! NEMO/NST 3.6 , NEMO Consortium (2010)
    !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
-   CONTAINS
+CONTAINS
 
-   SUBROUTINE Agrif_Sponge_Trc
+   SUBROUTINE Agrif_Sponge_trc
       !!---------------------------------------------
       !!   *** ROUTINE Agrif_Sponge_Trc ***
       !!---------------------------------------------
       !! 
-      INTEGER :: ji,jj,jk,jn
       REAL(wp) :: timecoeff
-      REAL(wp) :: ztra, zabe1, zabe2, zbtr
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff
 
 #if defined SPONGE_TOP
-      CALL wrk_alloc( jpi, jpj, ztru, ztrv )
-      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff )
-
       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
-
+      CALL Agrif_sponge
       Agrif_SpecialValue=0.
       Agrif_UseSpecialValue = .TRUE.
-      ztabr = 0.e0
-      CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn)
+      tabspongedone_trn = .FALSE.
+      CALL Agrif_Bc_Variable(trn_sponge_id,calledweight=timecoeff,procname=interptrn_sponge)
       Agrif_UseSpecialValue = .FALSE.
-
-      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:)
-
-      CALL Agrif_sponge
-
-      DO jn = 1, jptra
-         DO jk = 1, jpkm1
-            !
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
-                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
-                  ztru(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
-                  ztrv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
-               ENDDO
-            ENDDO
-
-            DO jj = 2,jpjm1
-               DO ji = 2,jpim1
-                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
-                  ! horizontal diffusive trends
-                  ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1)  )
-                  ! add it to the general tracer trends
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-            !
-         ENDDO
-      ENDDO
- 
-      CALL wrk_dealloc( jpi, jpj, ztru, ztrv )
-      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr )
 
 #endif
@@ -88,14 +49,57 @@
    END SUBROUTINE Agrif_Sponge_Trc
 
-   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
+   SUBROUTINE interptrn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
       !!---------------------------------------------
-      !!   *** ROUTINE interptn ***
+      !!   *** ROUTINE interptrn_sponge ***
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+
+
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+
+      REAL(wp) :: ztra, zabe1, zabe2, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::trbdiff
       !
-      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      IF (before) THEN
+         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE      
 
-   END SUBROUTINE interptrn
+         trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)      
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+
+               DO jj = j1,j2-1
+                  DO ji = i1,i2-1
+                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
+                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
+                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                  ENDDO
+               ENDDO
+
+               DO jj = j1+1,j2-1
+                  DO ji = i1+1,i2-1
+
+                     IF (.NOT. tabspongedone_trn(ji,jj)) THEN 
+                        zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,jk)
+                        ! horizontal diffusive trends
+                        ztra = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  ) + ztv(ji,jj) - ztv(ji  ,jj-1)  )
+                        ! add it to the general tracer trends
+                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+                     ENDIF
+
+                  ENDDO
+               ENDDO
+
+            ENDDO
+         ENDDO
+
+         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+      ENDIF
+      !                 
+   END SUBROUTINE interptrn_sponge
 
 #else
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 5682)
@@ -1,3 +1,4 @@
 #define TWO_WAY
+#undef DECAL_FEEDBACK
 
 MODULE agrif_top_update
@@ -8,4 +9,5 @@
    USE dom_oce
    USE agrif_oce
+   USE par_trc
    USE trc
    USE wrk_nemo  
@@ -24,5 +26,5 @@
    !!----------------------------------------------------------------------
 
-   CONTAINS
+CONTAINS
 
    SUBROUTINE Agrif_Update_Trc( kt )
@@ -30,75 +32,65 @@
       !!   *** ROUTINE Agrif_Update_Trc ***
       !!---------------------------------------------
-      !!
       INTEGER, INTENT(in) :: kt
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra
-
-  
-      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
-
-#if defined TWO_WAY
-      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra )
-
+      !!---------------------------------------------
+      ! 
+      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
+#if defined TWO_WAY   
       Agrif_UseSpecialValueInUpdate = .TRUE.
       Agrif_SpecialValueFineGrid = 0.
- 
-     IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN
-         CALL Agrif_Update_Variable(ztra,trn_id, procname=updateTRC)
+      ! 
+      IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(trn_id, procname=updateTRC)
+# else
+         CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC)
+# endif
       ELSE
-         CALL Agrif_Update_Variable(ztra,trn_id,locupdate=(/0,2/), procname=updateTRC)
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(trn_id,locupdate=(/0,2/), procname=updateTRC)
+# else
+         CALL Agrif_Update_Variable(trn_id,locupdate=(/1,2/), procname=updateTRC)
+# endif
       ENDIF
-
+      !
       Agrif_UseSpecialValueInUpdate = .FALSE.
       nbcline_trc = nbcline_trc + 1
-
-      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )
 #endif
-
+      !
    END SUBROUTINE Agrif_Update_Trc
 
-   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
+   SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )
       !!---------------------------------------------
-      !!   *** ROUTINE UpdateTrc ***
+      !!           *** ROUTINE updateT ***
       !!---------------------------------------------
+#  include "domzgr_substitute.h90"
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
-      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
       LOGICAL, INTENT(in) :: before
-   
+      !!
       INTEGER :: ji,jj,jk,jn
-
-         IF( before ) THEN
-            DO jn = n1, n2
-               DO jk = k1, k2
-                  DO jj = j1, j2
-                     DO ji = i1, i2
-                        tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
-                     ENDDO
-                  ENDDO
-               ENDDO
-            ENDDO
-         ELSE
-            IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         DO jn = n1,n2
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
+                  END DO
+               END DO
+            END DO
+         END DO
+      ELSE
+         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
             ! Add asselin part
-               DO jn = n1, n2
-                  DO jk = k1, k2
-                     DO jj = j1, j2
-                        DO ji = i1, i2
-                           IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
-                              trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 
-                                 & + atfp * ( tabres(ji,jj,jk,jn) &
-                                               - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
-                           ENDIF
-                        ENDDO
-                     ENDDO
-                  ENDDO
-               ENDDO
-            ENDIF
-
-            DO jn = n1, n2
-               DO jk = k1, k2
-                  DO jj = j1, j2
-                     DO ji = i1, i2
-                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
-                           trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk)
+            DO jn = n1,n2
+               DO jk=k1,k2
+                  DO jj=j1,j2
+                     DO ji=i1,i2
+                        IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN
+                           trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 
+                                 & + atfp * ( ptab(ji,jj,jk,jn) &
+                                 &             - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
                         ENDIF
                      ENDDO
@@ -107,5 +99,17 @@
             ENDDO
          ENDIF
-
+         DO jn = n1,n2
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 
+                        trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk)
+                     END IF
+                  END DO
+               END DO
+            END DO
+         END DO
+      ENDIF
+      ! 
    END SUBROUTINE updateTRC
 
@@ -119,3 +123,3 @@
    END SUBROUTINE agrif_top_update_empty
 #endif
-END Module agrif_top_update
+END MODULE agrif_top_update
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 5682)
@@ -17,5 +17,4 @@
    USE par_oce
    USE dom_oce
-   USE Agrif_Util
    USE nemogcm
    !
@@ -31,5 +30,9 @@
       jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
       jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
-      jpk     = jpkdta 
+! JC: change to allow for different vertical levels
+!     jpk is already set
+!     keep it jpk possibly different from jpkdta which 
+!     hold parent grid vertical levels number (set earlier)
+!      jpk     = jpkdta 
       jpim1   = jpi-1 
       jpjm1   = jpj-1 
@@ -64,7 +67,7 @@
    ! 0. Initializations
    !-------------------
-   IF( cp_cfg == 'orca' ) then
+   IF( cp_cfg == 'orca' ) THEN
       IF ( jp_cfg == 2 .OR. jp_cfg == 025 .OR. jp_cfg == 05 &
-  &                      .OR. jp_cfg == 4 ) THEN
+            &                      .OR. jp_cfg == 4 ) THEN
          jp_cfg = -1    ! set special value for jp_cfg on fine grids
          cp_cfg = "default"
@@ -120,10 +123,10 @@
 SUBROUTINE agrif_declare_var_dom
    !!----------------------------------------------------------------------
-   !!                 *** ROUTINE agrif_declarE_var ***
+   !!                 *** ROUTINE agrif_declare_var ***
    !!
    !! ** Purpose :: Declaration of variables to be interpolated
    !!----------------------------------------------------------------------
    USE agrif_util
-   USE par_oce       !   ONLY : jpts
+   USE par_oce       
    USE oce
    IMPLICIT NONE
@@ -132,23 +135,26 @@
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
-
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
 
    ! 2. Type of interpolation
    !-------------------------
-   Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+   CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
 
    ! 3. Location of interpolation
    !-----------------------------
-   Call Agrif_Set_bc(e1u_id,(/0,0/))
-   Call Agrif_Set_bc(e2v_id,(/0,0/))
+   CALL Agrif_Set_bc(e1u_id,(/0,0/))
+   CALL Agrif_Set_bc(e2v_id,(/0,0/))
 
    ! 5. Update type
    !--------------- 
-   Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
-   Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
-
+   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
+   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
+
+! High order updates
+!   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average,            update2=Agrif_Update_Full_Weighting)
+!   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting,     update2=Agrif_Update_Average)
+    !
 END SUBROUTINE agrif_declare_var_dom
 
@@ -167,4 +173,5 @@
    USE nemogcm
    USE sol_oce
+   USE lib_mpp
    USE in_out_manager
    USE agrif_opa_update
@@ -174,14 +181,7 @@
    IMPLICIT NONE
    !
-   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp
-   REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp
-   REAL(wp), DIMENSION(:,:    ), ALLOCATABLE :: tab2d
    LOGICAL :: check_namelist
-   !!----------------------------------------------------------------------
-
-   ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) )
-   ALLOCATE( tabuvtemp(jpi, jpj, jpk)       )
-   ALLOCATE( tab2d(jpi, jpj)                )
-
+   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3
+   !!----------------------------------------------------------------------
 
    ! 1. Declaration of the type of variable which have to be interpolated
@@ -193,44 +193,69 @@
    Agrif_SpecialValue=0.
    Agrif_UseSpecialValue = .TRUE.
-   Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn)
-   Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn)
-
-   Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu)
-   Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv)
-   Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun)
-   Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn)
-
-   Call Agrif_Bc_variable(tab2d,unb_id,calledweight=1.,procname=interpunb)
-   Call Agrif_Bc_variable(tab2d,vnb_id,calledweight=1.,procname=interpvnb)
-   Call Agrif_Bc_variable(tab2d,sshn_id,calledweight=1.,procname=interpsshn)
-   Agrif_UseSpecialValue = .FALSE.
+   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
+   CALL Agrif_Sponge
+   tabspongedone_tsn = .FALSE.
+   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
+   ! reset tsa to zero
+   tsa(:,:,:,:) = 0.
+
+   Agrif_UseSpecialValue = ln_spc_dyn
+   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
+   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
+   tabspongedone_u = .FALSE.
+   tabspongedone_v = .FALSE.
+   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
+   tabspongedone_u = .FALSE.
+   tabspongedone_v = .FALSE.
+   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
+
+#if defined key_dynspg_ts
+   Agrif_UseSpecialValue = .TRUE.
+   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
+
+   Agrif_UseSpecialValue = ln_spc_dyn
+   CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
+   CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
+   CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
+   CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
+   ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0
+   ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 
+   ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 
+   ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0
+#endif
+
+   Agrif_UseSpecialValue = .FALSE. 
+   ! reset velocities to zero
+   ua(:,:,:) = 0.
+   va(:,:,:) = 0.
 
    ! 3. Some controls
    !-----------------
-   check_namelist = .true.
-
-   IF( check_namelist ) THEN
+   check_namelist = .TRUE.
+
+   IF( check_namelist ) THEN 
 
       ! Check time steps           
-      IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN
-         WRITE(*,*) 'incompatible time step between grids'
-         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
-         WRITE(*,*) 'child  grid value : ',nint(rdt)
-         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
-         STOP
+      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
+         WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt))
+         WRITE(cl_check2,*)  NINT(rdt)
+         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot())
+         CALL ctl_warn( 'incompatible time step between grids',   &
+               &               'parent grid value : '//cl_check1    ,   & 
+               &               'child  grid value : '//cl_check2    ,   & 
+               &               'value on child grid will be changed to : '//cl_check3 )
+         rdt=Agrif_Parent(rdt)/Agrif_Rhot()
       ENDIF
 
       ! Check run length
       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
-           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
-         WRITE(*,*) 'incompatible run length between grids'
-         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
-              Agrif_Parent(nit000)+1),' time step'
-         WRITE(*,*) 'child  grid value : ', &
-              (nitend-nit000+1),' time step'
-         WRITE(*,*) 'value on child grid should be : ', &
-              Agrif_IRhot() * (Agrif_Parent(nitend)- &
-              Agrif_Parent(nit000)+1)
-         STOP
+            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
+         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
+         CALL ctl_warn( 'incompatible run length between grids'               ,   &
+               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
+               &              ' nitend on fine grid will be change to : '//cl_check2    )
+         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
       ENDIF
 
@@ -238,5 +263,5 @@
       IF( ln_zps ) THEN
          ! check parameters for partial steps 
-         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
+         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
             WRITE(*,*) 'incompatible e3zps_min between grids'
             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
@@ -253,14 +278,47 @@
          ENDIF
       ENDIF
+      ! check if masks and bathymetries match
+      IF(ln_chk_bathy) THEN
+         !
+         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
+         !
+         kindic_agr = 0
+         ! check if umask agree with parent along western and eastern boundaries:
+         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
+         ! check if vmask agree with parent along northern and southern boundaries:
+         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
+	 ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
+         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
+         !
+         IF (lk_mpp) CALL mpp_sum( kindic_agr )
+         IF( kindic_agr /= 0 ) THEN             		
+            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
+         ELSE
+            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
+         END IF
+      ENDIF
+      !
    ENDIF
-
-   CALL Agrif_Update_tra(0)
-   CALL Agrif_Update_dyn(0)
-
+   ! 
+   ! Do update at initialisation because not done before writing restarts
+   ! This would indeed change boundary conditions values at initial time
+   ! hence produce restartability issues.
+   ! Note that update below is recursive (with lk_agrif_doupd=T):
+   ! 
+! JC: I am not sure if Agrif_MaxLevel() is the "relative"
+!     or the absolute maximum nesting level...TBC                        
+   IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 
+      ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics
+      CALL Agrif_Update_tra()
+      CALL Agrif_Update_dyn()
+   ENDIF
+   !
+# if defined key_zdftke
+   CALL Agrif_Update_tke(0)
+# endif
+   !
+   Agrif_UseSpecialValueInUpdate = .FALSE.
    nbcline = 0
-   !
-   DEALLOCATE(tabtstemp)
-   DEALLOCATE(tabuvtemp)
-   DEALLOCATE(tab2d)
+   lk_agrif_doupd = .FALSE.
    !
 END SUBROUTINE Agrif_InitValues_cont
@@ -276,4 +334,5 @@
    USE par_oce       !   ONLY : jpts
    USE oce
+   USE agrif_oce
    IMPLICIT NONE
    !!----------------------------------------------------------------------
@@ -281,68 +340,120 @@
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id)
-
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id)
-   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id)
-   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id)
-
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id)
-   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id)
-   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id)
-   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_id)
-   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
+
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
+
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
+
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
+
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
+
+   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
+
+# if defined key_zdftke
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
+# endif
 
    ! 2. Type of interpolation
    !-------------------------
    CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
-   CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear)
-
-   Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-
-   Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
 
    CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
-   Call Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   Call Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
-   Call Agrif_Set_bcinterp(ub2b_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   Call Agrif_Set_bcinterp(vb2b_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+
+   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
+   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
+   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
+
+# if defined key_zdftke
+   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear)
+# endif
+
 
    ! 3. Location of interpolation
    !-----------------------------
-   Call Agrif_Set_bc(un_id,(/0,1/))
-   Call Agrif_Set_bc(vn_id,(/0,1/))
-
-   Call Agrif_Set_bc(sshn_id,(/0,1/))
-   Call Agrif_Set_bc(unb_id,(/0,1/))
-   Call Agrif_Set_bc(vnb_id,(/0,1/))
-   Call Agrif_Set_bc(ub2b_id,(/0,1/))
-   Call Agrif_Set_bc(vb2b_id,(/0,1/))
-
-   Call Agrif_Set_bc(tsn_id,(/0,1/))
-   Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/))
-
-   Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/))
-   Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/))
+   CALL Agrif_Set_bc(tsn_id,(/0,1/))
+   CALL Agrif_Set_bc(un_interp_id,(/0,1/))
+   CALL Agrif_Set_bc(vn_interp_id,(/0,1/))
+
+!   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/))
+!   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/))
+!   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/))
+   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+
+   CALL Agrif_Set_bc(sshn_id,(/0,0/))
+   CALL Agrif_Set_bc(unb_id ,(/0,0/))
+   CALL Agrif_Set_bc(vnb_id ,(/0,0/))
+   CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/))
+   CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/))
+
+   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9
+   CALL Agrif_Set_bc(umsk_id,(/0,0/))
+   CALL Agrif_Set_bc(vmsk_id,(/0,0/))
+
+# if defined key_zdftke
+   CALL Agrif_Set_bc(avm_id ,(/0,1/))
+# endif
 
    ! 5. Update type
    !--------------- 
-   Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
-   Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average)
-
-   Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
-   Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average)
-
-   Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
-   Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
-
-   Call Agrif_Set_Updatetype(ub2b_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
-   Call Agrif_Set_Updatetype(vb2b_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
-
+   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
+
+   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
+
+   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+
+   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
+
+   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+
+# if defined key_zdftke
+   CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
+   CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
+   CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
+# endif
+
+! High order updates
+!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
+!   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
+!   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
+!
+!   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
+!   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
+!   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
+ 
+   !
 END SUBROUTINE agrif_declare_var
 # endif
@@ -365,9 +476,5 @@
    IMPLICIT NONE
    !
-   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: zvel
-   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zadv
-   !!----------------------------------------------------------------------
-
-   ALLOCATE( zvel(jpi,jpj), zadv(jpi,jpj,7))
+   !!----------------------------------------------------------------------
 
    ! 1. Declaration of the type of variable which have to be interpolated
@@ -401,6 +508,4 @@
    CALL Agrif_Update_lim2(0)
    !
-   DEALLOCATE( zvel, zadv )
-   !
 END SUBROUTINE Agrif_InitValues_cont_lim2
 
@@ -431,19 +536,19 @@
    !-------------------------
    CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
-   Call Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
-   Call Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+   CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
 
    ! 3. Location of interpolation
    !-----------------------------
-   Call Agrif_Set_bc(adv_ice_id ,(/0,1/))
-   Call Agrif_Set_bc(u_ice_id,(/0,1/))
-   Call Agrif_Set_bc(v_ice_id,(/0,1/))
+   CALL Agrif_Set_bc(adv_ice_id ,(/0,1/))
+   CALL Agrif_Set_bc(u_ice_id,(/0,1/))
+   CALL Agrif_Set_bc(v_ice_id,(/0,1/))
 
    ! 5. Update type
    !---------------
-   Call Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
-   Call Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
-   Call Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
-
+   CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
+   CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+   CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+   ! 
 END SUBROUTINE agrif_declare_var_lim2
 #  endif
@@ -462,6 +567,8 @@
    USE nemogcm
    USE par_trc
+   USE lib_mpp
    USE trc
    USE in_out_manager
+   USE agrif_opa_sponge
    USE agrif_top_update
    USE agrif_top_interp
@@ -470,9 +577,7 @@
    IMPLICIT NONE
    !
-   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp
+   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
    LOGICAL :: check_namelist
    !!----------------------------------------------------------------------
-
-   ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) )
 
 
@@ -485,35 +590,42 @@
    Agrif_SpecialValue=0.
    Agrif_UseSpecialValue = .TRUE.
-   Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn)
-   Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn)
+   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
    Agrif_UseSpecialValue = .FALSE.
+   CALL Agrif_Sponge
+   tabspongedone_trn = .FALSE.
+   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
+   ! reset tsa to zero
+   tra(:,:,:,:) = 0.
+
 
    ! 3. Some controls
    !-----------------
-   check_namelist = .true.
+   check_namelist = .TRUE.
 
    IF( check_namelist ) THEN
-#  if defined offline     
+# if defined key_offline
       ! Check time steps
-      IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
-         WRITE(*,*) 'incompatible time step between grids'
-         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
-         WRITE(*,*) 'child  grid value : ',nint(rdt)
-         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
-         STOP
+      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
+         WRITE(cl_check1,*)  Agrif_Parent(rdt)
+         WRITE(cl_check2,*)  rdt
+         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
+         CALL ctl_warn( 'incompatible time step between grids',   &
+               &               'parent grid value : '//cl_check1    ,   & 
+               &               'child  grid value : '//cl_check2    ,   & 
+               &               'value on child grid will be changed to  &
+               &               :'//cl_check3  )
+         rdt=rdt*Agrif_Rhot()
       ENDIF
 
       ! Check run length
       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
-           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
-         WRITE(*,*) 'incompatible run length between grids'
-         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
-              Agrif_Parent(nit000)+1),' time step'
-         WRITE(*,*) 'child  grid value : ', &
-              (nitend-nit000+1),' time step'
-         WRITE(*,*) 'value on child grid should be : ', &
-              Agrif_IRhot() * (Agrif_Parent(nitend)- &
-              Agrif_Parent(nit000)+1)
-         STOP
+            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
+         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
+         CALL ctl_warn( 'incompatible run length between grids'               ,   &
+               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
+               &              ' nitend on fine grid will be change to : '//cl_check2    )
+         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
       ENDIF
 
@@ -521,5 +633,5 @@
       IF( ln_zps ) THEN
          ! check parameters for partial steps 
-         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
+         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
             WRITE(*,*) 'incompatible e3zps_min between grids'
             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
@@ -528,5 +640,5 @@
             STOP
          ENDIF
-         IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN
+         IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN
             WRITE(*,*) 'incompatible e3zps_rat between grids'
             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
@@ -538,13 +650,13 @@
 #  endif         
       ! Check passive tracer cell
-      IF( nn_dttrc .ne. 1 ) THEN
+      IF( nn_dttrc .NE. 1 ) THEN
          WRITE(*,*) 'nn_dttrc should be equal to 1'
       ENDIF
    ENDIF
 
-!ch   CALL Agrif_Update_trc(0)
+   CALL Agrif_Update_trc(0)
+   !
+   Agrif_UseSpecialValueInUpdate = .FALSE.
    nbcline_trc = 0
-   !
-   DEALLOCATE(tabtrtemp)
    !
 END SUBROUTINE Agrif_InitValues_cont_top
@@ -558,4 +670,5 @@
    !!----------------------------------------------------------------------
    USE agrif_util
+   USE agrif_oce
    USE dom_oce
    USE trc
@@ -565,24 +678,26 @@
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id)
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)
 
    ! 2. Type of interpolation
    !-------------------------
    CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
-   CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear)
+   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
 
    ! 3. Location of interpolation
    !-----------------------------
-   Call Agrif_Set_bc(trn_id,(/0,1/))
-   Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/))
+   CALL Agrif_Set_bc(trn_id,(/0,1/))
+!   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/))
+   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
 
    ! 5. Update type
    !--------------- 
-   Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
-   Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average)
-
-
+   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
+
+!   Higher order update
+!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
+
+   !
 END SUBROUTINE agrif_declare_var_top
 # endif
@@ -592,5 +707,4 @@
    !!   *** ROUTINE Agrif_detect ***
    !!----------------------------------------------------------------------
-   USE Agrif_Types
    !
    INTEGER, DIMENSION(2) :: ksizex
@@ -614,15 +728,16 @@
    !
    INTEGER  ::   ios                 ! Local integer output status for namelist read
-   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn
-   !!----------------------------------------------------------------------
-   !
-      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
-      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
-      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namagrif )
+   INTEGER  ::   iminspon
+   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
+   !!--------------------------------------------------------------------------------------
+   !
+   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
+   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
+
+   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
+   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
+902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
+   IF(lwm) WRITE ( numond, namagrif )
    !
    IF(lwp) THEN                    ! control print
@@ -635,4 +750,5 @@
       WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
       WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
+      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
       WRITE(numout,*) 
    ENDIF
@@ -643,5 +759,10 @@
    visc_dyn      = rn_sponge_dyn
    !
-   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed')
+   ! Check sponge length:
+   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
+   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
+   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
+   !
+   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
 # if defined key_lim2
    IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed')
@@ -664,10 +785,45 @@
    SELECT CASE( i )
    CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
-   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
-   CASE(3)   ;   indglob = indloc
-   CASE(4)   ;   indglob = indloc
+   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
+   CASE DEFAULT
+      indglob = indloc
    END SELECT
    !
 END SUBROUTINE Agrif_InvLoc
+
+SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE Agrif_get_proc_info ***
+   !!----------------------------------------------------------------------
+   USE par_oce
+   IMPLICIT NONE
+   !
+   INTEGER, INTENT(out) :: imin, imax
+   INTEGER, INTENT(out) :: jmin, jmax
+   !!----------------------------------------------------------------------
+   !
+   imin = nimppt(Agrif_Procrank+1)  ! ?????
+   jmin = njmppt(Agrif_Procrank+1)  ! ?????
+   imax = imin + jpi - 1
+   jmax = jmin + jpj - 1
+   ! 
+END SUBROUTINE Agrif_get_proc_info
+
+SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
+   !!----------------------------------------------------------------------
+   USE par_oce
+   IMPLICIT NONE
+   !
+   INTEGER,  INTENT(in)  :: imin, imax
+   INTEGER,  INTENT(in)  :: jmin, jmax
+   INTEGER,  INTENT(in)  :: nbprocs
+   REAL(wp), INTENT(out) :: grid_cost
+   !!----------------------------------------------------------------------
+   !
+   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
+   !
+END SUBROUTINE Agrif_estimate_parallel_cost
 
 # endif
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/domain.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/domain.F90	(revision 5659)
+++ 	(revision )
@@ -1,428 +1,0 @@
-MODULE domain
-   !!==============================================================================
-   !!                       ***  MODULE domain   ***
-   !! Ocean initialization : domain initialization
-   !!==============================================================================
-
-   !!----------------------------------------------------------------------
-   !!   dom_init       : initialize the space and time domain
-   !!   dom_nam        : read and contral domain namelists
-   !!   dom_ctl        : control print for the ocean domain
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! 
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distributed memory computing library
-
-   USE domstp          ! domain: set the time-step
-   USE domrea          ! domain: write the meshmask file
-   USE dommsk          ! domain : mask
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC dom_init       ! called by opa.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE dom_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dom_init  ***
-      !!                    
-      !! ** Purpose :   Domain initialization. Call the routines that are 
-      !!      required to create the arrays which define the space and time
-      !!      domain of the ocean model.
-      !!
-      !! ** Method  :
-      !!      - dom_stp: defined the model time step
-      !!      - dom_rea: read the meshmask file if nmsh=1
-      !!
-      !! History :
-      !!        !  90-10  (C. Levy - G. Madec)  Original code
-      !!        !  91-11  (G. Madec)
-      !!        !  92-01  (M. Imbard) insert time step initialization
-      !!        !  96-06  (G. Madec) generalized vertical coordinate 
-      !!        !  97-02  (G. Madec) creation of domwri.F
-      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
-      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER ::   jk                ! dummy loop argument
-      INTEGER ::   iconf = 0         ! temporary integers
-      !!----------------------------------------------------------------------
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_init : domain initialization'
-         WRITE(numout,*) '~~~~~~~~'
-      ENDIF
-
-      CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
-      CALL dom_zgr      ! Vertical mesh and bathymetry option
-      CALL dom_rea      ! Create a domain file
-
-     !
-      ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines
-      !        but could be usefull in many other routines
-      e12t    (:,:) = e1t(:,:) * e2t(:,:)
-      e1e2t   (:,:) = e1t(:,:) * e2t(:,:)
-      e12u    (:,:) = e1u(:,:) * e2u(:,:)
-      e12v    (:,:) = e1v(:,:) * e2v(:,:)
-      e12f    (:,:) = e1f(:,:) * e2f(:,:)
-      r1_e12t (:,:) = 1._wp    / e12t(:,:)
-      r1_e12u (:,:) = 1._wp    / e12u(:,:)
-      r1_e12v (:,:) = 1._wp    / e12v(:,:)
-      r1_e12f (:,:) = 1._wp    / e12f(:,:)
-      re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)
-      re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)
-      !
-      hu(:,:) = 0._wp                          ! Ocean depth at U- and V-points
-      hv(:,:) = 0._wp
-      DO jk = 1, jpk
-         hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
-         hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
-      END DO
-      !                                        ! Inverse of the local depth
-      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)
-      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)
-
-      CALL dom_stp      ! Time step
-      CALL dom_msk      ! Masks
-      CALL dom_ctl      ! Domain control
-
-   END SUBROUTINE dom_init
-
-   SUBROUTINE dom_nam
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE dom_nam  ***
-      !!                    
-      !! ** Purpose :   read domaine namelists and print the variables.
-      !!
-      !! ** input   : - namrun namelist
-      !!              - namdom namelist
-      !!              - namcla namelist
-      !!----------------------------------------------------------------------
-      USE ioipsl
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
-         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
-         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz, nn_euler
-      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
-         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
-         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea , ln_crs, &
-         &             jphgr_msh, &
-         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
-         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
-         &             ppa2, ppkth2, ppacr2
-      NAMELIST/namcla/ nn_cla
-#if defined key_netcdf4
-      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
-#endif
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
-      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
-      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namrun )
-      !
-      IF(lwp) THEN                  ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
-         WRITE(numout,*) '~~~~~~~ '
-         WRITE(numout,*) '   Namelist namrun'  
-         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
-         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
-         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
-         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
-         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
-         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
-         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
-         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
-         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
-         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
-         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
-         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
-         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
-         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
-         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
-      ENDIF
-      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
-      cexper = cn_exp
-      nrstdt = nn_rstctl
-      nit000 = nn_it000
-      nitend = nn_itend
-      ndate0 = nn_date0
-      nleapy = nn_leapy
-      ninist = nn_istate
-      nstock = nn_stock
-      nwrite = nn_write
-
-
-      !                             ! control of output frequency
-      IF ( nstock == 0 .OR. nstock > nitend ) THEN
-         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
-         CALL ctl_warn( ctmp1 )
-         nstock = nitend
-      ENDIF
-      IF ( nwrite == 0 ) THEN
-         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
-         CALL ctl_warn( ctmp1 )
-         nwrite = nitend
-      ENDIF
-
-      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
-      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
-      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
-
-#if defined key_agrif
-      IF( Agrif_Root() ) THEN
-#endif
-      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
-      CASE (  1 ) 
-         CALL ioconf_calendar('gregorian')
-         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
-      CASE (  0 )
-         CALL ioconf_calendar('noleap')
-         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
-      CASE ( 30 )
-         CALL ioconf_calendar('360d')
-         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
-      END SELECT
-#if defined key_agrif
-      ENDIF
-#endif
-
-      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
-      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
-903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
-      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
-904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namdom )
-
-      IF(lwp) THEN
-         WRITE(numout,*) 
-         WRITE(numout,*) '   Namelist namdom : space & time domain'
-         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
-         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
-         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
-         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
-         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
-         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
-         WRITE(numout,*) '           = 0   no file created                 '
-         WRITE(numout,*) '           = 1   mesh_mask                       '
-         WRITE(numout,*) '           = 2   mesh and mask                   '
-         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
-         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
-         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
-         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
-         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
-         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
-         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
-         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
-         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
-         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
-         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
-         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
-         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
-         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
-         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
-         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
-         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
-         WRITE(numout,*) '                                        ppa0            = ', ppa0
-         WRITE(numout,*) '                                        ppa1            = ', ppa1
-         WRITE(numout,*) '                                        ppkth           = ', ppkth
-         WRITE(numout,*) '                                        ppacr           = ', ppacr
-         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
-         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
-         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
-         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
-         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
-         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
-      ENDIF
-
-      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
-      e3zps_min = rn_e3zps_min
-      e3zps_rat = rn_e3zps_rat
-      nmsh      = nn_msh
-      nacc      = nn_acc
-      atfp      = rn_atfp
-      rdt       = rn_rdt
-      rdtmin    = rn_rdtmin
-      rdtmax    = rn_rdtmin
-      rdth      = rn_rdth
-
-      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection
-      READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
-905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection
-      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
-906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
-      IF(lwm) WRITE( numond, namcla )
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namcla'
-         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
-      ENDIF
-
-#if defined key_netcdf4
-      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
-      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
-      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
-907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
-      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
-908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
-      IF(lwm) WRITE( numond, namnc4 )
-      IF(lwp) THEN                        ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
-         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
-         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
-         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
-         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
-      ENDIF
-
-      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
-      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
-      snc4set%ni   = nn_nchunks_i
-      snc4set%nj   = nn_nchunks_j
-      snc4set%nk   = nn_nchunks_k
-      snc4set%luse = ln_nc4zip
-#else
-      snc4set%luse = .FALSE.        ! No NetCDF 4 case
-#endif
-      !
-   END SUBROUTINE dom_nam
-
-   SUBROUTINE dom_zgr
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE dom_zgr  ***
-      !!                   
-      !! ** Purpose :  set the depth of model levels and the resulting 
-      !!      vertical scale factors.
-      !!
-      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d)
-      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
-      !!              - vertical coordinate (gdep., e3.) depending on the 
-      !!                coordinate chosen :
-      !!                   ln_zco=T   z-coordinate  
-      !!                   ln_zps=T   z-coordinate with partial steps
-      !!                   ln_zco=T   s-coordinate 
-      !!
-      !! ** Action  :   define gdep., e3., mbathy and bathy
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio = 0   ! temporary integer
-      INTEGER ::   ios
-      !!
-      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
-      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
-
-      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
-      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
-      IF(lwm) WRITE ( numond, namzgr )
-
-      IF(lwp) THEN                     ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_zgr : vertical coordinate'
-         WRITE(numout,*) '~~~~~~~'
-         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
-         WRITE(numout,*) '             z-coordinate - full steps      ln_zco    = ', ln_zco
-         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps    = ', ln_zps
-         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
-         WRITE(numout,*) '             ice shelf cavity               ln_isfcav = ', ln_isfcav
-      ENDIF
-
-      ioptio = 0                       ! Check Vertical coordinate options
-      IF( ln_zco ) ioptio = ioptio + 1
-      IF( ln_zps ) ioptio = ioptio + 1
-      IF( ln_sco ) ioptio = ioptio + 1
-      IF( ln_isfcav ) ioptio = 33
-      IF ( ioptio /= 1  )   CALL ctl_stop( ' none or several vertical coordinate options used' )
-      IF ( ioptio == 33 )   CALL ctl_stop( ' isf cavity with off line module not yet done    ' )
-
-   END SUBROUTINE dom_zgr
-
-   SUBROUTINE dom_ctl
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE dom_ctl  ***
-      !!
-      !! ** Purpose :   Domain control.
-      !!
-      !! ** Method  :   compute and print extrema of masked scale factors
-      !!
-      !! History :
-      !!   8.5  !  02-08  (G. Madec)    Original code
-      !!----------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
-      INTEGER, DIMENSION(2) ::   iloc      ! 
-      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
-      !!----------------------------------------------------------------------
-
-      ! Extrema of the scale factors
-
-      IF(lwp)WRITE(numout,*)
-      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
-      IF(lwp)WRITE(numout,*) '~~~~~~~'
-
-      IF (lk_mpp) THEN
-         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
-         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
-         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
-         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
-      ELSE
-         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
-         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
-         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
-         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
-
-         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
-         iimi1 = iloc(1) + nimpp - 1
-         ijmi1 = iloc(2) + njmpp - 1
-         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
-         iimi2 = iloc(1) + nimpp - 1
-         ijmi2 = iloc(2) + njmpp - 1
-         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
-         iima1 = iloc(1) + nimpp - 1
-         ijma1 = iloc(2) + njmpp - 1
-         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
-         iima2 = iloc(1) + nimpp - 1
-         ijma2 = iloc(2) + njmpp - 1
-      ENDIF
-
-      IF(lwp) THEN
-         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
-         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
-         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
-         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
-      ENDIF
-
-   END SUBROUTINE dom_ctl
-
-   !!======================================================================
-END MODULE domain
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/dommsk.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/dommsk.F90	(revision 5659)
+++ 	(revision )
@@ -1,104 +1,0 @@
-MODULE dommsk
-   !!======================================================================
-   !!                       ***  MODULE dommsk   ***
-   !! Ocean initialization : domain land/sea masks, off-line case 
-   !!======================================================================
-   !! History :  3.3  ! 2010-10  (C. Ethe)  adapted from OPA_SRC/DOM/dommsk
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   dom_msk        : compute land/ocean mask
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE lib_mpp         ! MPP library
-   USE in_out_manager  ! I/O manager
-   USE wrk_nemo  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dom_msk    ! routine called by inidom.F90
-
-   REAL(wp)        :: rn_shlat   = 2.   ! type of lateral boundary condition on velocity
-   LOGICAL, PUBLIC :: ln_vorlat  = .false.   !  consistency of vorticity boundary condition 
-
-   !! * Substitutions
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE dom_msk
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE dom_msk  ***
-      !!
-      !! ** Purpose :   Off-line case: defines the interior domain T-mask.
-      !!
-      !! ** Method  :   The interior ocean/land mask is computed from tmask
-      !!              setting to zero the duplicated row and lines due to
-      !!              MPP exchange halos, est-west cyclic and north fold
-      !!              boundary conditions.
-      !!
-      !! ** Action :   tmask_i  : interiorland/ocean mask at t-point
-      !!               tpol     : ???
-      !!----------------------------------------------------------------------
-      !
-      INTEGER  ::   ji, jk                   ! dummy loop indices
-      INTEGER  ::   iif, iil, ijf, ijl       ! local integers
-      INTEGER, POINTER, DIMENSION(:,:) ::  imsk 
-      !
-      !!---------------------------------------------------------------------
-      
-      CALL wrk_alloc( jpi, jpj, imsk )
-      !
-      ! Interior domain mask (used for global sum)
-      ! --------------------
-      ssmask(:,:)  = tmask(:,:,1)
-      tmask_i(:,:) = tmask(:,:,1)
-      iif = jpreci                        ! thickness of exchange halos in i-axis
-      iil = nlci - jpreci + 1
-      ijf = jprecj                        ! thickness of exchange halos in j-axis
-      ijl = nlcj - jprecj + 1
-      !
-      tmask_i( 1 :iif,   :   ) = 0._wp    ! first columns
-      tmask_i(iil:jpi,   :   ) = 0._wp    ! last  columns (including mpp extra columns)
-      tmask_i(   :   , 1 :ijf) = 0._wp    ! first rows
-      tmask_i(   :   ,ijl:jpj) = 0._wp    ! last  rows (including mpp extra rows)
-      !
-      !                                   ! north fold mask
-      tpol(1:jpiglo) = 1._wp
-      !                                
-      IF( jperio == 3 .OR. jperio == 4 )   tpol(jpiglo/2+1:jpiglo) = 0._wp    ! T-point pivot
-      IF( jperio == 5 .OR. jperio == 6 )   tpol(     1    :jpiglo) = 0._wp    ! F-point pivot
-      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row
-         IF( mjg(ijl-1) == jpjglo-1 ) THEN
-            DO ji = iif+1, iil-1
-               tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji))
-            END DO
-         ENDIF
-      ENDIF 
-      !
-      IF( nprint == 1 .AND. lwp ) THEN    ! Control print
-         imsk(:,:) = INT( tmask_i(:,:) )
-         WRITE(numout,*) ' tmask_i : '
-         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
-         WRITE (numout,*)
-         WRITE (numout,*) ' dommsk: tmask for each level'
-         WRITE (numout,*) ' ----------------------------'
-         DO jk = 1, jpk
-            imsk(:,:) = INT( tmask(:,:,jk) )
-            WRITE(numout,*)
-            WRITE(numout,*) ' level = ',jk
-            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
-         END DO
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, imsk )
-      !
-   END SUBROUTINE dom_msk
-   !!======================================================================
-END MODULE dommsk
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/domrea.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/domrea.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/domrea.F90	(revision 5682)
@@ -1,35 +1,41 @@
 MODULE domrea
-   !!======================================================================
-   !!                       ***  MODULE domrea  ***
-   !! Ocean initialization : read the ocean domain meshmask file(s)
-   !!======================================================================
-   !! History :  3.3  ! 2010-05  (C. Ethe)  Full reorganization of the off-line
+   !!==============================================================================
+   !!                       ***  MODULE domrea   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+
    !!----------------------------------------------------------------------
-
+   !!   dom_init       : initialize the space and time domain
+   !!   dom_nam        : read and contral domain namelists
+   !!   dom_ctl        : control print for the ocean domain
    !!----------------------------------------------------------------------
-   !!   dom_rea        : read mesh and mask file(s)
-   !!                    nmsh = 1  :   mesh_mask file
-   !!                         = 2  :   mesh and mask file
-   !!                         = 3  :   mesh_hgr, mesh_zgr and mask
-   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! 
    USE dom_oce         ! ocean space and time domain
-   USE dommsk          ! domain: masks
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing library
+
+   USE domstp          ! domain: set the time-step
+
    USE lbclnk          ! lateral boundary condition - MPP exchanges
    USE trc_oce         ! shared ocean/biogeochemical variables
-   USE lib_mpp 
-   USE in_out_manager
    USE wrk_nemo  
-
+   
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   dom_rea    ! routine called by inidom.F90
-  !! * Substitutions
+   !! * Routine accessibility
+   PUBLIC dom_rea       ! called by opa.F90
+
+   !! * Substitutions
 #  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OFF 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
+
 CONTAINS
 
@@ -37,4 +43,395 @@
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dom_rea  ***
+      !!                    
+      !! ** Purpose :   Domain initialization. Call the routines that are 
+      !!      required to create the arrays which define the space and time
+      !!      domain of the ocean model.
+      !!
+      !! ** Method  :
+      !!      - dom_stp: defined the model time step
+      !!      - dom_rea: read the meshmask file if nmsh=1
+      !!
+      !! History :
+      !!        !  90-10  (C. Levy - G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  92-01  (M. Imbard) insert time step initialization
+      !!        !  96-06  (G. Madec) generalized vertical coordinate 
+      !!        !  97-02  (G. Madec) creation of domwri.F
+      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   jk                ! dummy loop argument
+      INTEGER ::   iconf = 0         ! temporary integers
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+
+      CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
+      CALL dom_zgr      ! Vertical mesh and bathymetry option
+      CALL dom_grd      ! Create a domain file
+
+     !
+      ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines
+      !        but could be usefull in many other routines
+      e12t    (:,:) = e1t(:,:) * e2t(:,:)
+      e1e2t   (:,:) = e1t(:,:) * e2t(:,:)
+      e12u    (:,:) = e1u(:,:) * e2u(:,:)
+      e12v    (:,:) = e1v(:,:) * e2v(:,:)
+      e12f    (:,:) = e1f(:,:) * e2f(:,:)
+      r1_e12t (:,:) = 1._wp    / e12t(:,:)
+      r1_e12u (:,:) = 1._wp    / e12u(:,:)
+      r1_e12v (:,:) = 1._wp    / e12v(:,:)
+      r1_e12f (:,:) = 1._wp    / e12f(:,:)
+      re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)
+      re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)
+      !
+      hu(:,:) = 0._wp                          ! Ocean depth at U- and V-points
+      hv(:,:) = 0._wp
+      DO jk = 1, jpk
+         hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
+         hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
+      END DO
+      !                                        ! Inverse of the local depth
+      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)
+      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)
+
+      CALL dom_stp      ! Time step
+      CALL dom_msk      ! Masks
+      CALL dom_ctl      ! Domain control
+
+   END SUBROUTINE dom_rea
+
+   SUBROUTINE dom_nam
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read domaine namelists and print the variables.
+      !!
+      !! ** input   : - namrun namelist
+      !!              - namdom namelist
+      !!              - namcla namelist
+      !!----------------------------------------------------------------------
+      USE ioipsl
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               &
+         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
+         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
+         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler
+      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
+         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
+         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea , ln_crs, &
+         &             jphgr_msh, &
+         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
+         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
+         &             ppa2, ppkth2, ppacr2
+      NAMELIST/namcla/ nn_cla
+#if defined key_netcdf4
+      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
+#endif
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
+      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namrun )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namrun'  
+         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
+         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
+         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
+         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
+         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
+         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
+         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
+         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
+         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
+         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
+         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
+         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
+         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
+         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
+         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
+         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
+      ENDIF
+      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
+      cexper = cn_exp
+      nrstdt = nn_rstctl
+      nit000 = nn_it000
+      nitend = nn_itend
+      ndate0 = nn_date0
+      nleapy = nn_leapy
+      ninist = nn_istate
+      nstock = nn_stock
+      nstocklist = nn_stocklist
+      nwrite = nn_write
+
+
+      !                             ! control of output frequency
+      IF ( nstock == 0 .OR. nstock > nitend ) THEN
+         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nstock = nitend
+      ENDIF
+      IF ( nwrite == 0 ) THEN
+         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nwrite = nitend
+      ENDIF
+
+      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
+      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
+      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+
+#if defined key_agrif
+      IF( Agrif_Root() ) THEN
+#endif
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE (  1 ) 
+         CALL ioconf_calendar('gregorian')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
+      CASE (  0 )
+         CALL ioconf_calendar('noleap')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
+      CASE ( 30 )
+         CALL ioconf_calendar('360d')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
+      END SELECT
+#if defined key_agrif
+      ENDIF
+#endif
+
+      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdom )
+
+      IF(lwp) THEN
+         WRITE(numout,*) 
+         WRITE(numout,*) '   Namelist namdom : space & time domain'
+         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
+         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
+         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
+         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
+         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
+         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
+         WRITE(numout,*) '           = 0   no file created                 '
+         WRITE(numout,*) '           = 1   mesh_mask                       '
+         WRITE(numout,*) '           = 2   mesh and mask                   '
+         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
+         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
+         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
+         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
+         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
+         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
+         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
+         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
+         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
+         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
+         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
+         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
+         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
+         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
+         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
+         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
+         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
+         WRITE(numout,*) '                                        ppa0            = ', ppa0
+         WRITE(numout,*) '                                        ppa1            = ', ppa1
+         WRITE(numout,*) '                                        ppkth           = ', ppkth
+         WRITE(numout,*) '                                        ppacr           = ', ppacr
+         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
+         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
+         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
+         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
+         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
+         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
+      ENDIF
+
+      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
+      e3zps_min = rn_e3zps_min
+      e3zps_rat = rn_e3zps_rat
+      nmsh      = nn_msh
+      nacc      = nn_acc
+      atfp      = rn_atfp
+      rdt       = rn_rdt
+      rdtmin    = rn_rdtmin
+      rdtmax    = rn_rdtmin
+      rdth      = rn_rdth
+
+      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection
+      READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
+905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection
+      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
+906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
+      IF(lwm) WRITE( numond, namcla )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namcla'
+         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
+      ENDIF
+
+#if defined key_netcdf4
+      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
+      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
+      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
+907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
+      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
+908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
+      IF(lwm) WRITE( numond, namnc4 )
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
+         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
+         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
+         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
+         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
+      ENDIF
+
+      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
+      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
+      snc4set%ni   = nn_nchunks_i
+      snc4set%nj   = nn_nchunks_j
+      snc4set%nk   = nn_nchunks_k
+      snc4set%luse = ln_nc4zip
+#else
+      snc4set%luse = .FALSE.        ! No NetCDF 4 case
+#endif
+      !
+   END SUBROUTINE dom_nam
+
+   SUBROUTINE dom_zgr
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_zgr  ***
+      !!                   
+      !! ** Purpose :  set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d)
+      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
+      !!              - vertical coordinate (gdep., e3.) depending on the 
+      !!                coordinate chosen :
+      !!                   ln_zco=T   z-coordinate  
+      !!                   ln_zps=T   z-coordinate with partial steps
+      !!                   ln_zco=T   s-coordinate 
+      !!
+      !! ** Action  :   define gdep., e3., mbathy and bathy
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio = 0   ! temporary integer
+      INTEGER ::   ios
+      !!
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
+      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
+      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzgr )
+
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_zgr : vertical coordinate'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
+         WRITE(numout,*) '             z-coordinate - full steps      ln_zco    = ', ln_zco
+         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps    = ', ln_zps
+         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
+         WRITE(numout,*) '             ice shelf cavity               ln_isfcav = ', ln_isfcav
+      ENDIF
+
+      ioptio = 0                       ! Check Vertical coordinate options
+      IF( ln_zco ) ioptio = ioptio + 1
+      IF( ln_zps ) ioptio = ioptio + 1
+      IF( ln_sco ) ioptio = ioptio + 1
+      IF( ln_isfcav ) ioptio = 33
+      IF ( ioptio /= 1  )   CALL ctl_stop( ' none or several vertical coordinate options used' )
+      IF ( ioptio == 33 )   CALL ctl_stop( ' isf cavity with off line module not yet done    ' )
+
+   END SUBROUTINE dom_zgr
+
+   SUBROUTINE dom_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_ctl  ***
+      !!
+      !! ** Purpose :   Domain control.
+      !!
+      !! ** Method  :   compute and print extrema of masked scale factors
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)    Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
+      INTEGER, DIMENSION(2) ::   iloc      ! 
+      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
+      !!----------------------------------------------------------------------
+
+      ! Extrema of the scale factors
+
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
+      IF(lwp)WRITE(numout,*) '~~~~~~~'
+
+      IF (lk_mpp) THEN
+         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
+         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
+         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
+         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
+      ELSE
+         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+
+         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iimi1 = iloc(1) + nimpp - 1
+         ijmi1 = iloc(2) + njmpp - 1
+         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iimi2 = iloc(1) + nimpp - 1
+         ijmi2 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iima1 = iloc(1) + nimpp - 1
+         ijma1 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iima2 = iloc(1) + nimpp - 1
+         ijma2 = iloc(2) + njmpp - 1
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
+         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
+         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
+         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
+      ENDIF
+
+   END SUBROUTINE dom_ctl
+
+   SUBROUTINE dom_grd
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_grd  ***
       !!                   
       !! ** Purpose :  Read the NetCDF file(s) which contain(s) all the
@@ -344,5 +741,5 @@
       CALL wrk_dealloc( jpi, jpj, zmbk, zprt, zprw )
       !
-   END SUBROUTINE dom_rea
+   END SUBROUTINE dom_grd
 
 
@@ -388,4 +785,101 @@
    END SUBROUTINE zgr_bot_level
 
+   SUBROUTINE dom_msk
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk  ***
+      !!
+      !! ** Purpose :   Off-line case: defines the interior domain T-mask.
+      !!
+      !! ** Method  :   The interior ocean/land mask is computed from tmask
+      !!              setting to zero the duplicated row and lines due to
+      !!              MPP exchange halos, est-west cyclic and north fold
+      !!              boundary conditions.
+      !!
+      !! ** Action :   tmask_i  : interiorland/ocean mask at t-point
+      !!               tpol     : ???
+      !!----------------------------------------------------------------------
+      !
+      INTEGER  ::   ji, jj, jk                   ! dummy loop indices
+      INTEGER  ::   iif, iil, ijf, ijl       ! local integers
+      INTEGER, POINTER, DIMENSION(:,:) ::  imsk 
+      !
+      !!---------------------------------------------------------------------
+      
+      CALL wrk_alloc( jpi, jpj, imsk )
+      !
+      ! Interior domain mask (used for global sum)
+      ! --------------------
+      ssmask(:,:)  = tmask(:,:,1)
+      tmask_i(:,:) = tmask(:,:,1)
+      iif = jpreci                        ! thickness of exchange halos in i-axis
+      iil = nlci - jpreci + 1
+      ijf = jprecj                        ! thickness of exchange halos in j-axis
+      ijl = nlcj - jprecj + 1
+      !
+      tmask_i( 1 :iif,   :   ) = 0._wp    ! first columns
+      tmask_i(iil:jpi,   :   ) = 0._wp    ! last  columns (including mpp extra columns)
+      tmask_i(   :   , 1 :ijf) = 0._wp    ! first rows
+      tmask_i(   :   ,ijl:jpj) = 0._wp    ! last  rows (including mpp extra rows)
+      !
+      !                                   ! north fold mask
+      tpol(1:jpiglo) = 1._wp
+      !                                
+      IF( jperio == 3 .OR. jperio == 4 )   tpol(jpiglo/2+1:jpiglo) = 0._wp    ! T-point pivot
+      IF( jperio == 5 .OR. jperio == 6 )   tpol(     1    :jpiglo) = 0._wp    ! F-point pivot
+      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row
+         IF( mjg(ijl-1) == jpjglo-1 ) THEN
+            DO ji = iif+1, iil-1
+               tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji))
+            END DO
+         ENDIF
+      ENDIF 
+      !
+      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at
+      ! least 1 wet u point
+      DO jj = 1, jpjm1
+         DO ji = 1, fs_jpim1   ! vector loop
+            umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:)))
+            vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:)))
+         END DO
+         DO ji = 1, jpim1      ! NO vector opt.
+            fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   &
+               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:)))
+         END DO
+      END DO
+      CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions
+      CALL lbc_lnk( vmask_i, 'V', 1._wp )
+      CALL lbc_lnk( fmask_i, 'F', 1._wp )
+
+      ! 3. Ocean/land mask at wu-, wv- and w points 
+      !----------------------------------------------
+      wmask (:,:,1) = tmask(:,:,1) ! ????????
+      wumask(:,:,1) = umask(:,:,1) ! ????????
+      wvmask(:,:,1) = vmask(:,:,1) ! ????????
+      DO jk=2,jpk
+         wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1)
+         wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1)   
+         wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1)
+      END DO
+      !
+      IF( nprint == 1 .AND. lwp ) THEN    ! Control print
+         imsk(:,:) = INT( tmask_i(:,:) )
+         WRITE(numout,*) ' tmask_i : '
+         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
+         WRITE (numout,*)
+         WRITE (numout,*) ' dommsk: tmask for each level'
+         WRITE (numout,*) ' ----------------------------'
+         DO jk = 1, jpk
+            imsk(:,:) = INT( tmask(:,:,jk) )
+            WRITE(numout,*)
+            WRITE(numout,*) ' level = ',jk
+            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
+         END DO
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, imsk )
+      !
+   END SUBROUTINE dom_msk
+
    !!======================================================================
 END MODULE domrea
+
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 5682)
@@ -245,5 +245,10 @@
       tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:)  * tmask(:,:,:)    ! salinity
       !
-      CALL eos    ( tsn, rhd, rhop, gdept_0(:,:,:) )                                       ! In any case, we need rhop
+      !
+      CALL eos    ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
+      CALL eos_rab( tsn, rab_n )       ! now    local thermal/haline expension ratio at T-points
+      CALL bn2    ( tsn, rab_n, rn2 ) ! before Brunt-Vaisala frequency need for zdfmxl
+
+      rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl
       CALL zdf_mxl( kt )                                                   ! In any case, we need mxl 
       !
@@ -259,5 +264,5 @@
       fr_i(:,:)        = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1)    ! Sea-ice fraction
       qsr (:,:)        = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1)    ! solar radiation
-      IF ( ln_dynrnf ) &
+      IF( ln_dynrnf ) &
       rnf (:,:)        = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1)    ! river runoffs 
 
@@ -383,5 +388,5 @@
 
       !
-      IF ( ln_dynrnf ) THEN
+      IF( ln_dynrnf ) THEN
                 jf_rnf = jfld + 1  ;  jfld  = jf_rnf
          slf_d(jf_rnf) = sn_rnf
@@ -535,14 +540,18 @@
       !!---------------------------------------------------------------------
 #if defined key_ldfslp && ! defined key_c1d
+      CALL eos    ( pts, rhd, rhop, gdept_0(:,:,:) )
       CALL eos_rab( pts, rab_n )       ! now local thermal/haline expension ratio at T-points
       CALL bn2    ( pts, rab_n, rn2  ) ! now    Brunt-Vaisala
-      IF( ln_zps )   & ! Partial steps: before Horizontal DErivative
-        &    CALL zps_hde( kt, jpts, pts, gtsu, gtsv,  &        ! Partial steps: before horizontal gradient
-        &                                        rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &             !
-        &                                 gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    )  ! of t, s, rd at the last ocean level
-        ! only gtsu, gtsv, rhd, gru , grv are used 
-
-
-         !                                                            ! of t, s, rd at the bottom ocean level
+
+      ! Partial steps: before Horizontal DErivative
+      IF( ln_zps  .AND. .NOT. ln_isfcav)                            &
+         &            CALL zps_hde    ( kt, jpts, pts, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient
+         &                                        rhd, gru , grv    )  ! of t, s, rd at the last ocean level
+      IF( ln_zps .AND.        ln_isfcav)                            &
+         &            CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
+         &                                        rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
+         &                                 gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the first ocean level
+
+      rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl
       CALL zdf_mxl( kt )            ! mixed layer depth
       CALL ldf_slp( kt, rhd, rn2 )  ! slopes
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/istate.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/istate.F90	(revision 5659)
+++ 	(revision )
@@ -1,51 +1,0 @@
-MODULE istate
-   !!======================================================================
-   !!                     ***  MODULE  istate  ***
-   !! Ocean state   :  initial state setting, off-line case
-   !!=====================================================================
-   !! History :  3.3  ! 2010-10  (C. Ethe)  original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   istate_init   : initial state set to zero
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers 
-   USE dom_oce         ! ocean space and time domain 
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   istate_init   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!---------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE istate_init
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE istate_init  ***
-      !! 
-      !! ** Purpose :   Initialization to zero of the dynamics and tracers.
-      !!----------------------------------------------------------------------
-      !
-      !     now fields         !     after fields      !
-      un   (:,:,:)   = 0._wp   ;   ua(:,:,:) = 0._wp   !
-      vn   (:,:,:)   = 0._wp   ;   va(:,:,:) = 0._wp   !
-      wn   (:,:,:)   = 0._wp   !                       !
-      hdivn(:,:,:)   = 0._wp   !                       !
-      tsn  (:,:,:,:) = 0._wp   !                       !
-      !
-      rhd  (:,:,:) = 0.e0
-      rhop (:,:,:) = 0.e0
-      rn2  (:,:,:) = 0.e0 
-      !
-   END SUBROUTINE istate_init
-
-   !!=====================================================================
-END MODULE istate
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90	(revision 5682)
@@ -18,6 +18,6 @@
    USE c1d             ! 1D configuration
    USE domcfg          ! domain configuration               (dom_cfg routine)
-   USE domain          ! domain initialization             (dom_init routine)
-   USE istate          ! initial state setting          (istate_init routine)
+   USE domain          ! domain initialization from coordinate & bathymetry (dom_init routine)
+   USE domrea          ! domain initialization from mesh_mask            (dom_init routine)
    USE eosbn2          ! equation of state            (eos bn2 routine)
    !              ! ocean physics
@@ -34,5 +34,4 @@
    USE trcstp          ! passive tracer time-stepping      (trc_stp routine)
    USE dtadyn          ! Lecture and interpolation of the dynamical fields
-   USE stpctl          ! time stepping control            (stp_ctl routine)
    !              ! I/O & MPP
    USE iom             ! I/O library
@@ -62,5 +61,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OFF 3.3 , NEMO Consortium (2010)
-   !! $Id: nemogcm.F90 2528 2010-12-27 17:33:53Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -95,5 +94,5 @@
       istp = nit000
       ! 
-      CALL iom_init( "nemo" )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
+      CALL iom_init( cxios_context )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
       ! 
       DO WHILE ( istp <= nitend .AND. nstop == 0 )    ! time stepping
@@ -108,5 +107,5 @@
       END DO
 #if defined key_iomput
-      CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF
+      CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
 #endif
 
@@ -143,4 +142,5 @@
       INTEGER ::   ilocal_comm   ! local integer
       INTEGER ::   ios
+      LOGICAL ::   llexist
       CHARACTER(len=80), DIMENSION(16) ::   cltxt
       !!
@@ -149,7 +149,8 @@
          &             nn_bench, nn_timing
       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
-         &             jpizoom, jpjzoom, jperio
+         &             jpizoom, jpjzoom, jperio, ln_use_jattr
       !!----------------------------------------------------------------------
       cltxt = ''
+      cxios_context = 'nemo'
       !
       !                             ! Open reference namelist and configuration namelist files
@@ -181,9 +182,9 @@
       !                             !--------------------------------------------!
 #if defined key_iomput
-      CALL  xios_initialize( "nemo",return_comm=ilocal_comm )
-      narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection
+      CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection
 #else
       ilocal_comm = 0
-      narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
 #endif
 
@@ -233,5 +234,5 @@
          WRITE(numout,*) '                       NEMO team'
          WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.5  (2012) '
+         WRITE(numout,*) '                  version 3.6  (2015) '
          WRITE(numout,*)
          WRITE(numout,*)
@@ -268,5 +269,10 @@
       IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration
                             CALL     dom_cfg    ! Domain configuration
-                            CALL     dom_init   ! Domain
+      !
+      INQUIRE( FILE='coordinates.nc', EXIST = llexist )   ! Check if coordinate file exist
+      !
+      IF( llexist )  THEN  ;  CALL  dom_init   !  compute the grid from coordinates and bathymetry
+      ELSE                 ;  CALL  dom_rea    !  read grid from the meskmask
+      ENDIF
                             CALL  istate_init   ! ocean initial state (Dynamics and tracers)
 
@@ -275,6 +281,6 @@
       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
 
-      !                                     ! Ocean physics
                             CALL     sbc_init   ! Forcings : surface module
+
 #if ! defined key_degrad
                             CALL ldf_tra_init   ! Lateral ocean tracer physics
@@ -282,27 +288,15 @@
       IF( lk_ldfslp )       CALL ldf_slp_init   ! slope of lateral mixing
 
-      !                                     ! Active tracers
                             CALL tra_qsr_init   ! penetrative solar radiation qsr
       IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme
 
-                            CALL trc_nam_run  ! Needed to get restart parameters for passive tracers
-      IF( ln_rsttr ) THEN
-        neuler = 1   ! Set time-step indicator at nit000 (leap-frog)
-        CALL trc_rst_cal( nit000, 'READ' )   ! calendar
-      ELSE
-        neuler = 0                  ! Set time-step indicator at nit000 (euler)
-        CALL day_init               ! set calendar
-      ENDIF
-      !                                     ! Dynamics
+                            CALL trc_nam_run    ! Needed to get restart parameters for passive tracers
+                            CALL trc_rst_cal( nit000, 'READ' )   ! calendar
                             CALL dta_dyn_init   ! Initialization for the dynamics
 
-      !                                     ! Passive tracers
                             CALL     trc_init   ! Passive tracers initialization
-      !
-      ! Initialise diaptr as some variables are used in if statements later (in
-      ! various advection and diffusion routines.
-                            CALL dia_ptr_init
-      !
-      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
+                            CALL dia_ptr_init   ! Initialise diaptr as some variables are used 
+      !                                         ! in various advection and diffusion routines
+      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
       !
       IF( nn_timing == 1 )  CALL timing_stop( 'nemo_init')
@@ -359,4 +353,5 @@
          WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
          WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio   
+         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
       ENDIF
       !                             ! Parameter control
@@ -658,4 +653,51 @@
    END SUBROUTINE nemo_northcomms
 #endif
+
+   SUBROUTINE istate_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_init  ***
+      !!
+      !! ** Purpose :   Initialization to zero of the dynamics and tracers.
+      !!----------------------------------------------------------------------
+      !
+      !     now fields         !     after fields      !
+      un   (:,:,:)   = 0._wp   ;   ua(:,:,:) = 0._wp   !
+      vn   (:,:,:)   = 0._wp   ;   va(:,:,:) = 0._wp   !
+      wn   (:,:,:)   = 0._wp   !                       !
+      hdivn(:,:,:)   = 0._wp   !                       !
+      tsn  (:,:,:,:) = 0._wp   !                       !
+      !
+      rhd  (:,:,:) = 0.e0
+      rhop (:,:,:) = 0.e0
+      rn2  (:,:,:) = 0.e0
+      !
+   END SUBROUTINE istate_init
+
+   SUBROUTINE stp_ctl( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE stp_ctl  ***
+      !!
+      !! ** Purpose :   Control the run
+      !!
+      !! ** Method  : - Save the time step in numstp
+      !!
+      !! ** Actions :   'time.step' file containing the last ocean time-step
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'stp_ctl : time-stepping control'
+         WRITE(numout,*) '~~~~~~~'
+         ! open time.step file
+         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+      ENDIF
+      !
+      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
+      IF(lwp) REWIND( numstp )                       ! --------------------------
+      !
+   END SUBROUTINE stp_ctl
    !!======================================================================
 END MODULE nemogcm
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/stpctl.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OFF_SRC/stpctl.F90	(revision 5659)
+++ 	(revision )
@@ -1,62 +1,0 @@
-MODULE stpctl
-   !!======================================================================
-   !!                       ***  MODULE  stpctl  ***
-   !! Ocean run control :  Off-line case, only save the time step in numstp
-   !!======================================================================
-   !! History :  OPA  ! 1991-03  (G. Madec) Original code
-   !!            6.0  ! 1992-06  (M. Imbard)
-   !!            8.0  ! 1997-06  (A.M. Treguier)
-   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
-   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   stp_ctl      : Control the run
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE in_out_manager  ! I/O manager
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp         ! distributed memory computing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   stp_ctl    ! routine called by opa.F90
-   
-   !!----------------------------------------------------------------------
-   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE stp_ctl( kt, kindic )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE stp_ctl  ***
-      !!                     
-      !! ** Purpose :   Control the run
-      !!
-      !! ** Method  : - Save the time step in numstp
-      !!
-      !! ** Actions :   'time.step' file containing the last ocean time-step
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index
-      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'stp_ctl : time-stepping control'
-         WRITE(numout,*) '~~~~~~~'
-         ! open time.step file
-         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-      ENDIF
-      !
-      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
-      IF(lwp) REWIND( numstp )                       !  --------------------------
-      !
-   END SUBROUTINE stp_ctl
-
-   !!======================================================================
-END MODULE stpctl
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90	(revision 5682)
@@ -129,8 +129,9 @@
          &             nn_bench, nn_timing
       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
-         &             jpizoom, jpjzoom, jperio
+         &             jpizoom, jpjzoom, jperio, ln_use_jattr
       !!----------------------------------------------------------------------
       !
       cltxt = ''
+      cxios_context = 'nemo'
       !
       !                             ! Open reference namelist and configuration namelist files
@@ -162,22 +163,22 @@
 #if defined key_iomput
       IF( Agrif_Root() ) THEN
-         IF( lk_cpl ) THEN
+         IF( lk_oasis ) THEN
             CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis
             CALL xios_initialize( "oceanx",local_comm=ilocal_comm )    ! send nemo communicator to xios
          ELSE
-            CALL  xios_initialize( "nemo",return_comm=ilocal_comm )    ! nemo local communicator given by xios
+            CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios
          ENDIF
       ENDIF
       ENDIF
-      narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection
 #else
-      IF( lk_cpl ) THEN
+      IF( lk_oasis ) THEN
          IF( Agrif_Root() ) THEN
             CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis
          ENDIF
-         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt)
+         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt)
       ELSE
          ilocal_comm = 0
-         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
+         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
       ENDIF
 #endif
@@ -233,5 +234,5 @@
          WRITE(numout,*) '                       NEMO team'
          WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.4  (2011) '
+         WRITE(numout,*) '                  version 3.6  (2015) '
          WRITE(numout,*)
          WRITE(numout,*)
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_data.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_data.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_data.F90	(revision 5682)
@@ -40,4 +40,5 @@
    CHARACTER(len=128) :: &
       & alt_file                       !: altimeter file
+   !! $Id$
 CONTAINS
    SUBROUTINE ooo_data_init( ld_cl4 )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_intp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_intp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_intp.F90	(revision 5682)
@@ -16,4 +16,5 @@
    PUBLIC ooo_interp
 
+   !! $Id$
    CONTAINS
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_read.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_read.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_read.F90	(revision 5682)
@@ -22,4 +22,5 @@
    PUBLIC ooo_rea_dri
 
+   !! $Id$
 CONTAINS
    SUBROUTINE ooo_rea_dri(kfile)
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_utils.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_utils.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_utils.F90	(revision 5682)
@@ -10,4 +10,5 @@
    REAL(kind=dp), PARAMETER :: obfilldbl=99999.
 
+   !! $Id$
    CONTAINS
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_write.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_write.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OOO_SRC/ooo_write.F90	(revision 5682)
@@ -29,4 +29,5 @@
    END INTERFACE
 
+   !! $Id$
    CONTAINS
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 5682)
@@ -57,5 +57,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 5682)
@@ -658,5 +658,5 @@
 
       DO jk = 1, jpkm1
-         fzptnz(:,:,jk) = eos_fzp( tsn(:,:,jk,jp_sal), fsdept(:,:,jk) )
+        CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), fsdept(:,:,jk) )
       END DO
 
@@ -746,8 +746,11 @@
 
 
-            IF( ln_zps .AND. .NOT. lk_c1d ) &
-               &  CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv,  &        ! Partial steps: before horizontal gradient
-               &                rhd, gru , grv, aru, arv, gzu, gzv, ge3ru, ge3rv,  &             !
-               &                gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi  )  ! of t, s, rd at the last ocean level
+            IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)      &
+               &  CALL zps_hde    ( kt, jpts, tsb, gtsu, gtsv,        &  ! Partial steps: before horizontal gradient
+               &                              rhd, gru , grv          )  ! of t, s, rd at the last ocean level
+            IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)      &
+               &  CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv,    &    ! Partial steps for top cell (ISF)
+               &                                  rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
+               &                           gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
 
 #if defined key_zdfkpp
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 5682)
@@ -33,7 +33,6 @@
    USE ice_2
 #elif defined key_lim3
-   USE par_ice
    USE ice
-   USE limcat_1D          ! redistribute ice input into categories
+   USE limvar          ! redistribute ice input into categories
 #endif
    USE sbcapr
@@ -380,5 +379,5 @@
 #if defined key_lim3
                IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is lim2 type)
-     	          CALL lim_cat_1D ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &
+     	          CALL lim_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &
                                   & dta_bdy(ib_bdy)%ht_i,     dta_bdy(ib_bdy)%ht_s,     dta_bdy(ib_bdy)%a_i     )
                ENDIF
@@ -734,4 +733,5 @@
          IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) )
          nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld))
+         nbmap_ptr(jfld)%ll_unstruc = ln_coords_file(ibdy(jfld))
       ENDDO
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 5682)
@@ -36,5 +36,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: bdydyn.F90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90	(revision 5682)
@@ -33,5 +33,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: bdydyn.F90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90	(revision 5682)
@@ -26,7 +26,7 @@
    USE dom_ice_2       ! sea-ice domain
 #elif defined key_lim3
-   USE par_ice
    USE ice             ! LIM_3 ice variables
    USE dom_ice         ! sea-ice domain
+   USE limvar
 #endif 
    USE par_oce         ! ocean parameters
@@ -42,10 +42,10 @@
    PRIVATE
 
-   PUBLIC   bdy_ice_lim    ! routine called in sbcmod
+   PUBLIC   bdy_ice_lim     ! routine called in sbcmod
    PUBLIC   bdy_ice_lim_dyn ! routine called in limrhg
 
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: bdyice.F90 2715 2011-03-30 15:58:35Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -60,6 +60,10 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) :: kt     ! Main time step counter
-      !!
       INTEGER               :: ib_bdy ! Loop index
+
+#if defined key_lim3
+      CALL lim_var_glo2eqv
+#endif
+
       DO ib_bdy=1, nb_bdy
 
@@ -72,5 +76,11 @@
             CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' )
          END SELECT
-      ENDDO
+
+      END DO
+
+#if defined key_lim3
+      CALL lim_var_zapsmall
+      CALL lim_var_agg(1)
+#endif
 
    END SUBROUTINE bdy_ice_lim
@@ -89,5 +99,5 @@
       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
       INTEGER,         INTENT(in) ::   kt   ! main time-step counter
-      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index      !!
+      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
 
       INTEGER  ::   jpbound            ! 0 = incoming ice
@@ -97,4 +107,8 @@
       REAL(wp) ::   zwgt, zwgt1        ! local scalar
       REAL(wp) ::   ztmelts, zdh
+#if  defined key_lim2 && ! defined key_lim2_vp && defined key_agrif
+     USE ice_2, vt_s => hsnm
+     USE ice_2, vt_i => hicm
+#endif
 
       !!------------------------------------------------------------------------------
@@ -169,10 +183,14 @@
             jpbound = 0; ii = ji; ij = jj;
 
-            IF ( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj
-            IF ( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj
-            IF ( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1
-            IF ( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1
-
-            rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ii,ij) + 0.01 ) ) ! 0 if no ice
+            IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj
+            IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj
+            IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1
+            IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1
+
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj   ! case ice boundaries = initial conditions
+                                                                              !      do not make state variables dependent on velocity
+               
+
+            rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice
 
             ! concentration and thickness
@@ -190,13 +208,13 @@
 
                ! Ice salinity, age, temperature
-               sm_i(ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * s_i_min
-               o_i(ji,jj,jl)    = rswitch * rn_ice_age(ib_bdy)  + ( 1.0 - rswitch )
+               sm_i(ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * rn_simin
+               oa_i(ji,jj,jl)   = rswitch * rn_ice_age(ib_bdy) * a_i(ji,jj,jl)
                t_su(ji,jj,jl)   = rswitch * rn_ice_tem(ib_bdy)  + ( 1.0 - rswitch ) * rn_ice_tem(ib_bdy)
                DO jk = 1, nlay_s
-                  t_s(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rtt
+                  t_s(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0
                END DO
                DO jk = 1, nlay_i
-                  t_i(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rtt 
-                  s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * s_i_min
+                  t_i(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0 
+                  s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin
                END DO
                
@@ -204,13 +222,13 @@
  
                ! Ice salinity, age, temperature
-               sm_i(ji,jj,jl)   = rswitch * sm_i(ii,ij,jl)  + ( 1.0 - rswitch ) * s_i_min
-               o_i(ji,jj,jl)    = rswitch * o_i(ii,ij,jl)   + ( 1.0 - rswitch )
-               t_su(ji,jj,jl)   = rswitch * t_su(ii,ij,jl)  + ( 1.0 - rswitch ) * rtt
+               sm_i(ji,jj,jl)   = rswitch * sm_i(ii,ij,jl)  + ( 1.0 - rswitch ) * rn_simin
+               oa_i(ji,jj,jl)   = rswitch * oa_i(ii,ij,jl)
+               t_su(ji,jj,jl)   = rswitch * t_su(ii,ij,jl)  + ( 1.0 - rswitch ) * rt0
                DO jk = 1, nlay_s
-                  t_s(ji,jj,jk,jl) = rswitch * t_s(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rtt
+                  t_s(ji,jj,jk,jl) = rswitch * t_s(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0
                END DO
                DO jk = 1, nlay_i
-                  t_i(ji,jj,jk,jl) = rswitch * t_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rtt
-                  s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * s_i_min
+                  t_i(ji,jj,jk,jl) = rswitch * t_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0
+                  s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin
                END DO
 
@@ -218,37 +236,31 @@
 
             ! if salinity is constant, then overwrite rn_ice_sal
-            IF( num_sal == 1 ) THEN
-               sm_i(ji,jj,jl)   = bulk_sal
-               s_i (ji,jj,:,jl) = bulk_sal
+            IF( nn_icesal == 1 ) THEN
+               sm_i(ji,jj,jl)   = rn_icesal
+               s_i (ji,jj,:,jl) = rn_icesal
             ENDIF
 
             ! contents
             smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl)
-            oa_i(ji,jj,jl)   = o_i(ji,jj,jl) * a_i(ji,jj,jl)
             DO jk = 1, nlay_s
                ! Snow energy of melting
-               e_s(ji,jj,jk,jl) = rswitch * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus )
-               ! Change dimensions
-               e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac
-               ! Multiply by volume, so that heat content in 10^9 Joules
-               e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s
+               e_s(ji,jj,jk,jl) = rswitch * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
+               ! Multiply by volume, so that heat content in J/m2
+               e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
             END DO
             DO jk = 1, nlay_i
-               ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K                  
+               ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K                  
                ! heat content per unit volume
                e_i(ji,jj,jk,jl) = rswitch * rhoic * &
                   (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
-                  +   lfus    * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) &
-                  - rcp      * ( ztmelts - rtt ) )
-               ! Correct dimensions to avoid big values
-               e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac 
-               ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J
-               e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / nlay_i
+                  +   lfus    * ( 1.0 - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &
+                  - rcp      * ( ztmelts - rt0 ) )
+               ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
+               e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i
             END DO
 
-
-         END DO !jb
+         END DO
  
-         CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy )                                         ! lateral boundary conditions
+         CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy )
          CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy )
          CALL lbc_bdy_lnk( ht_s(:,:,jl), 'T', 1., ib_bdy )
@@ -259,5 +271,4 @@
          CALL lbc_bdy_lnk(  sm_i(:,:,jl), 'T', 1., ib_bdy )
          CALL lbc_bdy_lnk(  oa_i(:,:,jl), 'T', 1., ib_bdy )
-         CALL lbc_bdy_lnk(   o_i(:,:,jl), 'T', 1., ib_bdy )
          CALL lbc_bdy_lnk(  t_su(:,:,jl), 'T', 1., ib_bdy )
          DO jk = 1, nlay_s
@@ -291,7 +302,7 @@
       !!
       CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points
-      INTEGER  ::   jb, jgrd   ! dummy loop indices
+      INTEGER  ::   jb, jgrd           ! dummy loop indices
       INTEGER  ::   ji, jj             ! local scalar
-      INTEGER  ::   ib_bdy ! Loop index
+      INTEGER  ::   ib_bdy             ! Loop index
       REAL(wp) ::   zmsk1, zmsk2, zflag
      !!------------------------------------------------------------------------------
@@ -309,7 +320,9 @@
          CASE('frs')
             
-
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions 
+                                                               !      do not change ice velocity (it is only computed by rheology)
+ 
             SELECT CASE ( cd_type )
-
+               
             CASE ( 'U' )
                
@@ -326,6 +339,6 @@
                      
                      ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
-                     u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5 * ABS( zflag + 1._wp ) * zmsk1 + &
-                        &            u_ice(ji-1,jj) * 0.5 * ABS( zflag - 1._wp ) * zmsk2 + &
+                     u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
+                        &            u_ice(ji-1,jj) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + &
                         &            u_oce(ji  ,jj) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) )
                   ELSE                             ! everywhere else
@@ -334,9 +347,9 @@
                   ENDIF
                   ! mask ice velocities
-                  rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ji,jj) + 0.01 ) ) ! 0 if no ice
+                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice
                   u_ice(ji,jj) = rswitch * u_ice(ji,jj)
                   
                ENDDO
-
+               
                CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy )
                
@@ -355,6 +368,6 @@
                      
                      ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
-                     v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5 * ABS( zflag + 1._wp ) * zmsk1 + &
-                        &            v_ice(ji,jj-1) * 0.5 * ABS( zflag - 1._wp ) * zmsk2 + &
+                     v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
+                        &            v_ice(ji,jj-1) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + &
                         &            v_oce(ji,jj  ) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) )
                   ELSE                             ! everywhere else
@@ -363,5 +376,5 @@
                   ENDIF
                   ! mask ice velocities
-                  rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ji,jj) + 0.01 ) ) ! 0 if no ice
+                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice
                   v_ice(ji,jj) = rswitch * v_ice(ji,jj)
                   
@@ -369,5 +382,5 @@
                
                CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy )
-               
+                  
             END SELECT
             
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 5682)
@@ -76,5 +76,5 @@
       INTEGER  ::   ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices
       INTEGER  ::   icount, icountr, ibr_max, ilen1, ibm1  ! local integers
-      INTEGER  ::   iw, ie, is, in, inum, id_dummy         !   -       -
+      INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy         !   -       -
       INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       -
       INTEGER  ::   jpbdtau, jpbdtas                       !   -       -
@@ -777,8 +777,8 @@
 !      is = mjg(1) + 1            ! if monotasking and no zoom, is=2
 !      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1      
-      iw = mig(1) - jpizoom + 2         ! if monotasking and no zoom, iw=2
-      ie = mig(1) + nlci - jpizoom - 1  ! if monotasking and no zoom, ie=jpim1
-      is = mjg(1) - jpjzoom + 2         ! if monotasking and no zoom, is=2
-      in = mjg(1) + nlcj - jpjzoom - 1  ! if monotasking and no zoom, in=jpjm1
+      iwe = mig(1) - jpizoom + 2         ! if monotasking and no zoom, iw=2
+      ies = mig(1) + nlci - jpizoom - 1  ! if monotasking and no zoom, ie=jpim1
+      iso = mjg(1) - jpjzoom + 2         ! if monotasking and no zoom, is=2
+      ino = mjg(1) + nlcj - jpjzoom - 1  ! if monotasking and no zoom, in=jpjm1
 
       ALLOCATE( nbondi_bdy(nb_bdy))
@@ -853,6 +853,6 @@
                ENDIF
                ! check if point is in local domain
-               IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   &
-                  & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in       ) THEN
+               IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   &
+                  & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino      ) THEN
                   !
                   icount = icount  + 1
@@ -890,4 +890,5 @@
          com_south_b = 0
          com_north_b = 0
+
          DO igrd = 1, jpbgrd
             icount  = 0
@@ -896,6 +897,6 @@
                DO ib = 1, nblendta(igrd,ib_bdy)
                   ! check if point is in local domain and equals ir
-                  IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   &
-                     & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in .AND.   &
+                  IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   &
+                     & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino .AND.   &
                      & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
                      !
@@ -1594,5 +1595,5 @@
             ELSE
                ! This is a corner
-               WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)
+               IF(lwp) WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)
                CALL bdy_ctl_corn(npckgw(ib), icornw(ib,1))
                itest=itest+1
@@ -1608,5 +1609,5 @@
             ELSE
                ! This is a corner
-               WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)
+               IF(lwp) WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)
                CALL bdy_ctl_corn(npckgw(ib), icornw(ib,2))
                itest=itest+1
@@ -1638,5 +1639,5 @@
             ELSE
                ! This is a corner
-               WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)
+               IF(lwp) WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)
                CALL bdy_ctl_corn(npckge(ib), icorne(ib,1))
                itest=itest+1
@@ -1652,5 +1653,5 @@
             ELSE
                ! This is a corner
-               WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)
+               IF(lwp) WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)
                CALL bdy_ctl_corn(npckge(ib), icorne(ib,2))
                itest=itest+1
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90	(revision 5682)
@@ -29,5 +29,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: bdydyn.F90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 5682)
@@ -32,5 +32,5 @@
    USE tideini
 !   USE tide_mod       ! Useless ??
-   USE fldread, ONLY: fld_map
+   USE fldread
    USE dynspg_oce, ONLY: lk_dynspg_ts
 
@@ -88,4 +88,5 @@
       !!
       TYPE(TIDES_DATA),  POINTER                ::   td                  !: local short cut   
+      TYPE(MAP_POINTER), DIMENSION(jpbgrd)      ::   ibmap_ptr           !: array of pointers to nbmap
       !!
       NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj
@@ -125,7 +126,7 @@
             IF(lwp) WRITE(numout,*) '             Number of tidal components to read: ', nb_harmo
             IF(lwp) THEN 
-                    WRITE(numout,*) '             Tidal cpt name    -     Phase speed (deg/hr)'            
+                    WRITE(numout,*) '             Tidal components: ' 
                DO itide = 1, nb_harmo
-                  WRITE(numout,*)  '             ', Wave(ntide(itide))%cname_tide, omega_tide(itide)   
+                  WRITE(numout,*)  '                 ', Wave(ntide(itide))%cname_tide 
                END DO
             ENDIF 
@@ -220,4 +221,12 @@
                ! 
                ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) )
+               !
+               ! Set map structure
+               ibmap_ptr(1)%ptr => idx_bdy(ib_bdy)%nbmap(:,1)
+               ibmap_ptr(1)%ll_unstruc = ln_coords_file(ib_bdy)
+               ibmap_ptr(2)%ptr => idx_bdy(ib_bdy)%nbmap(:,2)
+               ibmap_ptr(2)%ll_unstruc = ln_coords_file(ib_bdy)
+               ibmap_ptr(3)%ptr => idx_bdy(ib_bdy)%nbmap(:,3)
+               ibmap_ptr(3)%ll_unstruc = ln_coords_file(ib_bdy)
 
                ! Open files and read in tidal forcing data
@@ -228,7 +237,7 @@
                   clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc'
                   CALL iom_open( clfile, inum )
-                  CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
+                  CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1,  ibmap_ptr(1) )
                   td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1)
-                  CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
+                  CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1,  ibmap_ptr(1) )
                   td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1)
                   CALL iom_close( inum )
@@ -236,7 +245,7 @@
                   clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc'
                   CALL iom_open( clfile, inum )
-                  CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
+                  CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, ibmap_ptr(2) )
                   td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1)
-                  CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
+                  CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, ibmap_ptr(2) )
                   td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1)
                   CALL iom_close( inum )
@@ -244,7 +253,7 @@
                   clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc'
                   CALL iom_open( clfile, inum )
-                  CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
+                  CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, ibmap_ptr(3) )
                   td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1)
-                  CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
+                  CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, ibmap_ptr(3) )
                   td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1)
                   CALL iom_close( inum )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 5682)
@@ -91,5 +91,5 @@
       ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain
       ! -----------------------------------------------------------------------
-      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+rdivisf*fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0
+      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0
       IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90	(revision 5682)
@@ -31,5 +31,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/C1D 3.3 , NEMO Consortium (2010)
-   !! $Id: c1d.F90 2382 2010-11-13 13:08:12Z gm $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90	(revision 5682)
@@ -26,5 +26,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: domc1d.F90 3851 2013-04-30 10:30:51Z hadcv $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90	(revision 5682)
@@ -35,5 +35,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: dtauvd.F90 2392 2010-11-15 21:20:05Z gm $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90	(revision 5682)
@@ -30,5 +30,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/C1D 3.3 , NEMO Consortium (2010)
-   !! $Id: dyncor_c1d.F90 2382 2010-11-13 13:08:12Z gm $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90	(revision 5682)
@@ -3,6 +3,9 @@
    !!                       ***  MODULE  dyndmp  ***
    !! Ocean dynamics: internal restoring trend on momentum (U and V current)
+   !!                 This should only be used for C1D case in current form
    !!======================================================================
    !! History :  3.5  ! 2013-08  (D. Calvert)  Original code
+   !!            3.6  ! 2014-08  (T. Graham) Modified to use netcdf file of
+   !!                             restoration coefficients supplied to tradmp
    !!----------------------------------------------------------------------
 
@@ -25,4 +28,5 @@
    USE wrk_nemo       ! Memory allocation
    USE timing         ! Timing
+   USE iom            ! I/O manager
 
    IMPLICIT NONE
@@ -43,5 +47,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: dyndmp.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -73,4 +77,5 @@
       NAMELIST/namc1d_dyndmp/ ln_dyndmp
       INTEGER :: ios
+      INTEGER :: imask
       !!----------------------------------------------------------------------
 
@@ -91,10 +96,7 @@
          WRITE(numout,*) '      add a damping term or not       ln_dyndmp = ', ln_dyndmp
          WRITE(numout,*) '   Namelist namtra_dmp    : Set damping parameters'
-         WRITE(numout,*) '      horizontal damping option       nn_hdmp   = ', nn_hdmp
-         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp, '(non-C1D zoom: forced to 0)'
-         WRITE(numout,*) '      surface time scale (days)       rn_surf   = ', rn_surf
-         WRITE(numout,*) '      bottom time scale (days)        rn_bot    = ', rn_bot
-         WRITE(numout,*) '      depth of transition (meters)    rn_dep    = ', rn_dep
-         WRITE(numout,*) '      create a damping.coeff file     nn_file   = ', nn_file
+         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp
+         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp
+         WRITE(numout,*) '      Damping file name               cn_resto  = ', cn_resto
          WRITE(numout,*)
       ENDIF
@@ -104,14 +106,4 @@
          IF( dyn_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dyn_dmp_init: unable to allocate arrays' )
          !
-#if ! defined key_c1d
-         SELECT CASE ( nn_hdmp )             !==   control print of horizontal option   ==!
-         CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   momentum damping in the Med & Red seas only'
-         CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   momentum damping poleward of', nn_hdmp, ' degrees'
-         CASE DEFAULT
-            WRITE(ctmp1,*) '          bad flag value for nn_hdmp = ', nn_hdmp
-            CALL ctl_stop(ctmp1)
-         END SELECT
-         !
-#endif
          SELECT CASE ( nn_zdmp )             !==   control print of vertical option   ==!
          CASE ( 0    )   ;   IF(lwp) WRITE(numout,*) '   momentum damping throughout the water column'
@@ -130,13 +122,9 @@
          utrdmp(:,:,:) = 0._wp               ! internal damping trends
          vtrdmp(:,:,:) = 0._wp
-         !                                   !==   Damping coefficients calculation:                           ==!
-         !                                   !==   use tradmp.F90 subroutines dtacof, dtacof_zoom and cofdis   ==!
-         !                                   !!!   NOTE: these need to be altered for use in this module if 
-         !                                   !!!       they are to be used outside the C1D context 
-         !                                   !!!       (use of U,V grid variables)
-         IF( lzoom .AND. .NOT. lk_c1d ) THEN   ;   CALL dtacof_zoom( resto_uv )
-         ELSE               ;   CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep, nn_file, 'DYN', resto_uv )
-         ENDIF
-         !
+         !
+         !Read in mask from file
+         CALL iom_open ( cn_resto, imask)
+         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto)
+         CALL iom_close( imask )
       ENDIF
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90	(revision 5682)
@@ -25,5 +25,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/C1D 3.3 , NEMO Consortium (2010)
-   !! $Id: dynnxt_c1d.F90 2382 2010-11-13 13:08:12Z gm $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 5682)
@@ -32,5 +32,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/C1D 3.3 , NEMO Consortium (2010)
-   !! $Id: step_c1d.F90 2382 2010-11-13 13:08:12Z gm $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -72,4 +72,6 @@
       ! Ocean physics update                (ua, va, ta, sa used as workspace)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL eos_rab( tsb, rab_b )   ! before local thermal/haline expension ratio at T-points
+                         CALL eos_rab( tsn, rab_n )   ! now    local thermal/haline expension ratio at T-points
                          CALL bn2( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency
                          CALL bn2( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency
@@ -132,4 +134,6 @@
                         CALL tra_nxt( kstp )       ! tracer fields at next time step
 
+
+
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Dynamics                                    (ta, sa used as workspace)
@@ -150,4 +154,8 @@
       IF( lrst_oce       )   CALL rst_write( kstp )        ! write output ocean restart file
       !
+#if defined key_iomput
+      IF( kstp == nitend .OR. indic < 0 )   CALL xios_context_finalize()   ! needed for XIOS
+      !
+#endif
    END SUBROUTINE stp_c1d
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 5682)
@@ -164,4 +164,5 @@
 
 
+   !! $Id$
 CONTAINS
    
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90	(revision 5682)
@@ -57,4 +57,5 @@
 #  include "domzgr_substitute.h90"
    
+   !! $Id$
 CONTAINS
 
@@ -1882,5 +1883,5 @@
       CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 )
 
-      CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk )
+      CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk, zsurf )
 
    END SUBROUTINE crs_dom_sfc
@@ -2274,6 +2275,4 @@
       ENDDO
      
-      CALL wrk_alloc( jpi_crs, jpj_crs, zmbk )
-
       zmbk(:,:) = 0.0
       zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0)   ;   mbathy_crs(:,:) = INT( zmbk(:,:) )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90	(revision 5682)
@@ -33,4 +33,5 @@
    PUBLIC crs_dom_wri        ! routine called by crsini.F90
 
+   !! $Id$
 CONTAINS
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 5682)
@@ -38,5 +38,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 5682)
@@ -29,4 +29,5 @@
 #  include "domzgr_substitute.h90"
 
+   !! $Id$
 CONTAINS
    
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 5682)
@@ -22,4 +22,5 @@
    PUBLIC crs_lbc_lnk
    
+   !! $Id$
 CONTAINS
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 5682)
@@ -21,4 +21,7 @@
    USE timing         ! preformance summary
    USE wrk_nemo       ! working arrays
+   USE fldread        ! type FLD_N
+   USE phycst         ! physical constant
+   USE in_out_manager  ! I/O manager
 
    IMPLICIT NONE
@@ -83,6 +86,4 @@
       CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 )
 
-      CALL iom_put( 'cellthc', fse3t(:,:,:) )
-
       zarea_ssh(:,:) = area(:,:) * sshn(:,:)
 
@@ -105,9 +106,13 @@
       END DO
       IF( .NOT.lk_vvl ) THEN
-         DO ji=1,jpi
-            DO jj=1,jpj
-               zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
-            END DO
-         END DO
+         IF ( ln_isfcav ) THEN
+            DO ji=1,jpi
+               DO jj=1,jpj
+                  zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
+               END DO
+            END DO
+         ELSE
+            zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+         END IF
       END IF
       !                                         
@@ -127,9 +132,13 @@
       END DO
       IF( .NOT.lk_vvl ) THEN
-         DO ji=1,jpi
-            DO jj=1,jpj
-               zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
-            END DO
-         END DO
+         IF ( ln_isfcav ) THEN
+            DO ji=1,jpi
+               DO jj=1,jpj
+                  zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
+               END DO
+            END DO
+         ELSE
+            zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+         END IF
       END IF
       !    
@@ -157,10 +166,15 @@
       END DO
       IF( .NOT.lk_vvl ) THEN
-         DO ji=1,jpi
-            DO jj=1,jpj
-               ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem) 
-               zsal  = zsal  + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal) 
-            END DO
-         END DO
+         IF ( ln_isfcav ) THEN
+            DO ji=1,jpi
+               DO jj=1,jpj
+                  ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem) 
+                  zsal  = zsal  + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal) 
+               END DO
+            END DO
+         ELSE
+            ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) )
+            zsal  = zsal  + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) )
+         END IF
       ENDIF
       IF( lk_mpp ) THEN  
@@ -197,4 +211,22 @@
       REAL(wp) ::   zztmp  
       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity
+      ! reading initial file
+      LOGICAL  ::   ln_tsd_init      !: T & S data flag
+      LOGICAL  ::   ln_tsd_tradmp    !: internal damping toward input data flag
+      CHARACTER(len=100)            ::   cn_dir
+      TYPE(FLD_N)                   ::  sn_tem,sn_sal
+      INTEGER  ::   ios=0
+
+      NAMELIST/namtsd/ ln_tsd_init,ln_tsd_tradmp,cn_dir,sn_tem,sn_sal
+      !
+
+      REWIND( numnam_ref )              ! Namelist namtsd in reference namelist :
+      READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in reference namelist for dia_ar5', lwp )
+      REWIND( numnam_cfg )              ! Namelist namtsd in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in configuration namelist for dia_ar5', lwp )
+      IF(lwm) WRITE ( numond, namtsd )
+      !
       !!----------------------------------------------------------------------
       !
@@ -216,8 +248,8 @@
       END DO
       IF( lk_mpp )   CALL mpp_sum( vol0 )
-      
-      CALL iom_open ( 'data_1m_salinity_nomask', inum )
-      CALL iom_get  ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,1), 1  )
-      CALL iom_get  ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,2), 12 )
+
+      CALL iom_open ( TRIM( cn_dir )//TRIM(sn_sal%clname), inum )
+      CALL iom_get  ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,1), 1  )
+      CALL iom_get  ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,2), 12 )
       CALL iom_close( inum )
       sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )        
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 5682)
@@ -42,5 +42,4 @@
 #endif
 #if defined key_lim3
-  USE par_ice
   USE ice
 #endif
@@ -113,4 +112,5 @@
   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  transports_2d  
 
+   !! $Id$
 CONTAINS
 
@@ -176,5 +176,5 @@
 
      !open output file
-     IF( lwp ) THEN
+     IF( lwm ) THEN
         CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
         CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
@@ -283,5 +283,5 @@
            DO jsec=1,nb_sec
 
-              IF( lwp )CALL dia_dct_wri(kt,jsec,secs(jsec))
+              IF( lwm )CALL dia_dct_wri(kt,jsec,secs(jsec))
             
               !nullify transports values after writing
@@ -1298,4 +1298,5 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .FALSE.    !: diamht flag
    PUBLIC 
+   !! $Id$
 CONTAINS
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 5682)
@@ -51,11 +51,12 @@
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
       !!
-      INTEGER :: inum             ! temporary logical unit
-      INTEGER :: ji, jj, jk, jt   ! dummy loop indices
-      INTEGER :: ii0, ii1, ij0, ij1
-      REAL(wp) ::   zarea, zvol, zwei
-      REAL(wp) ::  ztemi(4), ztemo(4), zsali(4), zsalo(4), zflxi(4), zflxo(4)
-      REAL(wp) ::  zt, zs, zu  
-      REAL(wp) ::  zsm0, zfwfnew
+      INTEGER  :: inum             ! temporary logical unit
+      INTEGER  :: ji, jj, jk, jt   ! dummy loop indices
+      INTEGER  :: ii0, ii1, ij0, ij1
+      INTEGER  :: isrow         ! index for ORCA1 starting row
+      REAL(wp) :: zarea, zvol, zwei
+      REAL(wp) :: ztemi(4), ztemo(4), zsali(4), zsalo(4), zflxi(4), zflxo(4)
+      REAL(wp) :: zt, zs, zu  
+      REAL(wp) :: zsm0, zfwfnew
       IF( cp_cfg == "orca" .AND. jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN
       !!----------------------------------------------------------------------
@@ -165,6 +166,12 @@
          CASE ( 1 )                                  !  ORCA_R1 configurations
             !                                        ! =======================
-            ii0 = 283   ;   ii1 = 283
-            ij0 = 200   ;   ij1 = 200
+            ! This dirty section will be suppressed by simplification process:
+            ! all this will come back in input files
+            ! Currently these hard-wired indices relate to configuration with
+            ! extend grid (jpjglo=332)
+            isrow = 332 - jpjglo
+            !
+            ii0 = 283           ;   ii1 = 283
+            ij0 = 241 - isrow   ;   ij1 = 241 - isrow
             !                                        ! =======================
          CASE DEFAULT                                !    ORCA R05 or R025
@@ -212,6 +219,11 @@
          CASE ( 1 )                                  !  ORCA_R1 configurations
             !                                        ! =======================
-            ii0 = 282   ;   ii1 = 282
-            ij0 = 200   ;   ij1 = 200
+            ! This dirty section will be suppressed by simplification process:
+            ! all this will come back in input files
+            ! Currently these hard-wired indices relate to configuration with
+            ! extend grid (jpjglo=332)
+            isrow = 332 - jpjglo
+            ii0 = 282           ;   ii1 = 282
+            ij0 = 240 - isrow   ;   ij1 = 240 - isrow
             !                                        ! =======================
          CASE DEFAULT                                !    ORCA R05 or R025
@@ -259,6 +271,11 @@
          CASE ( 1 )                                  !  ORCA_R1 configurations
             !                                        ! =======================
-            ii0 = 331   ;   ii1 = 331
-            ij0 = 176   ;   ij1 = 176
+            ! This dirty section will be suppressed by simplification process:
+            ! all this will come back in input files
+            ! Currently these hard-wired indices relate to configuration with
+            ! extend grid (jpjglo=332)
+            isrow = 332 - jpjglo
+            ii0 = 331           ;   ii1 = 331
+            ij0 = 215 - isrow   ;   ij1 = 215 - isrow
             !                                        ! =======================
          CASE DEFAULT                                !    ORCA R05 or R025
@@ -306,6 +323,11 @@
          CASE ( 1 )                                  !  ORCA_R1 configurations
             !                                        ! =======================
-            ii0 = 297   ;   ii1 = 297 
-            ij0 = 230   ;   ij1 = 230
+            ! This dirty section will be suppressed by simplification process:
+            ! all this will come back in input files
+            ! Currently these hard-wired indices relate to configuration with
+            ! extend grid (jpjglo=332)
+            isrow = 332 - jpjglo
+            ii0 = 297           ;   ii1 = 297
+            ij0 = 269 - isrow   ;   ij1 = 269 - isrow
             !                                        ! =======================
          CASE DEFAULT                                !    ORCA R05 or R025
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90	(revision 5682)
@@ -60,5 +60,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.5 , NEMO Consortium (2013)
-   !! $Id:$
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -196,9 +196,7 @@
                   DO ji = 1,jpi
                      ! Elevation
-                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)           *tmask_i(ji,jj)        
-#if defined key_dynspg_ts
-                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*hur(ji,jj)*umask_i(ji,jj)
-                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*hvr(ji,jj)*vmask_i(ji,jj)
-#endif
+                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*tmask_i(ji,jj)        
+                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*umask_i(ji,jj)
+                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*vmask_i(ji,jj)
                   END DO
                END DO
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 5682)
@@ -93,15 +93,14 @@
       ! 1 - Trends due to forcing !
       ! ------------------------- !
-      z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes
+      z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes
       z_frc_trd_t =           glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) )                               ! heat fluxes
       z_frc_trd_s =           glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) )                               ! salt fluxes
-      ! Add runoff heat & salt input
+      ! Add runoff    heat & salt input
       IF( ln_rnf    )   z_frc_trd_t = z_frc_trd_t + glob_sum( rnf_tsc(:,:,jp_tem) * surf(:,:) )
       IF( ln_rnf_sal)   z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) )
-      ! Add geothermal ice shelf
+      ! Add ice shelf heat & salt input
       IF( nn_isf .GE. 1 )  THEN
-          z_frc_trd_t = z_frc_trd_t &
-              &   + glob_sum( ( risf_tsc(:,:,jp_tem) - rdivisf * fwfisf(:,:) * (-1.9) * r1_rau0 ) * surf(:,:) )
-          z_frc_trd_s = z_frc_trd_s + (1.0_wp - rdivisf) * glob_sum( risf_tsc(:,:,jp_sal) * surf(:,:) )
+          z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) )
+          z_frc_trd_s = z_frc_trd_s + glob_sum( risf_tsc(:,:,jp_sal) * surf(:,:) )
       ENDIF
 
@@ -112,11 +111,15 @@
       !
       IF( .NOT. lk_vvl ) THEN
-         z2d0=0.0_wp ; z2d1=0.0_wp
-         DO ji=1,jpi
-            DO jj=1,jpj
-              z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem)
-              z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal)
+         IF ( ln_isfcav ) THEN
+            DO ji=1,jpi
+               DO jj=1,jpj
+                  z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem)
+                  z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal)
+               ENDDO
             ENDDO
-         ENDDO
+         ELSE
+            z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem)
+            z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal)
+         END IF
          z_wn_trd_t = - glob_sum( z2d0 ) 
          z_wn_trd_s = - glob_sum( z2d1 )
@@ -144,11 +147,15 @@
       ! heat & salt content variation (associated with ssh)
       IF( .NOT. lk_vvl ) THEN
-         z2d0 = 0._wp   ;   z2d1 = 0._wp
-         DO ji = 1, jpi
-            DO jj = 1, jpj
-              z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) ) 
-              z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) ) 
+         IF ( ln_isfcav ) THEN
+            DO ji = 1, jpi
+               DO jj = 1, jpj
+                  z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) ) 
+                  z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) ) 
+               END DO
             END DO
-         END DO
+         ELSE
+            z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) 
+            z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) 
+         END IF
          z_ssh_hc = glob_sum( z2d0 ) 
          z_ssh_sc = glob_sum( z2d1 ) 
@@ -192,5 +199,4 @@
 !      ENDIF
 !!gm end
-
 
       IF( lk_vvl ) THEN
@@ -277,10 +283,15 @@
           frc_s = 0._wp                                           ! salt content   -    -   -    -        
           IF( .NOT. lk_vvl ) THEN
-             DO ji=1,jpi
-                DO jj=1,jpj
-                   ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj)   ! initial heat content in ssh
-                   ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj)   ! initial salt content in ssh
+             IF ( ln_isfcav ) THEN
+                DO ji=1,jpi
+                   DO jj=1,jpj
+                      ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj)   ! initial heat content in ssh
+                      ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj)   ! initial salt content in ssh
+                   ENDDO
                 ENDDO
-             ENDDO
+             ELSE
+                ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh
+                ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh
+             END IF
              frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface
              frc_wn_s = 0._wp                                       ! initial salt content misfit due to free surface
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 5682)
@@ -245,5 +245,4 @@
       CALL iom_put( "mldr10_3", zrho10_3     )   ! MLD delta rho(10m) = 0.03
       CALL iom_put( "pycndep" , zpycn        )   ! MLD delta rho equi. delta T(10m) = 0.2
-      CALL iom_put( "BLT"     , ztm2 - zpycn )   ! Barrier Layer Thickness
       CALL iom_put( "tinv"    , ztinv        )   ! max. temp. inv. (t10 ref) 
       CALL iom_put( "depti"   , zdepinv      )   ! depth of max. temp. inv. (t10 ref) 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 5682)
@@ -8,4 +8,5 @@
    !!            3.2  ! 2010-03  (O. Marti, S. Flavoni) Add fields
    !!            3.3  ! 2010-10  (G. Madec)  dynamical allocation
+   !!            3.6  ! 2014-12  (C. Ethe) use of IOM
    !!----------------------------------------------------------------------
 
@@ -13,59 +14,37 @@
    !!   dia_ptr      : Poleward Transport Diagnostics module
    !!   dia_ptr_init : Initialization, namelist read
-   !!   dia_ptr_wri  : Output of poleward fluxes
-   !!   ptr_vjk      : "zonal" sum computation of a "meridional" flux array
-   !!   ptr_tjk      : "zonal" mean computation of a tracer field
-   !!   ptr_vj       : "zonal" and vertical sum computation of a "meridional" flux array
-   !!                   (Generic interface to ptr_vj_3d, ptr_vj_2d)
+   !!   ptr_sjk      : "zonal" mean computation of a field - tracer or flux array
+   !!   ptr_sj       : "zonal" and vertical sum computation of a "meridional" flux array
+   !!                   (Generic interface to ptr_sj_3d, ptr_sj_2d)
    !!----------------------------------------------------------------------
    USE oce              ! ocean dynamics and active tracers
    USE dom_oce          ! ocean space and time domain
    USE phycst           ! physical constants
-   USE ldftra_oce       ! ocean active tracers: lateral physics
-   USE dianam           !
+   !
    USE iom              ! IOM library
-   USE ioipsl           ! IO-IPSL library
    USE in_out_manager   ! I/O manager
    USE lib_mpp          ! MPP library
-   USE lbclnk           ! lateral boundary condition - processor exchanges
    USE timing           ! preformance summary
-   USE wrk_nemo         ! working arrays
 
    IMPLICIT NONE
    PRIVATE
 
-   INTERFACE ptr_vj
-      MODULE PROCEDURE ptr_vj_3d, ptr_vj_2d
+   INTERFACE ptr_sj
+      MODULE PROCEDURE ptr_sj_3d, ptr_sj_2d
    END INTERFACE
 
-   PUBLIC   dia_ptr_init   ! call in opa module
+   PUBLIC   ptr_sj         ! call by tra_ldf & tra_adv routines
+   PUBLIC   ptr_sjk        ! 
+   PUBLIC   dia_ptr_init   ! call in step module
    PUBLIC   dia_ptr        ! call in step module
-   PUBLIC   ptr_vj         ! call by tra_ldf & tra_adv routines
-   PUBLIC   ptr_vjk        ! call by tra_ldf & tra_adv routines
 
    !                                  !!** namelist  namptr  **
-   LOGICAL , PUBLIC ::   ln_diaptr     !: Poleward transport flag (T) or not (F)
-   LOGICAL , PUBLIC ::   ln_subbas     !: Atlantic/Pacific/Indian basins calculation
-   LOGICAL , PUBLIC ::   ln_diaznl     !: Add zonal means and meridional stream functions
-   LOGICAL , PUBLIC ::   ln_ptrcomp    !: Add decomposition : overturning (and gyre, soon ...)
-   INTEGER , PUBLIC ::   nn_fptr       !: frequency of ptr computation  [time step]
-   INTEGER , PUBLIC ::   nn_fwri       !: frequency of ptr outputs      [time step]
-
-   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   htr_adv, htr_ldf, htr_ove   !: Heat TRansports (adv, diff, overturn.)
-   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   str_adv, str_ldf, str_ove   !: Salt TRansports (adv, diff, overturn.)
+   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   htr_adv, htr_ldf   !: Heat TRansports (adv, diff, overturn.)
+   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   str_adv, str_ldf   !: Salt TRansports (adv, diff, overturn.)
    
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   btmsk                  ! T-point basin interior masks
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   btm30                  ! mask out Southern Ocean (=0 south of 30°S)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htr  , str             ! adv heat and salt transports (approx)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_jk, sn_jk , v_msf   ! i-mean T and S, j-Stream-Function
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sjk  , r1_sjk          ! i-mean i-k-surface and its inverse        
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htr_eiv, str_eiv       ! bolus adv heat ans salt transports ('key_diaeiv')
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_msf_eiv              ! bolus j-streamfuction              ('key_diaeiv')
-
-
-   INTEGER ::   niter       !
-   INTEGER ::   nidom_ptr   !
-   INTEGER ::   numptr      ! logical unit for Poleward TRansports
-   INTEGER ::   nptr        ! = 1 (ln_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (ln_subbas=T) 
+
+   LOGICAL, PUBLIC ::   ln_diaptr   !  Poleward transport flag (T) or not (F)
+   LOGICAL, PUBLIC ::   ln_subbas   !  Atlantic/Pacific/Indian basins calculation
+   INTEGER         ::   nptr        ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T) 
 
    REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup
@@ -73,12 +52,11 @@
    REAL(wp) ::   rc_ggram = 1.e-6_wp   ! conversion from g    to Pg
 
-   REAL(wp), TARGET, DIMENSION(:),   ALLOCATABLE, SAVE :: p_fval1d
-   REAL(wp), TARGET, DIMENSION(:,:), ALLOCATABLE, SAVE :: p_fval2d
-
-   !! Integer, 1D workspace arrays. Not common enough to be implemented in 
-   !! wrk_nemo module.
-   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex  , ndex_atl     , ndex_pac     , ndex_ind     , ndex_ipc
-   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::         ndex_atl_30  , ndex_pac_30  , ndex_ind_30  , ndex_ipc_30
-   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30
+   CHARACTER(len=3), ALLOCATABLE, SAVE, DIMENSION(:)     :: clsubb
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk   ! T-point basin interior masks
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   :: btm30   ! mask out Southern Ocean (=0 south of 30°S)
+
+   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:)     :: p_fval1d
+   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: p_fval2d
+
 
    !! * Substitutions
@@ -92,350 +70,114 @@
 CONTAINS
 
-   FUNCTION dia_ptr_alloc()
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE dia_ptr_alloc  ***
-      !!----------------------------------------------------------------------
-      INTEGER               ::   dia_ptr_alloc   ! return value
-      INTEGER, DIMENSION(6) ::   ierr
-      !!----------------------------------------------------------------------
-      ierr(:) = 0
-      !
-      ALLOCATE( btmsk(jpi,jpj,nptr) ,           &
-         &      htr_adv(jpj) , str_adv(jpj) ,   &
-         &      htr_ldf(jpj) , str_ldf(jpj) ,   &
-         &      htr_ove(jpj) , str_ove(jpj),    &
-         &      htr(jpj,nptr) , str(jpj,nptr) , &
-         &      tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , &
-         &      sjk  (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1)  )
-         !
-#if defined key_diaeiv
-      ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , &
-         &      v_msf_eiv(jpj,jpk,nptr) , STAT=ierr(2) )
-#endif
-      ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(3))
-      !
-      ALLOCATE(ndex(jpj*jpk),        ndex_atl(jpj*jpk), ndex_pac(jpj*jpk), &
-         &     ndex_ind(jpj*jpk),    ndex_ipc(jpj*jpk),                    &
-         &     ndex_atl_30(jpj*jpk), ndex_pac_30(jpj*jpk), Stat=ierr(4))
-
-      ALLOCATE(ndex_ind_30(jpj*jpk), ndex_ipc_30(jpj*jpk),                   &
-         &     ndex_h(jpj),          ndex_h_atl_30(jpj), ndex_h_pac_30(jpj), &
-         &     ndex_h_ind_30(jpj),   ndex_h_ipc_30(jpj), Stat=ierr(5) )
-         !
-     ALLOCATE( btm30(jpi,jpj) , STAT=ierr(6)  )
-         !
-      dia_ptr_alloc = MAXVAL( ierr )
-      IF(lk_mpp)   CALL mpp_sum( dia_ptr_alloc )
-      !
-   END FUNCTION dia_ptr_alloc
-
-
-   FUNCTION ptr_vj_3d( pva )   RESULT ( p_fval )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE ptr_vj_3d  ***
-      !!
-      !! ** Purpose :   i-k sum computation of a j-flux array
-      !!
-      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
-      !!              pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
-      !!
-      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
-      !!----------------------------------------------------------------------
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point
-      !!
-      INTEGER                  ::   ji, jj, jk   ! dummy loop arguments
-      INTEGER                  ::   ijpj         ! ???
-      REAL(wp), POINTER, DIMENSION(:) :: p_fval  ! function value
-      !!--------------------------------------------------------------------
-      !
-      p_fval => p_fval1d
-
-      ijpj = jpj
-      p_fval(:) = 0._wp
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! Vector opt.
-               p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) 
-            END DO
-         END DO
-      END DO
-#if defined key_mpp_mpi
-      IF(lk_mpp)   CALL mpp_sum( p_fval, ijpj, ncomm_znl)
-#endif
-      !
-   END FUNCTION ptr_vj_3d
-
-
-   FUNCTION ptr_vj_2d( pva )   RESULT ( p_fval )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE ptr_vj_2d  ***
-      !!
-      !! ** Purpose :   "zonal" and vertical sum computation of a i-flux array
-      !!
-      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
-      !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
-      !!
-      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
-      !!----------------------------------------------------------------------
-      IMPLICIT none
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pva   ! mask flux array at V-point
-      !!
-      INTEGER                  ::   ji,jj       ! dummy loop arguments
-      INTEGER                  ::   ijpj        ! ???
-      REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value
-      !!--------------------------------------------------------------------
-      ! 
-      p_fval => p_fval1d
-
-      ijpj = jpj
-      p_fval(:) = 0._wp
-      DO jj = 2, jpjm1
-         DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ?
-            p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj)
-         END DO
-      END DO
-#if defined key_mpp_mpi
-      CALL mpp_sum( p_fval, ijpj, ncomm_znl )
-#endif
-      ! 
-   END FUNCTION ptr_vj_2d
-
-
-   FUNCTION ptr_vjk( pva, pmsk )   RESULT ( p_fval )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE ptr_vjk  ***
-      !!
-      !! ** Purpose :   i-sum computation of a j-velocity array
-      !!
-      !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i).
-      !!              pva is supposed to be a masked flux (i.e. * vmask)
-      !!
-      !! ** Action  : - p_fval: i-mean poleward flux of pva
-      !!----------------------------------------------------------------------
-      !!
-      IMPLICIT none
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pva    ! mask flux array at V-point
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask
-      !!
-      INTEGER                           :: ji, jj, jk ! dummy loop arguments
-      REAL(wp), POINTER, DIMENSION(:,:) :: p_fval     ! return function value
-#if defined key_mpp_mpi
-      INTEGER, DIMENSION(1) ::   ish
-      INTEGER, DIMENSION(2) ::   ish2
-      INTEGER               ::   ijpjjpk
-#endif
-#if defined key_mpp_mpi
-      REAL(wp), POINTER, DIMENSION(:) ::   zwork    ! mask flux array at V-point
-#endif
-      !!--------------------------------------------------------------------
-      !
-#if defined key_mpp_mpi
-      ijpjjpk = jpj*jpk
-      CALL wrk_alloc( jpj*jpk, zwork )
-#endif
-
-      p_fval => p_fval2d
-
-      p_fval(:,:) = 0._wp
-      !
-      IF( PRESENT( pmsk ) ) THEN 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-!!gm here, use of tmask_i  ==> no need of loop over nldi, nlei....
-               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
-                  p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * pmsk(ji,jj)
+   SUBROUTINE dia_ptr( pvtr )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_ptr  ***
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pvtr   ! j-effective transport
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zv, zsfc               ! local scalar
+      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d   ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d   ! 3D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zmask   ! 3D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::  zts   ! 3D workspace
+      CHARACTER( len = 10 )  :: cl1
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dia_ptr')
+
+      !
+      IF( PRESENT( pvtr ) ) THEN
+         IF( iom_use("zomsfglo") ) THEN    ! effective MSF
+            z3d(1,:,:) = ptr_sjk( pvtr(:,:,:) )  ! zonal cumulative effective transport
+            DO jk = 2, jpkm1 
+              z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk)   ! effective j-Stream-Function (MSF)
+            END DO
+            DO ji = 1, jpi
+               z3d(ji,:,:) = z3d(1,:,:)
+            ENDDO
+            cl1 = TRIM('zomsf'//clsubb(1) )
+            CALL iom_put( cl1, z3d * rc_sv )
+            DO jn = 2, nptr                                    ! by sub-basins
+               z3d(1,:,:) =  ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) 
+               DO jk = 2, jpkm1 
+                  z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk)    ! effective j-Stream-Function (MSF)
                END DO
-            END DO
-         END DO
-      ELSE 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
-                  p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji,jj)
-               END DO
-            END DO
-         END DO
-      END IF
-      !
-#if defined key_mpp_mpi
-      ijpjjpk = jpj*jpk
-      ish(1) = ijpjjpk  ;   ish2(1) = jpj   ;   ish2(2) = jpk
-      zwork(1:ijpjjpk) = RESHAPE( p_fval, ish )
-      CALL mpp_sum( zwork, ijpjjpk, ncomm_znl )
-      p_fval(:,:) = RESHAPE( zwork, ish2 )
-#endif
-      !
-#if defined key_mpp_mpi
-      CALL wrk_dealloc( jpj*jpk, zwork )
-#endif
-      !
-   END FUNCTION ptr_vjk
-
-
-   FUNCTION ptr_tjk( pta, pmsk )   RESULT ( p_fval )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE ptr_tjk  ***
-      !!
-      !! ** Purpose :   i-sum computation of e1t*e3t * a tracer field
-      !!
-      !! ** Method  : - i-sum of mj(pta) using tmask
-      !!
-      !! ** Action  : - p_fval: i-sum of e1t*e3t*pta
-      !!----------------------------------------------------------------------
-      !!
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! tracer flux array at T-point
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)     ::   pmsk   ! Optional 2D basin mask
-      !!
-      INTEGER                           :: ji, jj, jk   ! dummy loop arguments
-      REAL(wp), POINTER, DIMENSION(:,:) :: p_fval       ! return function value
-#if defined key_mpp_mpi
-      INTEGER, DIMENSION(1) ::   ish
-      INTEGER, DIMENSION(2) ::   ish2
-      INTEGER               ::   ijpjjpk
-#endif
-#if defined key_mpp_mpi
-      REAL(wp), POINTER, DIMENSION(:) ::   zwork    ! mask flux array at V-point
-#endif
-      !!-------------------------------------------------------------------- 
-      !
-#if defined key_mpp_mpi
-      ijpjjpk = jpj*jpk
-      CALL wrk_alloc( jpj*jpk, zwork )
-#endif
-
-      p_fval => p_fval2d
-
-      p_fval(:,:) = 0._wp
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
-               p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * e1t(ji,jj) * fse3t(ji,jj,jk) * pmsk(ji,jj)
-            END DO
-         END DO
-      END DO
-#if defined key_mpp_mpi
-      ijpjjpk = jpj*jpk
-      ish(1) = jpj*jpk   ;   ish2(1) = jpj   ;   ish2(2) = jpk
-      zwork(1:ijpjjpk)= RESHAPE( p_fval, ish )
-      CALL mpp_sum( zwork, ijpjjpk, ncomm_znl )
-      p_fval(:,:)= RESHAPE( zwork, ish2 )
-#endif
-      !
-#if defined key_mpp_mpi
-      CALL wrk_dealloc( jpj*jpk, zwork )
-#endif
-      !    
-   END FUNCTION ptr_tjk
-
-
-   SUBROUTINE dia_ptr( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dia_ptr  ***
-      !!----------------------------------------------------------------------
-      USE oce,     vt  =>   ua   ! use ua as workspace
-      USE oce,     vs  =>   va   ! use va as workspace
-      IMPLICIT none
-      !!
-      INTEGER, INTENT(in) ::   kt   ! ocean time step index
-      !
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zv               ! local scalar
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )   CALL timing_start('dia_ptr')
-      !
-      IF( kt == nit000 .OR. MOD( kt, nn_fptr ) == 0 )   THEN
-         !
-         IF( MOD( kt, nn_fptr ) == 0 ) THEN 
-            !
-            IF( ln_diaznl ) THEN               ! i-mean temperature and salinity
-               DO jn = 1, nptr
-                  tn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn)
-                  sn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn)
-               END DO
-            ENDIF
-            !
-            !                          ! horizontal integral and vertical dz 
-            !                                ! eulerian velocity
-            v_msf(:,:,1) = ptr_vjk( vn(:,:,:) ) 
-            DO jn = 2, nptr
-               v_msf(:,:,jn) = ptr_vjk( vn(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) 
-            END DO
-#if defined key_diaeiv
-            DO jn = 1, nptr                  ! bolus velocity
-               v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) )   ! here no btm30 for MSFeiv
-            END DO
-            !                                ! add bolus stream-function to the eulerian one
-            v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:)
-#endif
-            !
-            !                          ! Transports
-            !                                ! local heat & salt transports at T-points  ( tsn*mj[vn+v_eiv] )
-            vt(:,:,jpk) = 0._wp   ;   vs(:,:,jpk) = 0._wp
-            DO jk= 1, jpkm1
-               DO jj = 2, jpj
+               DO ji = 1, jpi
+                  z3d(ji,:,:) = z3d(1,:,:)
+               ENDDO
+               cl1 = TRIM('zomsf'//clsubb(jn) )
+               CALL iom_put( cl1, z3d * rc_sv )
+            END DO
+         ENDIF
+         !
+      ELSE
+         !
+         IF( iom_use("zotemglo") ) THEN    ! i-mean i-k-surface 
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
                   DO ji = 1, jpi
-#if defined key_diaeiv 
-                     zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + v_eiv(ji,jj,jk) + v_eiv(ji,jj-1,jk) ) * 0.5_wp
-#else
-                     zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp
-#endif 
-                     vt(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_tem)
-                     vs(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_sal)
-                  END DO
-               END DO
-            END DO
-!!gm useless as overlap areas are not used in ptr_vjk
-            CALL lbc_lnk( vs, 'V', -1. )   ;   CALL lbc_lnk( vt, 'V', -1. )
-!!gm
-            !                                ! heat & salt advective transports (approximation)
-            htr(:,1) = SUM( ptr_vjk( vt(:,:,:) ) , 2 ) * rc_pwatt   ! SUM over jk + conversion
-            str(:,1) = SUM( ptr_vjk( vs(:,:,:) ) , 2 ) * rc_ggram
-            DO jn = 2, nptr 
-               htr(:,jn) = SUM( ptr_vjk( vt(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_pwatt   ! mask Southern Ocean
-               str(:,jn) = SUM( ptr_vjk( vs(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_ggram   ! mask Southern Ocean
-            END DO
-
-            IF( ln_ptrcomp ) THEN            ! overturning transport
-               htr_ove(:) = SUM( v_msf(:,:,1) * tn_jk(:,:,1), 2 ) * rc_pwatt   ! SUM over jk + conversion
-               str_ove(:) = SUM( v_msf(:,:,1) * sn_jk(:,:,1), 2 ) * rc_ggram
-            END IF
-            !                                ! Advective and diffusive transport
-            htr_adv(:) = htr_adv(:) * rc_pwatt        ! these are computed in tra_adv... and tra_ldf... routines 
-            htr_ldf(:) = htr_ldf(:) * rc_pwatt        ! here just the conversion in PW and Gg
-            str_adv(:) = str_adv(:) * rc_ggram
-            str_ldf(:) = str_ldf(:) * rc_ggram
-
-#if defined key_diaeiv
-            DO jn = 1, nptr                  ! Bolus component
-               htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt   ! SUM over jk
-               str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram   ! SUM over jk
-            END DO
-#endif
-            !                                ! "Meridional" Stream-Function
+                     zsfc = e1t(ji,jj) * fse3t(ji,jj,jk)
+                     zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc
+                     zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc
+                     zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc
+                  ENDDO
+               ENDDO
+            ENDDO
             DO jn = 1, nptr
-               DO jk = 2, jpk 
-                  v_msf    (:,jk,jn) = v_msf    (:,jk-1,jn) + v_msf    (:,jk,jn)       ! Eulerian j-Stream-Function
-#if defined key_diaeiv
-                  v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn)       ! Bolus    j-Stream-Function
-
-#endif
-               END DO
-            END DO
-            v_msf    (:,:,:) = v_msf    (:,:,:) * rc_sv       ! converte in Sverdrups
-#if defined key_diaeiv
-            v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv
-#endif
-         ENDIF
-         !
-         CALL dia_ptr_wri( kt )                        ! outputs
+               zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) )
+               cl1 = TRIM('zosrf'//clsubb(jn) )
+               CALL iom_put( cl1, zmask )
+               !
+               z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) &
+                  &            / MAX( zmask(1,:,:), 10.e-15 )
+               DO ji = 1, jpi
+                  z3d(ji,:,:) = z3d(1,:,:)
+               ENDDO
+               cl1 = TRIM('zotem'//clsubb(jn) )
+               CALL iom_put( cl1, z3d )
+               !
+               z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) &
+                  &            / MAX( zmask(1,:,:), 10.e-15 )
+               DO ji = 1, jpi
+                  z3d(ji,:,:) = z3d(1,:,:)
+               ENDDO
+               cl1 = TRIM('zosal'//clsubb(jn) )
+               CALL iom_put( cl1, z3d )
+            END DO
+         ENDIF
+         !
+         !                                ! Advective and diffusive heat and salt transport
+         IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN   
+            z2d(1,:) = htr_adv(:) * rc_pwatt        !  (conversion in PW)
+            DO ji = 1, jpi
+               z2d(ji,:) = z2d(1,:)
+            ENDDO
+            cl1 = 'sophtadv'                 
+            CALL iom_put( TRIM(cl1), z2d )
+            z2d(1,:) = str_adv(:) * rc_ggram        ! (conversion in Gg)
+            DO ji = 1, jpi
+               z2d(ji,:) = z2d(1,:)
+            ENDDO
+            cl1 = 'sopstadv'
+            CALL iom_put( TRIM(cl1), z2d )
+         ENDIF
+         !
+         IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN   
+            z2d(1,:) = htr_ldf(:) * rc_pwatt        !  (conversion in PW) 
+            DO ji = 1, jpi
+               z2d(ji,:) = z2d(1,:)
+            ENDDO
+            cl1 = 'sophtldf'
+            CALL iom_put( TRIM(cl1), z2d )
+            z2d(1,:) = str_ldf(:) * rc_ggram        !  (conversion in Gg)
+            DO ji = 1, jpi
+               z2d(ji,:) = z2d(1,:)
+            ENDDO
+            cl1 = 'sopstldf'
+            CALL iom_put( TRIM(cl1), z2d )
+         ENDIF
          !
       ENDIF
-      !
-#if defined key_mpp_mpi
-      IF( kt == nitend .AND. l_znl_root )   CALL histclo( numptr )      ! Close the file
-#else
-      IF( kt == nitend )                    CALL histclo( numptr )      ! Close the file
-#endif
       !
       IF( nn_timing == 1 )   CALL timing_stop('dia_ptr')
@@ -450,12 +192,9 @@
       !! ** Purpose :   Initialization, namelist read
       !!----------------------------------------------------------------------
-      INTEGER ::   jn           ! dummy loop indices 
-      INTEGER ::   inum, ierr   ! local integers
-      INTEGER ::   ios          ! Local integer output status for namelist read
-#if defined key_mpp_mpi
-      INTEGER, DIMENSION(1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid
-#endif
-      !!
-      NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri
+      INTEGER ::  jn           ! local integers
+      INTEGER ::  inum, ierr   ! local integers
+      INTEGER ::  ios          ! Local integer output status for namelist read
+      !!
+      NAMELIST/namptr/ ln_diaptr, ln_subbas
       !!----------------------------------------------------------------------
 
@@ -475,17 +214,17 @@
          WRITE(numout,*) '   Namelist namptr : set ptr parameters'
          WRITE(numout,*) '      Poleward heat & salt transport (T) or not (F)      ln_diaptr  = ', ln_diaptr
-         WRITE(numout,*) '      Overturning heat & salt transport                  ln_ptrcomp = ', ln_ptrcomp
-         WRITE(numout,*) '      T & S zonal mean and meridional stream function    ln_diaznl  = ', ln_diaznl 
          WRITE(numout,*) '      Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins      ln_subbas  = ', ln_subbas
-         WRITE(numout,*) '      Frequency of computation                           nn_fptr    = ', nn_fptr
-         WRITE(numout,*) '      Frequency of outputs                               nn_fwri    = ', nn_fwri
       ENDIF
-      
-      IF( ln_diaptr) THEN  
-     
-         IF( nn_timing == 1 )   CALL timing_start('dia_ptr_init')
-      
-         IF( ln_subbas ) THEN   ;   nptr = 5       ! Global, Atlantic, Pacific, Indian, Indo-Pacific
-         ELSE                   ;   nptr = 1       ! Global only
+
+      IF( ln_diaptr ) THEN  
+         !
+         IF( ln_subbas ) THEN 
+            nptr = 5            ! Global, Atlantic, Pacific, Indian, Indo-Pacific
+            ALLOCATE( clsubb(nptr) )
+            clsubb(1) = 'glo' ;  clsubb(2) = 'atl'  ;  clsubb(3) = 'pac'  ;  clsubb(4) = 'ind'  ;  clsubb(5) = 'ipc'
+         ELSE               
+            nptr = 1       ! Global only
+            ALLOCATE( clsubb(nptr) )
+            clsubb(1) = 'glo' 
          ENDIF
 
@@ -493,10 +232,10 @@
          IF( dia_ptr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' )
 
-         rc_pwatt = rc_pwatt * rau0 * rcp          ! conversion from K.s-1 to PetaWatt
+         rc_pwatt = rc_pwatt * rau0_rcp          ! conversion from K.s-1 to PetaWatt
 
          IF( lk_mpp )   CALL mpp_ini_znl( numout )     ! Define MPI communicator for zonal sum
 
          IF( ln_subbas ) THEN                ! load sub-basin mask
-            CALL iom_open( 'subbasins', inum )
+            CALL iom_open( 'subbasins', inum,  ldstop = .FALSE.  )
             CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin
             CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin
@@ -508,4 +247,5 @@
             END WHERE
          ENDIF
+   
          btmsk(:,:,1) = tmask_i(:,:)                                   ! global ocean
       
@@ -513,32 +253,10 @@
             btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:)               ! interior domain only
          END DO
-      
-         IF( lk_vvl )   CALL ctl_stop( 'diaptr: error in vvl case as constant i-mean surface is used' )
-
-         !                                   ! i-sum of e1v*e3v surface and its inverse
-         DO jn = 1, nptr
-            sjk(:,:,jn) = ptr_tjk( tmask(:,:,:), btmsk(:,:,jn) )
-            r1_sjk(:,:,jn) = 0._wp
-            WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn)
-         END DO
-
-      ! Initialise arrays to zero because diatpr is called before they are first calculated
-      ! Note that this means diagnostics will not be exactly correct when model run is restarted.
-      htr_adv(:) = 0._wp ; str_adv(:) =  0._wp ;  htr_ldf(:) = 0._wp ; str_ldf(:) =  0._wp
-
-#if defined key_mpp_mpi 
-         iglo (1) = jpjglo                   ! MPP case using MPI  ('key_mpp_mpi')
-         iloc (1) = nlcj
-         iabsf(1) = njmppt(narea)
-         iabsl(:) = iabsf(:) + iloc(:) - 1
-         ihals(1) = nldj - 1
-         ihale(1) = nlcj - nlej
-         idid (1) = 2
-         CALL flio_dom_set( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr )
-#else
-         nidom_ptr = FLIO_DOM_NONE
-#endif
-      IF( nn_timing == 1 )   CALL timing_stop('dia_ptr_init')
-      !
+
+         ! Initialise arrays to zero because diatpr is called before they are first calculated
+         ! Note that this means diagnostics will not be exactly correct when model run is restarted.
+         htr_adv(:) = 0._wp  ;  str_adv(:) =  0._wp  
+         htr_ldf(:) = 0._wp  ;  str_ldf(:) =  0._wp 
+         !
       ENDIF 
       ! 
@@ -546,350 +264,176 @@
 
 
-   SUBROUTINE dia_ptr_wri( kt )
-      !!---------------------------------------------------------------------
-      !!                ***  ROUTINE dia_ptr_wri  ***
-      !!
-      !! ** Purpose :   output of poleward fluxes
-      !!
-      !! ** Method  :   NetCDF file
-      !!----------------------------------------------------------------------
-      !!
-      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
-      !!
-      INTEGER, SAVE ::   nhoridz, ndepidzt, ndepidzw
-      INTEGER, SAVE ::   ndim  , ndim_atl     , ndim_pac     , ndim_ind     , ndim_ipc
-      INTEGER, SAVE ::           ndim_atl_30  , ndim_pac_30  , ndim_ind_30  , ndim_ipc_30
-      INTEGER, SAVE ::   ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30
-      !!
-      CHARACTER (len=40) ::   clhstnam, clop, clop_once, cl_comment   ! temporary names
-      INTEGER            ::   iline, it, itmod, ji, jj, jk            !
-#if defined key_iomput
-      INTEGER            ::   inum                                    ! temporary logical unit
+   FUNCTION dia_ptr_alloc()
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_ptr_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER               ::   dia_ptr_alloc   ! return value
+      INTEGER, DIMENSION(3) ::   ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( btmsk(jpi,jpj,nptr) ,           &
+         &      htr_adv(jpj) , str_adv(jpj) ,   &
+         &      htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1)  )
+         !
+      ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2))
+      !
+      ALLOCATE( btm30(jpi,jpj), STAT=ierr(3)  )
+
+         !
+      dia_ptr_alloc = MAXVAL( ierr )
+      IF(lk_mpp)   CALL mpp_sum( dia_ptr_alloc )
+      !
+   END FUNCTION dia_ptr_alloc
+
+
+   FUNCTION ptr_sj_3d( pva, pmsk )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_sj_3d  ***
+      !!
+      !! ** Purpose :   i-k sum computation of a j-flux array
+      !!
+      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
+      !!              pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
+      !!
+      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)       ::   pva   ! mask flux array at V-point
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask
+      !
+      INTEGER                  ::   ji, jj, jk   ! dummy loop arguments
+      INTEGER                  ::   ijpj         ! ???
+      REAL(wp), POINTER, DIMENSION(:) :: p_fval  ! function value
+      !!--------------------------------------------------------------------
+      !
+      p_fval => p_fval1d
+
+      ijpj = jpj
+      p_fval(:) = 0._wp
+      IF( PRESENT( pmsk ) ) THEN 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! Vector opt.
+                  p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) * pmsk(ji,jj)
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! Vector opt.
+                  p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) 
+               END DO
+            END DO
+         END DO
+      ENDIF
+#if defined key_mpp_mpi
+      IF(lk_mpp)   CALL mpp_sum( p_fval, ijpj, ncomm_znl)
 #endif
-      REAL(wp)           ::   zsto, zout, zdt, zjulian                ! temporary scalars
-      !!
-      REAL(wp), POINTER, DIMENSION(:)   ::   zphi, zfoo    ! 1D workspace
-      REAL(wp), POINTER, DIMENSION(:,:) ::   z_1           ! 2D workspace
-      !!-------------------------------------------------------------------- 
-      !
-      CALL wrk_alloc( jpj       , zphi , zfoo )
-      CALL wrk_alloc( jpj , jpk , z_1  )
-
-      ! define time axis
-      it    = kt / nn_fptr
-      itmod = kt - nit000 + 1
-      
-      ! Initialization
-      ! --------------
-      IF( kt == nit000 ) THEN
-         niter = ( nit000 - 1 ) / nn_fptr
-         zdt = rdt
-         IF( nacc == 1 )   zdt = rdtmin
-         !
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter
-            WRITE(numout,*) '~~~~~~~~~~~~'
-         ENDIF
-
-         ! Reference latitude (used in plots)
-         ! ------------------
-         !                                           ! =======================
-         IF( cp_cfg == "orca" ) THEN                 !   ORCA configurations
-            !                                        ! =======================
-            IF( jp_cfg == 05  )   iline = 192   ! i-line that passes near the North Pole
-            IF( jp_cfg == 025 )   iline = 384   ! i-line that passes near the North Pole
-            IF( jp_cfg == 1   )   iline =  96   ! i-line that passes near the North Pole
-            IF( jp_cfg == 2   )   iline =  48   ! i-line that passes near the North Pole
-            IF( jp_cfg == 4   )   iline =  24   ! i-line that passes near the North Pole
-            zphi(1:jpj) = 0._wp
-            DO ji = mi0(iline), mi1(iline) 
-               zphi(1:jpj) = gphiv(ji,:)         ! if iline is in the local domain
-               ! Correct highest latitude for some configurations - will work if domain is parallelized in J ?
-               IF( jp_cfg == 05 ) THEN
-                  DO jj = mj0(jpjdta), mj1(jpjdta) 
-                     zphi( jj ) = zphi(mj0(jpjdta-1)) + ( zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)) ) * 0.5_wp
-                     zphi( jj ) = MIN( zphi(jj), 90._wp )
-                  END DO
-               END IF
-               IF( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN
-                  DO jj = mj0(jpjdta-1), mj1(jpjdta-1) 
-                     zphi( jj ) = 88.5_wp
-                  END DO
-                  DO jj = mj0(jpjdta  ), mj1(jpjdta  ) 
-                     zphi( jj ) = 89.5_wp
-                  END DO
-               END IF
-            END DO
-            ! provide the correct zphi to all local domains
+      !
+   END FUNCTION ptr_sj_3d
+
+
+   FUNCTION ptr_sj_2d( pva, pmsk )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_sj_2d  ***
+      !!
+      !! ** Purpose :   "zonal" and vertical sum computation of a i-flux array
+      !!
+      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
+      !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
+      !!
+      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
+      !!----------------------------------------------------------------------
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)           ::   pva   ! mask flux array at V-point
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask
+      !
+      INTEGER                  ::   ji,jj       ! dummy loop arguments
+      INTEGER                  ::   ijpj        ! ???
+      REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value
+      !!--------------------------------------------------------------------
+      ! 
+      p_fval => p_fval1d
+
+      ijpj = jpj
+      p_fval(:) = 0._wp
+      IF( PRESENT( pmsk ) ) THEN 
+         DO jj = 2, jpjm1
+            DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ?
+               p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj)
+            END DO
+         END DO
+      ELSE
+         DO jj = 2, jpjm1
+            DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ?
+               p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj)
+            END DO
+         END DO
+      ENDIF
 #if defined key_mpp_mpi
-            CALL mpp_sum( zphi, jpj, ncomm_znl )        
+      CALL mpp_sum( p_fval, ijpj, ncomm_znl )
 #endif
-            !                                        ! =======================
-         ELSE                                        !   OTHER configurations 
-            !                                        ! =======================
-            zphi(1:jpj) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line
-            !
-         ENDIF
-         !
-         ! Work only on westmost processor (will not work if mppini2 is used)
+      ! 
+   END FUNCTION ptr_sj_2d
+
+
+   FUNCTION ptr_sjk( pta, pmsk )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_sjk  ***
+      !!
+      !! ** Purpose :   i-sum computation of an array
+      !!
+      !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i).
+      !!
+      !! ** Action  : - p_fval: i-mean poleward flux of pva
+      !!----------------------------------------------------------------------
+      !!
+      IMPLICIT none
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pta    ! mask flux array at V-point
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask
+      !!
+      INTEGER                           :: ji, jj, jk ! dummy loop arguments
+      REAL(wp), POINTER, DIMENSION(:,:) :: p_fval     ! return function value
 #if defined key_mpp_mpi
-         IF( l_znl_root ) THEN 
+      INTEGER, DIMENSION(1) ::   ish
+      INTEGER, DIMENSION(2) ::   ish2
+      INTEGER               ::   ijpjjpk
+      REAL(wp), DIMENSION(jpj*jpk) ::   zwork    ! mask flux array at V-point
 #endif
-            !
-            ! OPEN netcdf file 
-            ! ----------------
-            ! Define frequency of output and means
-            zsto = nn_fptr * zdt
-            IF( ln_mskland )   THEN    ! put 1.e+20 on land (very expensive!!)
-               clop      = "ave(only(x))"
-               clop_once = "once(only(x))"
-            ELSE                       ! no use of the mask value (require less cpu time)
-               clop      = "ave(x)"       
-               clop_once = "once"
-            ENDIF
-
-            zout = nn_fwri * zdt
-            zfoo(1:jpj) = 0._wp
-
-            CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )  ! Compute julian date from starting date of the run
-            zjulian = zjulian - adatrj                         ! set calendar origin to the beginning of the experiment
-
-#if defined key_iomput
-            ! Requested by IPSL people, use by their postpro...
-            IF(lwp) THEN
-               CALL dia_nam( clhstnam, nn_fwri,' ' )
-               CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-               WRITE(inum,*) clhstnam
-               CLOSE(inum)
-            ENDIF
+      !!--------------------------------------------------------------------
+      !
+      p_fval => p_fval2d
+
+      p_fval(:,:) = 0._wp
+      !
+      IF( PRESENT( pmsk ) ) THEN 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+!!gm here, use of tmask_i  ==> no need of loop over nldi, nlei....
+               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
+                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj)
+               END DO
+            END DO
+         END DO
+      ELSE 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
+                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+      END IF
+      !
+#if defined key_mpp_mpi
+      ijpjjpk = jpj*jpk
+      ish(1) = ijpjjpk  ;   ish2(1) = jpj   ;   ish2(2) = jpk
+      zwork(1:ijpjjpk) = RESHAPE( p_fval, ish )
+      CALL mpp_sum( zwork, ijpjjpk, ncomm_znl )
+      p_fval(:,:) = RESHAPE( zwork, ish2 )
 #endif
-
-            CALL dia_nam( clhstnam, nn_fwri, 'diaptr' )
-            IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file : ", clhstnam
-
-            ! Horizontal grid : zphi()
-            CALL histbeg(clhstnam, 1, zfoo, jpj, zphi,   &
-               1, 1, 1, jpj, niter, zjulian, zdt*nn_fptr, nhoridz, numptr, domain_id=nidom_ptr)
-            ! Vertical grids : gdept_1d, gdepw_1d
-            CALL histvert( numptr, "deptht", "Vertical T levels",   &
-               &                   "m", jpk, gdept_1d, ndepidzt, "down" )
-            CALL histvert( numptr, "depthw", "Vertical W levels",   &
-               &                   "m", jpk, gdepw_1d, ndepidzw, "down" )
-            !
-            CALL wheneq ( jpj*jpk, MIN(sjk(:,:,1), 1._wp), 1, 1., ndex  , ndim  )      ! Lat-Depth
-            CALL wheneq ( jpj    , MIN(sjk(:,1,1), 1._wp), 1, 1., ndex_h, ndim_h )     ! Lat
-
-            IF( ln_subbas ) THEN
-               z_1(:,1) = 1._wp
-               WHERE ( gphit(jpi/2,:) < -30._wp )   z_1(:,1) = 0._wp
-               DO jk = 2, jpk
-                  z_1(:,jk) = z_1(:,1)
-               END DO
-               !                       ! Atlantic (jn=2)
-               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)         , 1._wp), 1, 1., ndex_atl     , ndim_atl      ) ! Lat-Depth
-               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)*z_1(:,:), 1._wp), 1, 1., ndex_atl_30  , ndim_atl_30   ) ! Lat-Depth
-               CALL wheneq ( jpj    , MIN(sjk(:,1,2)*z_1(:,1), 1._wp), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat
-               !                       ! Pacific (jn=3)
-               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)         , 1._wp), 1, 1., ndex_pac     , ndim_pac      ) ! Lat-Depth
-               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)*z_1(:,:), 1._wp), 1, 1., ndex_pac_30  , ndim_pac_30   ) ! Lat-Depth
-               CALL wheneq ( jpj    , MIN(sjk(:,1,3)*z_1(:,1), 1._wp), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat
-               !                       ! Indian (jn=4)
-               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)         , 1._wp), 1, 1., ndex_ind     , ndim_ind      ) ! Lat-Depth
-               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)*z_1(:,:), 1._wp), 1, 1., ndex_ind_30  , ndim_ind_30   ) ! Lat-Depth
-               CALL wheneq ( jpj    , MIN(sjk(:,1,4)*z_1(:,1), 1._wp), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat
-               !                       ! Indo-Pacific (jn=5)
-               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)         , 1._wp), 1, 1., ndex_ipc     , ndim_ipc      ) ! Lat-Depth
-               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)*z_1(:,:), 1._wp), 1, 1., ndex_ipc_30  , ndim_ipc_30   ) ! Lat-Depth
-               CALL wheneq ( jpj    , MIN(sjk(:,1,5)*z_1(:,1), 1._wp), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat
-            ENDIF
-            ! 
-#if defined key_diaeiv
-            cl_comment = ' (Bolus part included)'
-#else
-            cl_comment = '                      '
-#endif
-            IF( ln_diaznl ) THEN             !  Zonal mean T and S
-               CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" ,   &
-                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
-               CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU"  ,   &
-                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
-
-               CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2"   ,   &
-                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
-               !
-               IF (ln_subbas) THEN 
-                  CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" ,   &
-                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
-                  CALL histdef( numptr, "zosalatl", "Zonal Mean Salinity: Atlantic","PSU"  ,   &
-                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
-                  CALL histdef( numptr, "zosrfatl", "Zonal Mean Surface: Atlantic","m^2"   ,   &
-                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
-
-                  CALL histdef( numptr, "zotempac", "Zonal Mean Temperature: Pacific","C"  ,   &
-                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
-                  CALL histdef( numptr, "zosalpac", "Zonal Mean Salinity: Pacific","PSU"   ,   &
-                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
-                  CALL histdef( numptr, "zosrfpac", "Zonal Mean Surface: Pacific","m^2"    ,   &
-                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
-
-                  CALL histdef( numptr, "zotemind", "Zonal Mean Temperature: Indian","C"   ,   &
-                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
-                  CALL histdef( numptr, "zosalind", "Zonal Mean Salinity: Indian","PSU"    ,   &
-                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
-                  CALL histdef( numptr, "zosrfind", "Zonal Mean Surface: Indian","m^2"     ,   &
-                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
-
-                  CALL histdef( numptr, "zotemipc", "Zonal Mean Temperature: Pacific+Indian","C" ,   &
-                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
-                  CALL histdef( numptr, "zosalipc", "Zonal Mean Salinity: Pacific+Indian","PSU"  ,   &
-                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
-                  CALL histdef( numptr, "zosrfipc", "Zonal Mean Surface: Pacific+Indian","m^2"   ,   &
-                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
-               ENDIF
-            ENDIF
-            !
-            !  Meridional Stream-Function (Eulerian and Bolus)
-            CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" ,   &
-               1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
-            IF( ln_subbas .AND. ln_diaznl ) THEN
-               CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" ,   &
-                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
-               CALL histdef( numptr, "zomsfpac", "Meridional Stream-Function: Pacific"//TRIM(cl_comment),"Sv"  ,   &
-                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
-               CALL histdef( numptr, "zomsfind", "Meridional Stream-Function: Indian"//TRIM(cl_comment),"Sv"   ,   &
-                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
-               CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific"//TRIM(cl_comment),"Sv" ,&
-                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
-            ENDIF
-            !
-            !  Heat transport 
-            CALL histdef( numptr, "sophtadv", "Advective Heat Transport"      ,   &
-               "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-            CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport"      ,   &
-               "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-            IF ( ln_ptrcomp ) THEN 
-               CALL histdef( numptr, "sophtove", "Overturning Heat Transport"    ,   &
-                  "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-            END IF
-            IF( ln_subbas ) THEN
-               CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment),  &
-                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-               CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) ,  &
-                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-               CALL histdef( numptr, "sohtind", "Heat Transport Indian"//TRIM(cl_comment)  ,  &
-                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-               CALL histdef( numptr, "sohtipc", "Heat Transport Pacific+Indian"//TRIM(cl_comment), &
-                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-            ENDIF
-            !
-            !  Salt transport 
-            CALL histdef( numptr, "sopstadv", "Advective Salt Transport"      ,   &
-               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-            CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport"      ,   &
-               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-            IF ( ln_ptrcomp ) THEN 
-               CALL histdef( numptr, "sopstove", "Overturning Salt Transport"    ,   &
-                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-            END IF
-#if defined key_diaeiv
-            ! Eddy induced velocity
-            CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global",   &
-               "Sv"      , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
-            CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport",   &
-               "PW"      , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-            CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport",   &
-               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-#endif
-            IF( ln_subbas ) THEN
-               CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment)      ,  &
-                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-               CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment)      ,   &
-                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-               CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment)      ,    &
-                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-               CALL histdef( numptr, "sostipc", "Salt Transport Pacific+Indian"//TRIM(cl_comment),  &
-                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-            ENDIF
-            !
-            CALL histend( numptr )
-            !
-         END IF
-#if defined key_mpp_mpi
-      END IF
-#endif
-
-#if defined key_mpp_mpi
-      IF( MOD( itmod, nn_fptr ) == 0 .AND. l_znl_root ) THEN
-#else
-      IF( MOD( itmod, nn_fptr ) == 0  ) THEN
-#endif
-         niter = niter + 1
-
-         IF( ln_diaznl ) THEN 
-            CALL histwrite( numptr, "zosrfglo", niter, sjk  (:,:,1) , ndim, ndex )
-            CALL histwrite( numptr, "zotemglo", niter, tn_jk(:,:,1)  , ndim, ndex )
-            CALL histwrite( numptr, "zosalglo", niter, sn_jk(:,:,1)  , ndim, ndex )
-
-            IF (ln_subbas) THEN 
-               CALL histwrite( numptr, "zosrfatl", niter, sjk(:,:,2), ndim_atl, ndex_atl )
-               CALL histwrite( numptr, "zosrfpac", niter, sjk(:,:,3), ndim_pac, ndex_pac )
-               CALL histwrite( numptr, "zosrfind", niter, sjk(:,:,4), ndim_ind, ndex_ind )
-               CALL histwrite( numptr, "zosrfipc", niter, sjk(:,:,5), ndim_ipc, ndex_ipc )
-
-               CALL histwrite( numptr, "zotematl", niter, tn_jk(:,:,2)  , ndim_atl, ndex_atl )
-               CALL histwrite( numptr, "zosalatl", niter, sn_jk(:,:,2)  , ndim_atl, ndex_atl )
-               CALL histwrite( numptr, "zotempac", niter, tn_jk(:,:,3)  , ndim_pac, ndex_pac )
-               CALL histwrite( numptr, "zosalpac", niter, sn_jk(:,:,3)  , ndim_pac, ndex_pac )
-               CALL histwrite( numptr, "zotemind", niter, tn_jk(:,:,4)  , ndim_ind, ndex_ind )
-               CALL histwrite( numptr, "zosalind", niter, sn_jk(:,:,4)  , ndim_ind, ndex_ind )
-               CALL histwrite( numptr, "zotemipc", niter, tn_jk(:,:,5)  , ndim_ipc, ndex_ipc )
-               CALL histwrite( numptr, "zosalipc", niter, sn_jk(:,:,5)  , ndim_ipc, ndex_ipc )
-            END IF
-         ENDIF
-
-         ! overturning outputs:
-         CALL histwrite( numptr, "zomsfglo", niter, v_msf(:,:,1), ndim, ndex )
-         IF( ln_subbas .AND. ln_diaznl ) THEN
-            CALL histwrite( numptr, "zomsfatl", niter, v_msf(:,:,2) , ndim_atl_30, ndex_atl_30 )
-            CALL histwrite( numptr, "zomsfpac", niter, v_msf(:,:,3) , ndim_pac_30, ndex_pac_30 )
-            CALL histwrite( numptr, "zomsfind", niter, v_msf(:,:,4) , ndim_ind_30, ndex_ind_30 )
-            CALL histwrite( numptr, "zomsfipc", niter, v_msf(:,:,5) , ndim_ipc_30, ndex_ipc_30 )
-         ENDIF
-#if defined key_diaeiv
-         CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv(:,:,1), ndim  , ndex   )
-#endif
-
-         ! heat transport outputs:
-         IF( ln_subbas ) THEN
-            CALL histwrite( numptr, "sohtatl", niter, htr(:,2)  , ndim_h_atl_30, ndex_h_atl_30 )
-            CALL histwrite( numptr, "sohtpac", niter, htr(:,3)  , ndim_h_pac_30, ndex_h_pac_30 )
-            CALL histwrite( numptr, "sohtind", niter, htr(:,4)  , ndim_h_ind_30, ndex_h_ind_30 )
-            CALL histwrite( numptr, "sohtipc", niter, htr(:,5)  , ndim_h_ipc_30, ndex_h_ipc_30 )
-            CALL histwrite( numptr, "sostatl", niter, str(:,2)  , ndim_h_atl_30, ndex_h_atl_30 )
-            CALL histwrite( numptr, "sostpac", niter, str(:,3)  , ndim_h_pac_30, ndex_h_pac_30 )
-            CALL histwrite( numptr, "sostind", niter, str(:,4)  , ndim_h_ind_30, ndex_h_ind_30 )
-            CALL histwrite( numptr, "sostipc", niter, str(:,5)  , ndim_h_ipc_30, ndex_h_ipc_30 )
-         ENDIF
-
-         CALL histwrite( numptr, "sophtadv", niter, htr_adv     , ndim_h, ndex_h )
-         CALL histwrite( numptr, "sophtldf", niter, htr_ldf     , ndim_h, ndex_h )
-         CALL histwrite( numptr, "sopstadv", niter, str_adv     , ndim_h, ndex_h )
-         CALL histwrite( numptr, "sopstldf", niter, str_ldf     , ndim_h, ndex_h )
-         IF( ln_ptrcomp ) THEN 
-            CALL histwrite( numptr, "sopstove", niter, str_ove(:) , ndim_h, ndex_h )
-            CALL histwrite( numptr, "sophtove", niter, htr_ove(:) , ndim_h, ndex_h )
-         ENDIF
-#if defined key_diaeiv
-         CALL histwrite( numptr, "sophteiv", niter, htr_eiv(:,1)  , ndim_h, ndex_h )
-         CALL histwrite( numptr, "sopsteiv", niter, str_eiv(:,1)  , ndim_h, ndex_h )
-#endif
-         !
-      ENDIF
-      !
-      CALL wrk_dealloc( jpj      , zphi , zfoo )
-      CALL wrk_dealloc( jpj , jpk, z_1 )
-      !
-  END SUBROUTINE dia_ptr_wri
+      !
+   END FUNCTION ptr_sjk
+
 
    !!======================================================================
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 5682)
@@ -46,4 +46,6 @@
    USE iom
    USE ioipsl
+   USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities     
+
 #if defined key_lim2
    USE limwri_2 
@@ -78,5 +80,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -125,4 +127,5 @@
       !!
       INTEGER                      ::   ji, jj, jk              ! dummy loop indices
+      INTEGER                      ::   jkbot                   !
       REAL(wp)                     ::   zztmp, zztmpx, zztmpy   ! 
       !!
@@ -142,85 +145,104 @@
       ENDIF
 
-      IF( lk_vvl ) THEN
-         z3d(:,:,:) = tsn(:,:,:,jp_tem) * fse3t_n(:,:,:)
-         CALL iom_put( "toce" , z3d                        )   ! heat content
+      IF( .NOT.lk_vvl ) THEN
+         CALL iom_put( "e3t" , fse3t_n(:,:,:) )
+         CALL iom_put( "e3u" , fse3u_n(:,:,:) )
+         CALL iom_put( "e3v" , fse3v_n(:,:,:) )
+         CALL iom_put( "e3w" , fse3w_n(:,:,:) )
+      ENDIF
+
+      CALL iom_put( "ssh" , sshn )                 ! sea surface height
+      if( iom_use('ssh2') )   CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height
+      
+      CALL iom_put( "toce", tsn(:,:,:,jp_tem) )    ! 3D temperature
+      CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature
+      IF ( iom_use("sbt") ) THEN
          DO jj = 1, jpj
             DO ji = 1, jpi
-               z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * fse3t_n(ji,jj,mikt(ji,jj))
-            END DO
-         END DO  
-         CALL iom_put( "sst"  , z2d(:,:)                 )   ! sea surface heat content      
+               jkbot = mbkt(ji,jj)
+               z2d(ji,jj) = tsn(ji,jj,jkbot,jp_tem)
+            END DO
+         END DO
+         CALL iom_put( "sbt", z2d )                ! bottom temperature
+      ENDIF
+      
+      CALL iom_put( "soce", tsn(:,:,:,jp_sal) )    ! 3D salinity
+      CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity
+      IF ( iom_use("sbs") ) THEN
          DO jj = 1, jpj
             DO ji = 1, jpi
-               z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem)**2 * fse3t_n(ji,jj,mikt(ji,jj))
-            END DO
-         END DO  
-         CALL iom_put( "sst2" , z2d(:,:)      )   ! sea surface content of squared temperature
-         z3d(:,:,:) = tsn(:,:,:,jp_sal) * fse3t_n(:,:,:)            
-         CALL iom_put( "soce" , z3d                        )   ! salinity content
+               jkbot = mbkt(ji,jj)
+               z2d(ji,jj) = tsn(ji,jj,jkbot,jp_sal)
+            END DO
+         END DO
+         CALL iom_put( "sbs", z2d )                ! bottom salinity
+      ENDIF
+
+      IF ( iom_use("taubot") ) THEN                ! bottom stress
+         z2d(:,:) = 0._wp
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zztmpx = (  bfrua(ji  ,jj) * un(ji  ,jj,mbku(ji  ,jj))  &
+                      &  + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj))  )      
+               zztmpy = (  bfrva(ji,  jj) * vn(ji,jj  ,mbkv(ji,jj  ))  &
+                      &  + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1))  ) 
+               z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1) 
+               !
+            ENDDO
+         ENDDO
+         CALL lbc_lnk( z2d, 'T', 1. )
+         CALL iom_put( "taubot", z2d )           
+      ENDIF
+         
+      CALL iom_put( "uoce", un(:,:,:)         )    ! 3D i-current
+      CALL iom_put(  "ssu", un(:,:,1)         )    ! surface i-current
+      IF ( iom_use("sbu") ) THEN
          DO jj = 1, jpj
             DO ji = 1, jpi
-               z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * fse3t_n(ji,jj,mikt(ji,jj))
-            END DO
-         END DO  
-         CALL iom_put( "sss"  , z2d(:,:)                 )   ! sea surface salinity content
+               jkbot = mbku(ji,jj)
+               z2d(ji,jj) = un(ji,jj,jkbot)
+            END DO
+         END DO
+         CALL iom_put( "sbu", z2d )                ! bottom i-current
+      ENDIF
+#if defined key_dynspg_ts
+      CALL iom_put(  "ubar", un_adv(:,:)      )    ! barotropic i-current
+#else
+      CALL iom_put(  "ubar", un_b(:,:)        )    ! barotropic i-current
+#endif
+      
+      CALL iom_put( "voce", vn(:,:,:)         )    ! 3D j-current
+      CALL iom_put(  "ssv", vn(:,:,1)         )    ! surface j-current
+      IF ( iom_use("sbv") ) THEN
          DO jj = 1, jpj
             DO ji = 1, jpi
-               z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal)**2 * fse3t_n(ji,jj,mikt(ji,jj))
-            END DO
-         END DO  
-         CALL iom_put( "sss2" , z2d(:,:)                 )   ! sea surface content of squared salinity
-      ELSE
-         CALL iom_put( "toce" , tsn(:,:,:,jp_tem)        )   ! temperature
-         IF ( iom_use("sst") ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem)
-               END DO
-            END DO
-            CALL iom_put( "sst"  , z2d(:,:)            ) ! sea surface temperature
-         ENDIF
-         IF ( iom_use("sst2") )   CALL iom_put( "sst2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface temperature
-         CALL iom_put( "soce" , tsn(:,:,:,jp_sal)          )   ! salinity
-         IF ( iom_use("sss") ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal)
-               END DO
-            END DO
-            CALL iom_put( "sss"  , z2d(:,:)            ) ! sea surface salinity
-         ENDIF
-         CALL iom_put( "sss2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface salinity
-      END IF
-      IF( lk_vvl .AND. (.NOT. ln_dynadv_vec) ) THEN
-         CALL iom_put( "uoce" , umask(:,:,:) * un(:,:,:) * fse3u_n(:,:,:) )    ! i-transport
-         CALL iom_put( "voce" , vmask(:,:,:) * vn(:,:,:) * fse3v_n(:,:,:) )    ! j-transport
-      ELSE
-         CALL iom_put( "uoce" , umask(:,:,:) * un(:,:,:)                  )    ! i-current
-         CALL iom_put( "voce" , vmask(:,:,:) * vn(:,:,:)                  )    ! j-current
-         IF ( iom_use("ssu") ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z2d(ji,jj) = un(ji,jj,miku(ji,jj))
-               END DO
-            END DO
-            CALL iom_put( "ssu"   , z2d                                    )    ! i-current
-         ENDIF
-         IF ( iom_use("ssv") ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z2d(ji,jj) = vn(ji,jj,mikv(ji,jj))
-               END DO
-            END DO
-            CALL iom_put( "ssv"   , z2d                                    )    ! j-current
-         ENDIF
-      ENDIF
-      CALL iom_put(    "avt"  , avt                        )    ! T vert. eddy diff. coef.
-      CALL iom_put(    "avm"  , avmu                       )    ! T vert. eddy visc. coef.
-      IF( lk_zdfddm ) THEN
-         CALL iom_put( "avs" , fsavs(:,:,:)                          )    ! S vert. eddy diff. coef.
-      ENDIF
-
-      IF ( iom_use("sstgrad2") .OR. iom_use("sstgrad2") ) THEN
+               jkbot = mbkv(ji,jj)
+               z2d(ji,jj) = vn(ji,jj,jkbot)
+            END DO
+         END DO
+         CALL iom_put( "sbv", z2d )                ! bottom j-current
+      ENDIF
+#if defined key_dynspg_ts
+      CALL iom_put(  "vbar", vn_adv(:,:)      )    ! barotropic j-current
+#else
+      CALL iom_put(  "vbar", vn_b(:,:)        )    ! barotropic j-current
+#endif
+
+      CALL iom_put( "woce", wn )                   ! vertical velocity
+      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value
+         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
+         z2d(:,:) = rau0 * e12t(:,:)
+         DO jk = 1, jpk
+            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
+         END DO
+         CALL iom_put( "w_masstr" , z3d )  
+         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
+      ENDIF
+
+      CALL iom_put( "avt" , avt                        )    ! T vert. eddy diff. coef.
+      CALL iom_put( "avm" , avmu                       )    ! T vert. eddy visc. coef.
+      CALL iom_put( "avs" , fsavs(:,:,:)               )    ! S vert. eddy diff. coef. (useful only with key_zdfddm)
+
+      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
          DO jj = 2, jpjm1                                    ! sst gradient
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -234,5 +256,4 @@
          CALL lbc_lnk( z2d, 'T', 1. )
          CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient
-         !CDIR NOVERRCHK<
          z2d(:,:) = SQRT( z2d(:,:) )
          CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient
@@ -243,11 +264,10 @@
          z2d(:,:)  = 0._wp 
          DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
+            DO jj = 1, jpj
+               DO ji = 1, jpi
                   z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
                END DO
             END DO
          END DO
-         CALL lbc_lnk( z2d, 'T', 1. )
          CALL iom_put( "heatc", (rau0 * rcp) * z2d )    ! vertically integrated heat content (J/m2)
       ENDIF
@@ -256,11 +276,10 @@
          z2d(:,:)  = 0._wp 
          DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
+            DO jj = 1, jpj
+               DO ji = 1, jpi
                   z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
                END DO
             END DO
          END DO
-         CALL lbc_lnk( z2d, 'T', 1. )
          CALL iom_put( "saltc", rau0 * z2d )   ! vertically integrated salt content (PSU*kg/m2)
       ENDIF
@@ -419,7 +438,5 @@
       zdt = rdt
       IF( nacc == 1 ) zdt = rdtmin
-      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
-      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
-      ENDIF
+      clop = "x"         ! no use of the mask value (require less cpu time and otherwise the model crashes)
 #if defined key_diainstant
       zsto = nwrite * zdt
@@ -621,5 +638,5 @@
          ENDIF
 
-         IF( .NOT. lk_cpl ) THEN
+         IF( .NOT. ln_cpl ) THEN
             CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp
                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
@@ -630,5 +647,5 @@
          ENDIF
 
-         IF( lk_cpl .AND. nn_ice <= 1 ) THEN
+         IF( ln_cpl .AND. nn_ice <= 1 ) THEN
             CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp
                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
@@ -653,5 +670,5 @@
 #endif
 
-         IF( lk_cpl .AND. nn_ice == 2 ) THEN
+         IF( ln_cpl .AND. nn_ice == 2 ) THEN
             CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice
                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
@@ -808,5 +825,5 @@
       ENDIF
 
-      IF( .NOT. lk_cpl ) THEN
+      IF( .NOT. ln_cpl ) THEN
          CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
          CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
@@ -814,5 +831,5 @@
          CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
       ENDIF
-      IF( lk_cpl .AND. nn_ice <= 1 ) THEN
+      IF( ln_cpl .AND. nn_ice <= 1 ) THEN
          CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
          CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
@@ -830,5 +847,5 @@
 #endif
 
-      IF( lk_cpl .AND. nn_ice == 2 ) THEN
+      IF( ln_cpl .AND. nn_ice == 2 ) THEN
          CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature
          CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90	(revision 5682)
@@ -72,4 +72,5 @@
       !!----------------------------------------------------------------------
       INTEGER ::   jc            ! dummy loop indices
+      INTEGER :: isrow           ! local index
       !!----------------------------------------------------------------------
       
@@ -91,7 +92,13 @@
          CASE ( 1 )                                  ! ORCA_R1 configuration
             !                                        ! =======================
+            ! This dirty section will be suppressed by simplification process:
+            ! all this will come back in input files
+            ! Currently these hard-wired indices relate to configuration with
+            ! extend grid (jpjglo=332)
+            isrow = 332 - jpjglo
+            !
             ncsnr(1)   = 1    ; ncstt(1)   = 0           ! Caspian Sea
-            ncsi1(1)   = 332  ; ncsj1(1)   = 203
-            ncsi2(1)   = 344  ; ncsj2(1)   = 235
+            ncsi1(1)   = 332  ; ncsj1(1)   = 243 - isrow
+            ncsi2(1)   = 344  ; ncsj2(1)   = 275 - isrow
             ncsir(1,1) = 1    ; ncsjr(1,1) = 1
             !                                        
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 5682)
@@ -73,4 +73,9 @@
       !!----------------------------------------------------------------------
       !
+      ! max number of seconds between each restart
+      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
+         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
+            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
+      ENDIF
       ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0
       IF( MOD( rday     , rdttra(1) ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
@@ -238,9 +243,4 @@
                nday_year = 1
                nsec_year = ndt05
-               IF( nsec1jan000 >= 2 * (2**30 - nsecd * nyear_len(1) / 2 ) ) THEN   ! test integer 4 max value
-                  CALL ctl_stop( 'The number of seconds between Jan. 1st 00h of nit000 year and Jan. 1st 00h ',   &
-                     &           'of the current year is exceeding the INTEGER 4 max VALUE: 2^31-1 -> 68.09 years in seconds', &
-                     & 'You must do a restart at higher frequency (or remove this STOP and recompile everything in I8)' )
-               ENDIF
                nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
                IF( nleapy == 1 )   CALL day_mth
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 5682)
@@ -162,8 +162,8 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphit, gphiu   !: latitude  of t-, u-, v- and f-points (degre)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphiv, gphif   !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1t, e2t       !: horizontal scale factors at t-point (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1u, e2u       !: horizontal scale factors at u-point (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1v, e2v       !: horizontal scale factors at v-point (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1f, e2f       !: horizontal scale factors at f-point (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1t, e2t, r1_e1t, r1_e2t   !: horizontal scale factors and inverse at t-point (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1u, e2u, r1_e1u, r1_e2u   !: horizontal scale factors and inverse at u-point (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1v, e2v, r1_e1v, r1_e2v   !: horizontal scale factors and inverse at v-point (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1f, e2f, r1_e1f, r1_e2f   !: horizontal scale factors and inverse at f-point (m)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1e2t          !: surface at t-point (m2)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ff             !: coriolis factor (2.*omega*sin(yphi) ) (s-1)
@@ -262,4 +262,5 @@
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
@@ -332,5 +333,5 @@
    INTEGER FUNCTION dom_oce_alloc()
       !!----------------------------------------------------------------------
-      INTEGER, DIMENSION(11) :: ierr
+      INTEGER, DIMENSION(12) :: ierr
       !!----------------------------------------------------------------------
       ierr(:) = 0
@@ -345,8 +346,9 @@
          &      tpol(jpiglo)  , fpol(jpiglo)                               , STAT=ierr(2) )
          !
-      ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) ,                      & 
-         &      glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) ,                      &  
-         &      glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , e1e2t(jpi,jpj) ,     &  
-         &      glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , ff   (jpi,jpj) , STAT=ierr(3) )     
+      ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,   & 
+         &      glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,   &  
+         &      glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,   &  
+         &      glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,   &
+         &      e1e2t(jpi,jpj) , ff   (jpi,jpj) , STAT=ierr(3) )     
          !
       ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) ,                         &
@@ -400,6 +402,8 @@
          &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(11) )
 
+      ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(12) )
+
 #if defined key_noslip_accurate
-      ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(11) )
+      ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(12) )
 #endif
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 5682)
@@ -135,7 +135,8 @@
       !!----------------------------------------------------------------------
       USE ioipsl
-      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
+      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               &
+         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
          &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
-         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz, nn_euler
+         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler
       NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   &
          &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,                  &
@@ -169,5 +170,7 @@
          WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
          WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in
+         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir
          WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out
+         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
          WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
          WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
@@ -178,8 +181,13 @@
          WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
          WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
-         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
+         IF( ln_rst_list ) THEN
+            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist
+         ELSE
+            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
+         ENDIF
          WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
          WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
          WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
+         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
          WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
          WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
@@ -195,7 +203,8 @@
       ninist = nn_istate
       nstock = nn_stock
+      nstocklist = nn_stocklist
       nwrite = nn_write
       neuler = nn_euler
-      IF ( neuler == 1 .AND. .NOT.ln_rstart ) THEN
+      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
          WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
          CALL ctl_warn( ctmp1 )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 5682)
@@ -105,4 +105,6 @@
       REAL(wp) ::   zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg
       REAL(wp) ::   zphi1, zsin_alpha, zim05, zjm05
+      INTEGER  ::   isrow                ! index for ORCA1 starting row
+
       !!----------------------------------------------------------------------
       !
@@ -159,49 +161,50 @@
          IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration
             !                                             ! =====================
-
-            ii0 = 281   ;   ii1 = 282        ! Gibraltar Strait (e2u = 20 km)
-            ij0 = 200   ;   ij1 = 200   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3
+            ! This dirty section will be suppressed by simplification process: all this will come back in input files
+            ! Currently these hard-wired indices relate to configuration with
+            ! extend grid (jpjglo=332)
+            ! which had a grid-size of 362x292.
+            ! 
+            isrow = 332 - jpjglo
+            !
+            ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait (e2u = 20 km)
+            ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: Gibraltar : e2u reduced to 20 km'
 
-            ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait (e2u = 10 km)
-            ij0 = 208   ;   ij1 = 208   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
+            ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u = 10 km)
+            ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: Bhosporus : e2u reduced to 10 km'
 
-            ii0 =  44   ;   ii1 =  44        ! Lombok Strait (e1v = 13 km)
-            ij0 = 124   ;   ij1 = 125   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  13.e3
+            ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v = 13 km)
+            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  13.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: Lombok : e1v reduced to 10 km'
 
-            ii0 =  48   ;   ii1 =  48        ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]
-            ij0 = 124   ;   ij1 = 125   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  8.e3
+            ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]
+            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  8.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: Sumba : e1v reduced to 8 km'
 
-            ii0 =  53   ;   ii1 =  53        ! Ombai Strait (e1v = 13 km)
-            ij0 = 124   ;   ij1 = 125   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3
+            ii0 =  53           ;   ii1 =  53        ! Ombai Strait (e1v = 13 km)
+            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: Ombai : e1v reduced to 13 km'
 
-            ii0 =  56   ;   ii1 =  56        ! Timor Passage (e1v = 20 km)
-            ij0 = 124   ;   ij1 = 125   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3
+            ii0 =  56           ;   ii1 =  56        ! Timor Passage (e1v = 20 km)
+            ij0 = 164 - isrow   ;   ij1 = 145 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: Timor Passage : e1v reduced to 20 km'
 
-            ii0 =  55   ;   ii1 =  55        ! West Halmahera Strait (e1v = 30 km)
-            ij0 = 141   ;   ij1 = 142   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 30.e3
+            ii0 =  55           ;   ii1 =  55        ! West Halmahera Strait (e1v = 30 km)
+            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 30.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: W Halmahera : e1v reduced to 30 km'
 
-            ii0 =  58   ;   ii1 =  58        ! East Halmahera Strait (e1v = 50 km)
-            ij0 = 141   ;   ij1 = 142   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3
+            ii0 =  58           ;   ii1 =  58        ! East Halmahera Strait (e1v = 50 km)
+            ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r1: E Halmahera : e1v reduced to 50 km'
-
-            !
-
-            !
-            !
             !
             !
@@ -471,4 +474,12 @@
       re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)
       re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)
+      r1_e1t  (:,:) = 1._wp    / e1t(:,:)
+      r1_e1u  (:,:) = 1._wp    / e1u(:,:)
+      r1_e1v  (:,:) = 1._wp    / e1v(:,:)
+      r1_e1f  (:,:) = 1._wp    / e1f(:,:)
+      r1_e2t  (:,:) = 1._wp    / e2t(:,:)
+      r1_e2u  (:,:) = 1._wp    / e2u(:,:)
+      r1_e2v  (:,:) = 1._wp    / e2v(:,:)
+      r1_e2f  (:,:) = 1._wp    / e2f(:,:)
 
       ! Control printing : Grid informations (if not restart)
@@ -533,5 +544,6 @@
          IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only
             IF( .NOT. Agrif_Root() ) THEN
-              zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad)
+              zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m)   & 
+                    &           / (ra * rad)
             ENDIF
          ENDIF
@@ -616,23 +628,23 @@
       CALL iom_open( 'coordinates', inum )
       
-      CALL iom_get( inum, jpdom_data, 'glamt', glamt )
-      CALL iom_get( inum, jpdom_data, 'glamu', glamu )
-      CALL iom_get( inum, jpdom_data, 'glamv', glamv )
-      CALL iom_get( inum, jpdom_data, 'glamf', glamf )
-      
-      CALL iom_get( inum, jpdom_data, 'gphit', gphit )
-      CALL iom_get( inum, jpdom_data, 'gphiu', gphiu )
-      CALL iom_get( inum, jpdom_data, 'gphiv', gphiv )
-      CALL iom_get( inum, jpdom_data, 'gphif', gphif )
-      
-      CALL iom_get( inum, jpdom_data, 'e1t', e1t )
-      CALL iom_get( inum, jpdom_data, 'e1u', e1u )
-      CALL iom_get( inum, jpdom_data, 'e1v', e1v )
-      CALL iom_get( inum, jpdom_data, 'e1f', e1f )
-      
-      CALL iom_get( inum, jpdom_data, 'e2t', e2t )
-      CALL iom_get( inum, jpdom_data, 'e2u', e2u )
-      CALL iom_get( inum, jpdom_data, 'e2v', e2v )
-      CALL iom_get( inum, jpdom_data, 'e2f', e2f )
+      CALL iom_get( inum, jpdom_data, 'glamt', glamt, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamu', glamu, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamv', glamv, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamf', glamf, lrowattr=ln_use_jattr )
+      
+      CALL iom_get( inum, jpdom_data, 'gphit', gphit, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphiu', gphiu, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphiv', gphiv, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphif', gphif, lrowattr=ln_use_jattr )
+      
+      CALL iom_get( inum, jpdom_data, 'e1t', e1t, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1u', e1u, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1v', e1v, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1f', e1f, lrowattr=ln_use_jattr )
+      
+      CALL iom_get( inum, jpdom_data, 'e2t', e2t, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2u', e2u, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2v', e2v, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2f', e2f, lrowattr=ln_use_jattr )
       
       CALL iom_close( inum )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 5682)
@@ -134,4 +134,5 @@
       INTEGER  ::   ijf, ijl, ij0, ij1       !   -       -
       INTEGER  ::   ios
+      INTEGER  ::   isrow                    ! index for ORCA1 starting row
       INTEGER , POINTER, DIMENSION(:,:) ::  imsk
       REAL(wp), POINTER, DIMENSION(:,:) ::  zwf
@@ -281,4 +282,14 @@
       CALL lbc_lnk( fmask_i, 'F', 1._wp )
 
+      ! 3. Ocean/land mask at wu-, wv- and w points 
+      !----------------------------------------------
+      wmask (:,:,1) = tmask(:,:,1) ! ????????
+      wumask(:,:,1) = umask(:,:,1) ! ????????
+      wvmask(:,:,1) = vmask(:,:,1) ! ????????
+      DO jk=2,jpk
+         wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1)
+         wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1)   
+         wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1)
+      END DO
 
       ! 4. ocean/land mask for the elliptic equation
@@ -391,37 +402,44 @@
       IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN   ! ORCA R1 configuration
          !                                                 ! Increased lateral friction near of some straits
+         ! This dirty section will be suppressed by simplification process:
+         ! all this will come back in input files
+         ! Currently these hard-wired indices relate to configuration with
+         ! extend grid (jpjglo=332)
+         !
+         isrow = 332 - jpjglo
+         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : '
          IF(lwp) WRITE(numout,*) '      Gibraltar '
-         ii0 = 283   ;   ii1 = 284        ! Gibraltar Strait 
-         ij0 = 200   ;   ij1 = 200   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2._wp  
+         ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait 
+         ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
 
          IF(lwp) WRITE(numout,*) '      Bhosporus '
-         ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait 
-         ij0 = 208   ;   ij1 = 208   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2._wp  
+         ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait 
+         ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
 
          IF(lwp) WRITE(numout,*) '      Makassar (Top) '
-         ii0 =  48   ;   ii1 =  48        ! Makassar Strait (Top) 
-         ij0 = 149   ;   ij1 = 150   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  3._wp  
+         ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top) 
+         ij0 = 189 - isrow   ;   ij1 = 190 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
 
          IF(lwp) WRITE(numout,*) '      Lombok '
-         ii0 =  44   ;   ii1 =  44        ! Lombok Strait 
-         ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2._wp  
+         ii0 =  44           ;   ii1 =  44        ! Lombok Strait 
+         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
 
          IF(lwp) WRITE(numout,*) '      Ombai '
-         ii0 =  53   ;   ii1 =  53        ! Ombai Strait 
-         ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp  
+         ii0 =  53           ;   ii1 =  53        ! Ombai Strait 
+         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
 
          IF(lwp) WRITE(numout,*) '      Timor Passage '
-         ii0 =  56   ;   ii1 =  56        ! Timor Passage 
-         ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp  
+         ii0 =  56           ;   ii1 =  56        ! Timor Passage 
+         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
 
          IF(lwp) WRITE(numout,*) '      West Halmahera '
-         ii0 =  58   ;   ii1 =  58        ! West Halmahera Strait 
-         ij0 = 141   ;   ij1 = 142   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp  
+         ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait 
+         ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
 
          IF(lwp) WRITE(numout,*) '      East Halmahera '
-         ii0 =  55   ;   ii1 =  55        ! East Halmahera Strait 
-         ij0 = 141   ;   ij1 = 142   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp  
+         ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait 
+         ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
          !
       ENDIF
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 5682)
@@ -8,4 +8,5 @@
    !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl:
    !!                                          vvl option includes z_star and z_tilde coordinates
+   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability
    !!----------------------------------------------------------------------
    !!   'key_vvl'                              variable volume
@@ -125,4 +126,5 @@
       INTEGER ::   ji,jj,jk
       INTEGER ::   ii0, ii1, ij0, ij1
+      REAL(wp)::   zcoef
       !!----------------------------------------------------------------------
       IF( nn_timing == 1 )  CALL timing_start('dom_vvl_init')
@@ -164,4 +166,5 @@
       ! t- and w- points depth
       ! ----------------------
+      ! set the isf depth as it is in the initial step
       fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)
       fsdepw_n(:,:,1) = 0.0_wp
@@ -169,27 +172,19 @@
       fsdept_b(:,:,1) = 0.5_wp * fse3w_b(:,:,1)
       fsdepw_b(:,:,1) = 0.0_wp
-      DO jj = 1,jpj
-         DO ji = 1,jpi
-            DO jk = 2,mikt(ji,jj)-1
-               fsdept_n(ji,jj,jk) = gdept_0(ji,jj,jk)
-               fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
-               fsde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj)
-               fsdept_b(ji,jj,jk) = gdept_0(ji,jj,jk)
-               fsdepw_b(ji,jj,jk) = gdepw_0(ji,jj,jk)
-            END DO
-            IF (mikt(ji,jj) .GT. 1) THEN
-               jk = mikt(ji,jj)
-               fsdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_n(ji,jj,jk)
-               fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
-               fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk  ) - sshn   (ji,jj)
-               fsdept_b(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_b(ji,jj,jk)
-               fsdepw_b(ji,jj,jk) = gdepw_0(ji,jj,jk)
-            END IF
-            DO jk = mikt(ji,jj)+1, jpk
-               fsdept_n(ji,jj,jk) = fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk)
+
+      DO jk = 2, jpk
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+              !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+                                                     ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
+                                                     ! 0.5 where jk = mikt  
+               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
                fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1)
-               fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk  ) - sshn   (ji,jj)
-               fsdept_b(ji,jj,jk) = fsdept_b(ji,jj,jk-1) + fse3w_b(ji,jj,jk)
+               fsdept_n(ji,jj,jk) =      zcoef  * ( fsdepw_n(ji,jj,jk  ) + 0.5 * fse3w_n(ji,jj,jk))  &
+                   &                + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) +       fse3w_n(ji,jj,jk)) 
+               fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk) - sshn(ji,jj)
                fsdepw_b(ji,jj,jk) = fsdepw_b(ji,jj,jk-1) + fse3t_b(ji,jj,jk-1)
+               fsdept_b(ji,jj,jk) =      zcoef  * ( fsdepw_b(ji,jj,jk  ) + 0.5 * fse3w_b(ji,jj,jk))  &
+                   &                + (1-zcoef) * ( fsdept_b(ji,jj,jk-1) +       fse3w_b(ji,jj,jk)) 
             END DO
          END DO
@@ -588,11 +583,9 @@
       INTEGER, INTENT( in )               :: kt       ! time step
       !! * Local declarations
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_e3t_def
       INTEGER                             :: ji,jj,jk       ! dummy loop indices
+      REAL(wp)                            :: zcoef
       !!----------------------------------------------------------------------
 
       IF( nn_timing == 1 )  CALL timing_start('dom_vvl_sf_swp')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, z_e3t_def                )
       !
       IF( kt == nit000 )   THEN
@@ -638,27 +631,23 @@
       ! t- and w- points depth
       ! ----------------------
+      ! set the isf depth as it is in the initial step
       fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)
       fsdepw_n(:,:,1) = 0.0_wp
       fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:)
-      DO jj = 1,jpj
-         DO ji = 1,jpi
-            DO jk = 2,mikt(ji,jj)-1
-               fsdept_n(ji,jj,jk) = gdept_0(ji,jj,jk)
-               fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
-               fsde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj)
-            END DO
-            IF (mikt(ji,jj) .GT. 1) THEN
-               jk = mikt(ji,jj)
-               fsdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_n(ji,jj,jk)
-               fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
-               fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk  ) - sshn   (ji,jj)
-            END IF
-            DO jk = mikt(ji,jj)+1, jpk
-               fsdept_n(ji,jj,jk) = fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk)
+
+      DO jk = 2, jpk
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+              !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+                                                                 ! 1 for jk = mikt
+               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
                fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1)
-               fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk  ) - sshn   (ji,jj)
+               fsdept_n(ji,jj,jk) =      zcoef  * ( fsdepw_n(ji,jj,jk  ) + 0.5 * fse3w_n(ji,jj,jk))  &
+                   &                + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) +       fse3w_n(ji,jj,jk)) 
+               fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk) - sshn(ji,jj)
             END DO
          END DO
       END DO
+
       ! Local depth and Inverse of the local depth of the water column at u- and v- points
       ! ----------------------------------------------------------------------------------
@@ -679,14 +668,15 @@
       ! Write outputs
       ! =============
-      z_e3t_def(:,:,:) = ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2
-      CALL iom_put( "cellthc" , fse3t_n  (:,:,:) )
+      CALL iom_put(     "e3t" , fse3t_n  (:,:,:) )
+      CALL iom_put(     "e3u" , fse3u_n  (:,:,:) )
+      CALL iom_put(     "e3v" , fse3v_n  (:,:,:) )
+      CALL iom_put(     "e3w" , fse3w_n  (:,:,:) )
       CALL iom_put( "tpt_dep" , fsde3w_n (:,:,:) )
-      CALL iom_put( "e3tdef"  , z_e3t_def(:,:,:) )
+      IF( iom_use("e3tdef") )   &
+         CALL iom_put( "e3tdef"  , ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
 
       ! write restart file
       ! ==================
       IF( lrst_oce ) CALL dom_vvl_rst( kt, 'WRITE' )
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, z_e3t_def )
       !
       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_sf_swp')
@@ -1049,4 +1039,5 @@
       INTEGER ::   ji, jj, jk                                          ! dummy loop indices
       INTEGER ::   ij0, ij1, ii0, ii1                                  ! dummy loop indices
+      INTEGER ::   isrow                                               ! index for ORCA1 starting row
       !! acc
       !! Hmm with the time splitting these "fixes" seem to do more harm than good. Temporarily disabled for
@@ -1132,7 +1123,13 @@
       IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration
          !                                             ! =====================
-         !
-         ii0 = 281   ;   ii1 = 282        ! Gibraltar Strait (e2u was modified)
-         ij0 = 200   ;   ij1 = 200
+         ! This dirty section will be suppressed by simplification process:
+         ! all this will come back in input files
+         ! Currently these hard-wired indices relate to configuration with
+         ! extend grid (jpjglo=332)
+         ! which had a grid-size of 362x292.
+         isrow = 332 - jpjglo
+         !
+         ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait (e2u was modified)
+         ij0 = 241 - isrow   ;   ij1 = 241 - isrow
          DO jk = 1, jpkm1
             DO jj = mj0(ij0), mj1(ij1)
@@ -1154,6 +1151,6 @@
          END DO
          !
-         ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait (e2u was modified)
-         ij0 = 208   ;   ij1 = 208
+         ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u was modified)
+         ij0 = 248 - isrow   ;   ij1 = 248 - isrow
          DO jk = 1, jpkm1
             DO jj = mj0(ij0), mj1(ij1)
@@ -1175,6 +1172,6 @@
          END DO
          !
-         ii0 =  44   ;   ii1 =  44        ! Lombok Strait (e1v was modified)
-         ij0 = 124   ;   ij1 = 125
+         ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v was modified)
+         ij0 = 164 - isrow   ;   ij1 = 165 - isrow
          DO jk = 1, jpkm1
             DO jj = mj0(ij0), mj1(ij1)
@@ -1191,6 +1188,6 @@
          END DO
          !
-         ii0 =  48   ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on]
-         ij0 = 124   ;   ij1 = 125
+         ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on]
+         ij0 = 164 - isrow   ;   ij1 = 165 - isrow
          DO jk = 1, jpkm1
             DO jj = mj0(ij0), mj1(ij1)
@@ -1207,6 +1204,6 @@
          END DO
          !
-         ii0 =  53   ;   ii1 =  53        ! Ombai Strait (e1v was modified)
-         ij0 = 124   ;   ij1 = 125
+         ii0 =  53          ;   ii1 =  53        ! Ombai Strait (e1v was modified)
+         ij0 = 164 - isrow  ;   ij1 = 165  - isrow  
          DO jk = 1, jpkm1
             DO jj = mj0(ij0), mj1(ij1)
@@ -1223,6 +1220,6 @@
          END DO
          !
-         ii0 =  56   ;   ii1 =  56        ! Timor Passage (e1v was modified)
-         ij0 = 124   ;   ij1 = 125
+         ii0 =  56            ;   ii1 =  56        ! Timor Passage (e1v was modified)
+         ij0 = 164 - isrow    ;   ij1 = 165  - isrow  
          DO jk = 1, jpkm1
             DO jj = mj0(ij0), mj1(ij1)
@@ -1239,6 +1236,6 @@
          END DO
          !
-         ii0 =  55   ;   ii1 =  55        ! West Halmahera Strait (e1v was modified)
-         ij0 = 141   ;   ij1 = 142
+         ii0 =  55            ;   ii1 =  55        ! West Halmahera Strait (e1v was modified)
+         ij0 = 181 - isrow    ;   ij1 = 182 - isrow  
          DO jk = 1, jpkm1
             DO jj = mj0(ij0), mj1(ij1)
@@ -1255,6 +1252,6 @@
          END DO
          !
-         ii0 =  58   ;   ii1 =  58        ! East Halmahera Strait (e1v was modified)
-         ij0 = 141   ;   ij1 = 142
+         ii0 =  58            ;   ii1 =  58        ! East Halmahera Strait (e1v was modified)
+         ij0 = 181 - isrow    ;   ij1 = 182 - isrow  
          DO jk = 1, jpkm1
             DO jj = mj0(ij0), mj1(ij1)
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 5682)
@@ -215,4 +215,6 @@
          CALL iom_rstput( 0, 0, inum4, 'gdept_1d' , gdept_1d )  !    ! stretched system
          CALL iom_rstput( 0, 0, inum4, 'gdepw_1d' , gdepw_1d )
+         CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r4 )     
+         CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 )
       ENDIF
       
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 5682)
@@ -17,4 +17,5 @@
    !!            3.4  ! 2012-08  (J. Siddorn) added Siddorn and Furner stretching function
    !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  modify C1D case  
+   !!            3.6  ! 2014-11  (P. Mathiot and C. Harris) add ice shelf capabilitye  
    !!----------------------------------------------------------------------
 
@@ -35,5 +36,4 @@
    USE oce               ! ocean variables
    USE dom_oce           ! ocean domain
-   USE sbc_oce           ! surface variable (isf)
    USE closea            ! closed seas
    USE c1d               ! 1D vertical configuration
@@ -219,7 +219,13 @@
          &  ppsur == pp_to_be_computed           ) THEN
          !
+#if defined key_agrif
+         za1  = (  ppdzmin - pphmax / FLOAT(jpkdta-1)  )                                                   &
+            & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpkdta-1) * (  LOG( COSH( (jpkdta - ppkth) / ppacr) )&
+            &                                                      - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+#else
          za1  = (  ppdzmin - pphmax / FLOAT(jpkm1)  )                                                      &
             & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpk-1) * (  LOG( COSH( (jpk - ppkth) / ppacr) )      &
             &                                                   - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+#endif
          za0  = ppdzmin - za1 *              TANH( (1-ppkth) / ppacr )
          zsur =   - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
@@ -236,5 +242,9 @@
               WRITE(numout,*) '            Uniform grid with ',jpk-1,' layers'
               WRITE(numout,*) '            Total depth    :', zhmax
+#if defined key_agrif
+              WRITE(numout,*) '            Layer thickness:', zhmax/(jpkdta-1)
+#else
               WRITE(numout,*) '            Layer thickness:', zhmax/(jpk-1)
+#endif
          ELSE
             IF( ppa1 == 0._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN
@@ -260,6 +270,10 @@
       ! Reference z-coordinate (depth - scale factor at T- and W-points)
       ! ======================
-      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid       
+      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid 
+#if defined key_agrif
+         za1 = zhmax / FLOAT(jpkdta-1) 
+#else
          za1 = zhmax / FLOAT(jpk-1) 
+#endif
          DO jk = 1, jpk
             zw = FLOAT( jk )
@@ -298,15 +312,17 @@
       ENDIF
 
+      IF ( ln_isfcav ) THEN
 ! need to be like this to compute the pressure gradient with ISF. If not, level beneath the ISF are not aligned (sum(e3t) /= depth)
 ! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively
-      DO jk = 1, jpkm1
-         e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk) 
-      END DO
-      e3t_1d(jpk) = e3t_1d(jpk-1)   ! we don't care because this level is masked in NEMO
-
-      DO jk = 2, jpk
-         e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1) 
-      END DO
-      e3w_1d(1  ) = 2._wp * (gdept_1d(1) - gdepw_1d(1)) 
+         DO jk = 1, jpkm1
+            e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk) 
+         END DO
+         e3t_1d(jpk) = e3t_1d(jpk-1)   ! we don't care because this level is masked in NEMO
+
+         DO jk = 2, jpk
+            e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1) 
+         END DO
+         e3w_1d(1  ) = 2._wp * (gdept_1d(1) - gdepw_1d(1)) 
+      END IF
 
 !!gm BUG in s-coordinate this does not work!
@@ -471,26 +487,4 @@
          misfdep(:,:)=1
          !
-         ! (ISF) TODO build ice draft netcdf file for isomip and build the corresponding part of code
-         IF( cp_cfg == "isomip" ) THEN 
-	        ! 
-	        risfdep(:,:)=200.e0 
-	        misfdep(:,:)=1 
-	        ij0 = 1 ; ij1 = 40 
-	        DO jj = mj0(ij0), mj1(ij1) 
-	           risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp 
-                END DO 
-            WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp 
-	        ! 
-         ELSEIF ( cp_cfg == "isomip2" ) THEN
-         ! 
-            risfdep(:,:)=0.e0
-            misfdep(:,:)=1
-            ij0 = 1 ; ij1 = 40
-            DO jj = mj0(ij0), mj1(ij1)
-               risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp
-            END DO
-            WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp
-         END IF
-         !
          DEALLOCATE( idta, zdta )
          !
@@ -534,7 +528,11 @@
          IF( ln_zps .OR. ln_sco )   THEN              ! zps or sco : read meter bathymetry
             CALL iom_open ( 'bathy_meter.nc', inum ) 
-            CALL iom_get  ( inum, jpdom_data, 'Bathymetry', bathy )
+            IF ( ln_isfcav ) THEN
+               CALL iom_get  ( inum, jpdom_data, 'Bathymetry_isf', bathy, lrowattr=.false. )
+            ELSE
+               CALL iom_get  ( inum, jpdom_data, 'Bathymetry'    , bathy, lrowattr=ln_use_jattr  )
+            END IF
             CALL iom_close( inum )
-            !  
+            !                                                
             risfdep(:,:)=0._wp         
             misfdep(:,:)=1             
@@ -584,7 +582,9 @@
       IF ( .not. ln_sco ) THEN                                !==  set a minimum depth  ==!
          ! patch to avoid case bathy = ice shelf draft and bathy between 0 and zhmin
-         WHERE (bathy == risfdep)
-            bathy   = 0.0_wp ; risfdep = 0.0_wp
-         END WHERE
+         IF ( ln_isfcav ) THEN
+            WHERE (bathy == risfdep)
+               bathy   = 0.0_wp ; risfdep = 0.0_wp
+            END WHERE
+         END IF
          ! end patch
          IF( rn_hmin < 0._wp ) THEN    ;   ik = - INT( rn_hmin )                                      ! from a nb of level
@@ -961,4 +961,312 @@
       !!----------------------------------------------------------------------
       !!
+      INTEGER  ::   ji, jj, jk       ! dummy loop indices
+      INTEGER  ::   ik, it, ikb, ikt ! temporary integers
+      LOGICAL  ::   ll_print         ! Allow  control print for debugging
+      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
+      REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t
+      REAL(wp) ::   zmax             ! Maximum depth
+      REAL(wp) ::   zdiff            ! temporary scalar
+      REAL(wp) ::   zrefdep          ! temporary scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zprt
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_zps')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zprt )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_zps : z-coordinate with partial steps'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~ '
+      IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used'
+
+      ll_print = .FALSE.                   ! Local variable for debugging
+      
+      IF(lwp .AND. ll_print) THEN          ! control print of the ocean depth
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_zgr_zps:  bathy (in hundred of meters)'
+         CALL prihre( bathy, jpi, jpj, 1,jpi, 1, 1, jpj, 1, 1.e-2, numout )
+      ENDIF
+
+
+      ! bathymetry in level (from bathy_meter)
+      ! ===================
+      zmax = gdepw_1d(jpk) + e3t_1d(jpk)        ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
+      bathy(:,:) = MIN( zmax ,  bathy(:,:) )    ! bounded value of bathy (min already set at the end of zgr_bat)
+      WHERE( bathy(:,:) == 0._wp )   ;   mbathy(:,:) = 0       ! land  : set mbathy to 0
+      ELSE WHERE                     ;   mbathy(:,:) = jpkm1   ! ocean : initialize mbathy to the max ocean level
+      END WHERE
+
+      ! Compute mbathy for ocean points (i.e. the number of ocean levels)
+      ! find the number of ocean levels such that the last level thickness
+      ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where
+      ! e3t_1d is the reference level thickness
+      DO jk = jpkm1, 1, -1
+         zdepth = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+         WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth )   mbathy(:,:) = jk-1
+      END DO
+
+      IF ( ln_isfcav ) CALL zgr_isf
+
+      ! Scale factors and depth at T- and W-points
+      DO jk = 1, jpk                        ! intitialization to the reference z-coordinate
+         gdept_0(:,:,jk) = gdept_1d(jk)
+         gdepw_0(:,:,jk) = gdepw_1d(jk)
+         e3t_0  (:,:,jk) = e3t_1d  (jk)
+         e3w_0  (:,:,jk) = e3w_1d  (jk)
+      END DO
+      ! 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = mbathy(ji,jj)
+            IF( ik > 0 ) THEN               ! ocean point only
+               ! max ocean level case
+               IF( ik == jpkm1 ) THEN
+                  zdepwp = bathy(ji,jj)
+                  ze3tp  = bathy(ji,jj) - gdepw_1d(ik)
+                  ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) )
+                  e3t_0(ji,jj,ik  ) = ze3tp
+                  e3t_0(ji,jj,ik+1) = ze3tp
+                  e3w_0(ji,jj,ik  ) = ze3wp
+                  e3w_0(ji,jj,ik+1) = ze3tp
+                  gdepw_0(ji,jj,ik+1) = zdepwp
+                  gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp
+                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
+                  !
+               ELSE                         ! standard case
+                  IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj)
+                  ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
+                  ENDIF
+!gm Bug?  check the gdepw_1d
+                  !       ... on ik
+                  gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   &
+                     &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   &
+                     &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) ))
+                  e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   & 
+                     &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik) ) 
+                  e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   &
+                     &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
+                  !       ... on ik+1
+                  e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+                  e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik)
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      it = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = mbathy(ji,jj)
+            IF( ik > 0 ) THEN               ! ocean point only
+               e3tp (ji,jj) = e3t_0(ji,jj,ik)
+               e3wp (ji,jj) = e3w_0(ji,jj,ik)
+               ! test
+               zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  )
+               IF( zdiff <= 0._wp .AND. lwp ) THEN 
+                  it = it + 1
+                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj
+                  WRITE(numout,*) ' bathy = ', bathy(ji,jj)
+                  WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff
+                  WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  )
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      IF ( ln_isfcav ) THEN
+      ! (ISF) Definition of e3t, u, v, w for ISF case
+         DO jj = 1, jpj 
+            DO ji = 1, jpi 
+               ik = misfdep(ji,jj) 
+               IF( ik > 1 ) THEN               ! ice shelf point only 
+                  IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik) 
+                  gdepw_0(ji,jj,ik) = risfdep(ji,jj) 
+!gm Bug?  check the gdepw_0 
+               !       ... on ik 
+                  gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   & 
+                     &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   & 
+                     &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      ) 
+                  e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) 
+                  e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik)
+
+                  IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column) 
+                     e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik) 
+                  ENDIF 
+               !       ... on ik / ik-1 
+                  e3w_0  (ji,jj,ik  ) = 2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik)) 
+                  e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1)
+! The next line isn't required and doesn't affect results - included for consistency with bathymetry code 
+                  gdept_0(ji,jj,ik-1) = gdept_1d(ik-1)
+               ENDIF 
+            END DO 
+         END DO 
+      ! 
+         it = 0 
+         DO jj = 1, jpj 
+            DO ji = 1, jpi 
+               ik = misfdep(ji,jj) 
+               IF( ik > 1 ) THEN               ! ice shelf point only 
+                  e3tp (ji,jj) = e3t_0(ji,jj,ik  ) 
+                  e3wp (ji,jj) = e3w_0(ji,jj,ik+1 ) 
+               ! test 
+                  zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  ) 
+                  IF( zdiff <= 0. .AND. lwp ) THEN  
+                     it = it + 1 
+                     WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
+                     WRITE(numout,*) ' risfdep = ', risfdep(ji,jj) 
+                     WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 
+                     WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj) 
+                  ENDIF 
+               ENDIF 
+            END DO 
+         END DO 
+      END IF
+      ! END (ISF)
+
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3u_0 (:,:,jk) = e3t_1d(jk)
+         e3v_0 (:,:,jk) = e3t_1d(jk)
+         e3uw_0(:,:,jk) = e3w_1d(jk)
+         e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
+               e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
+               e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) )
+               e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) )
+            END DO
+         END DO
+      END DO
+      IF ( ln_isfcav ) THEN
+      ! (ISF) define e3uw (adapted for 2 cells in the water column)
+         DO jj = 2, jpjm1 
+            DO ji = 2, fs_jpim1   ! vector opt. 
+               ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj))
+               ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj))
+               IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) &
+                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) )
+               ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1))
+               ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1))
+               IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) &
+                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) )
+            END DO
+         END DO
+      END IF
+
+      CALL lbc_lnk( e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_0, 'U', 1._wp )   ! lateral boundary conditions
+      CALL lbc_lnk( e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_0, 'V', 1._wp )
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk)
+         WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+      
+      ! Scale factor at F-point
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( e3f_0, 'F', 1._wp )       ! Lateral boundary conditions
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+!!gm  bug ? :  must be a do loop with mj0,mj1
+      ! 
+      e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2
+      e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:) 
+      e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:) 
+      e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:) 
+      e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:) 
+
+      ! Control of the sign
+      IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' )
+      IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' )
+      IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' )
+      IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' )
+     
+      ! Compute gdep3w_0 (vertical sum of e3w)
+      IF ( ln_isfcav ) THEN ! if cavity
+         WHERE (misfdep == 0) misfdep = 1
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               gdep3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1)
+               DO jk = 2, misfdep(ji,jj)
+                  gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
+               END DO
+               IF (misfdep(ji,jj) .GE. 2) gdep3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj))
+               DO jk = misfdep(ji,jj) + 1, jpk
+                  gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
+               END DO
+            END DO
+         END DO
+      ELSE ! no cavity
+         gdep3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1)
+         DO jk = 2, jpk
+            gdep3w_0(:,:,jk) = gdep3w_0(:,:,jk-1) + e3w_0(:,:,jk)
+         END DO
+      END IF
+      !                                               ! ================= !
+      IF(lwp .AND. ll_print) THEN                     !   Control print   !
+         !                                            ! ================= !
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               ik = MAX( mbathy(ji,jj), 1 )
+               zprt(ji,jj,1) = e3t_0   (ji,jj,ik)
+               zprt(ji,jj,2) = e3w_0   (ji,jj,ik)
+               zprt(ji,jj,3) = e3u_0   (ji,jj,ik)
+               zprt(ji,jj,4) = e3v_0   (ji,jj,ik)
+               zprt(ji,jj,5) = e3f_0   (ji,jj,ik)
+               zprt(ji,jj,6) = gdep3w_0(ji,jj,ik)
+            END DO
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3t(mbathy)'      ;   CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3w(mbathy)'      ;   CALL prihre(zprt(:,:,2),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3u(mbathy)'      ;   CALL prihre(zprt(:,:,3),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3v(mbathy)'      ;   CALL prihre(zprt(:,:,4),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3f(mbathy)'      ;   CALL prihre(zprt(:,:,5),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr gdep3w(mbathy)'   ;   CALL prihre(zprt(:,:,6),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF  
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zprt )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_zps')
+      !
+   END SUBROUTINE zgr_zps
+
+   SUBROUTINE zgr_isf
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_isf  ***
+      !!   
+      !! ** Purpose :   check the bathymetry in levels
+      !!   
+      !! ** Method  :   THe water column have to contained at least 2 cells
+      !!                Bathymetry and isfdraft are modified (dig/close) to respect
+      !!                this criterion.
+      !!                 
+      !!   
+      !! ** Action  : - test compatibility between isfdraft and bathy 
+      !!              - bathy and isfdraft are modified
+      !!----------------------------------------------------------------------
+      !!   
       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
       INTEGER  ::   ik, it           ! temporary integers
@@ -971,45 +1279,15 @@
       REAL(wp) ::   zdiff            ! temporary scalar
       REAL(wp) ::   zrefdep          ! temporary scalar
-      REAL(wp) ::   zbathydiff, zrisfdepdiff 
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zrisfdep, zbathy, zmask   ! 3D workspace (ISH)
-      INTEGER , POINTER, DIMENSION(:,:)   ::   zmbathy, zmisfdep   ! 3D workspace (ISH)
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zprt
+      REAL(wp) ::   zbathydiff, zrisfdepdiff  ! isf temporary scalar
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zrisfdep, zbathy, zmask   ! 2D workspace (ISH)
+      INTEGER , POINTER, DIMENSION(:,:)   ::   zmbathy, zmisfdep         ! 2D workspace (ISH)
       !!---------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('zgr_zps')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, zprt )
+      IF( nn_timing == 1 )  CALL timing_start('zgr_isf')
+      !
       CALL wrk_alloc( jpi, jpj, zbathy, zmask, zrisfdep)
-      CALL wrk_alloc( jpi, jpj, zmbathy, zmisfdep)
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '    zgr_zps : z-coordinate with partial steps'
-      IF(lwp) WRITE(numout,*) '    ~~~~~~~ '
-      IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used'
-
-      ll_print = .FALSE.                   ! Local variable for debugging
-      
-      IF(lwp .AND. ll_print) THEN          ! control print of the ocean depth
-         WRITE(numout,*)
-         WRITE(numout,*) 'dom_zgr_zps:  bathy (in hundred of meters)'
-         CALL prihre( bathy, jpi, jpj, 1,jpi, 1, 1, jpj, 1, 1.e-2, numout )
-      ENDIF
-
-      ! bathymetry in level (from bathy_meter)
-      ! ===================
-      zmax = gdepw_1d(jpk) + e3t_1d(jpk)        ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
-      bathy(:,:) = MIN( zmax ,  bathy(:,:) )    ! bounded value of bathy (min already set at the end of zgr_bat)
-      WHERE( bathy(:,:) == 0._wp )   ;   mbathy(:,:) = 0       ! land  : set mbathy to 0
-      ELSE WHERE                     ;   mbathy(:,:) = jpkm1   ! ocean : initialize mbathy to the max ocean level
-      END WHERE
-
-      ! Compute mbathy for ocean points (i.e. the number of ocean levels)
-      ! find the number of ocean levels such that the last level thickness
-      ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where
-      ! e3t_1d is the reference level thickness
-      DO jk = jpkm1, 1, -1
-         zdepth = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
-         WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth )   mbathy(:,:) = jk-1
-      END DO
+      CALL wrk_alloc( jpi, jpj, zmisfdep, zmbathy )
+
+
       ! (ISF) compute misfdep
       WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) .NE. 0) ;   misfdep(:,:) = 1   ! open water : set misfdep to 1  
@@ -1055,10 +1333,10 @@
             misfdep(jpi,:) = misfdep(  2  ,:) 
          ENDIF
- 
+
          IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN
             mbathy( 1 ,:) = mbathy(jpim1,:)             ! local domain is cyclic east-west
             mbathy(jpi,:) = mbathy(  2  ,:)
          ENDIF
- 
+
          ! split last cell if possible (only where water column is 2 cell or less)
          DO jk = jpkm1, 1, -1
@@ -1078,5 +1356,5 @@
             END WHERE
          END DO
- 
+
  
  ! Case where bathy and risfdep compatible but not the level variable mbathy/misfdep because of partial cell condition
@@ -1254,5 +1532,5 @@
  
  ! remove single point "bay" on isf coast line in the ice shelf draft'
-         DO jk = 1, jpk
+         DO jk = 2, jpk
             WHERE (misfdep==0) misfdep=jpk
             zmask=0
@@ -1359,5 +1637,5 @@
                IF( zmbathy(ji,jj) .LT. misfdep(ji  ,jj+1) ) ibtestjp1 = 0
                ibtest=MAX(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1)
-               IF( ibtest == 0 ) THEN
+               IF( ibtest == 0 .AND. misfdep(ji,jj) .GE. 2) THEN
                   mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp ;
                END IF
@@ -1475,238 +1753,10 @@
       ENDIF 
 
-      ! Scale factors and depth at T- and W-points
-      DO jk = 1, jpk                        ! intitialization to the reference z-coordinate
-         gdept_0(:,:,jk) = gdept_1d(jk)
-         gdepw_0(:,:,jk) = gdepw_1d(jk)
-         e3t_0  (:,:,jk) = e3t_1d  (jk)
-         e3w_0  (:,:,jk) = e3w_1d  (jk)
-      END DO
-      ! 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ik = mbathy(ji,jj)
-            IF( ik > 0 ) THEN               ! ocean point only
-               ! max ocean level case
-               IF( ik == jpkm1 ) THEN
-                  zdepwp = bathy(ji,jj)
-                  ze3tp  = bathy(ji,jj) - gdepw_1d(ik)
-                  ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) )
-                  e3t_0(ji,jj,ik  ) = ze3tp
-                  e3t_0(ji,jj,ik+1) = ze3tp
-                  e3w_0(ji,jj,ik  ) = ze3wp
-                  e3w_0(ji,jj,ik+1) = ze3tp
-                  gdepw_0(ji,jj,ik+1) = zdepwp
-                  gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp
-                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
-                  !
-               ELSE                         ! standard case
-                  IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj)
-                  ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
-                  ENDIF
-!gm Bug?  check the gdepw_1d
-                  !       ... on ik
-                  gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   &
-                     &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   &
-                     &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) ))
-                  e3t_0(ji,jj,ik) = e3t_1d (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   & 
-                     &                          / ( gdepw_1d(      ik+1) - gdepw_1d(ik) ) 
-                  e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   &
-                     &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
-                  !       ... on ik+1
-                  e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
-                  e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
-                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik)
-               ENDIF
-            ENDIF
-         END DO
-      END DO
-      !
-      it = 0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ik = mbathy(ji,jj)
-            IF( ik > 0 ) THEN               ! ocean point only
-               e3tp (ji,jj) = e3t_0(ji,jj,ik)
-               e3wp (ji,jj) = e3w_0(ji,jj,ik)
-               ! test
-               zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  )
-               IF( zdiff <= 0._wp .AND. lwp ) THEN 
-                  it = it + 1
-                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj
-                  WRITE(numout,*) ' bathy = ', bathy(ji,jj)
-                  WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff
-                  WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  )
-               ENDIF
-            ENDIF
-         END DO
-      END DO
-      !
-      ! (ISF) Definition of e3t, u, v, w for ISF case
-      DO jj = 1, jpj 
-         DO ji = 1, jpi 
-            ik = misfdep(ji,jj) 
-            IF( ik > 1 ) THEN               ! ice shelf point only 
-               IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik) 
-               gdepw_0(ji,jj,ik) = risfdep(ji,jj) 
-!gm Bug?  check the gdepw_0 
-               !       ... on ik 
-               gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   & 
-                  &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   & 
-                  &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      ) 
-               e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) 
-               e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik)
-
-               IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column) 
-                  e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik) 
-                ENDIF 
-               !       ... on ik / ik-1 
-               e3w_0  (ji,jj,ik  ) = 2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik)) 
-               e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1)
-! The next line isn't required and doesn't affect results - included for consistency with bathymetry code 
-               gdept_0(ji,jj,ik-1) = gdept_1d(ik-1)
-            ENDIF 
-         END DO 
-      END DO 
-      ! 
-      it = 0 
-      DO jj = 1, jpj 
-         DO ji = 1, jpi 
-            ik = misfdep(ji,jj) 
-            IF( ik > 1 ) THEN               ! ice shelf point only 
-               e3tp (ji,jj) = e3t_0(ji,jj,ik  ) 
-               e3wp (ji,jj) = e3w_0(ji,jj,ik+1 ) 
-               ! test 
-               zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  ) 
-               IF( zdiff <= 0. .AND. lwp ) THEN  
-                  it = it + 1 
-                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
-                  WRITE(numout,*) ' risfdep = ', risfdep(ji,jj) 
-                  WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 
-                  WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj) 
-               ENDIF 
-            ENDIF 
-         END DO 
-      END DO 
-      ! END (ISF)
-
-      ! Scale factors and depth at U-, V-, UW and VW-points
-      DO jk = 1, jpk                        ! initialisation to z-scale factors
-         e3u_0 (:,:,jk) = e3t_1d(jk)
-         e3v_0 (:,:,jk) = e3t_1d(jk)
-         e3uw_0(:,:,jk) = e3w_1d(jk)
-         e3vw_0(:,:,jk) = e3w_1d(jk)
-      END DO
-      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
-               e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
-               e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) )
-               e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) )
-            END DO
-         END DO
-      END DO
-      ! (ISF) define e3uw
-      DO jk = 2,jpk                          
-         DO jj = 1, jpjm1 
-            DO ji = 1, fs_jpim1   ! vector opt. 
-               e3uw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji+1,jj  ,jk) ) &
-                 &   - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji+1,jj  ,jk-1) )
-               e3vw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji  ,jj+1,jk) ) &
-                 &   - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji  ,jj+1,jk-1) )
-            END DO 
-         END DO 
-      END DO
-      !End (ISF)
-      
-      CALL lbc_lnk( e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_0, 'U', 1._wp )   ! lateral boundary conditions
-      CALL lbc_lnk( e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_0, 'V', 1._wp )
-      !
-      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
-         WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk)
-         WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk)
-         WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk)
-         WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk)
-      END DO
-      
-      ! Scale factor at F-point
-      DO jk = 1, jpk                        ! initialisation to z-scale factors
-         e3f_0(:,:,jk) = e3t_1d(jk)
-      END DO
-      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( e3f_0, 'F', 1._wp )       ! Lateral boundary conditions
-      !
-      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
-         WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk)
-      END DO
-!!gm  bug ? :  must be a do loop with mj0,mj1
-      ! 
-      e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2
-      e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:) 
-      e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:) 
-      e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:) 
-      e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:) 
-
-      ! Control of the sign
-      IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' )
-      IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' )
-      IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' )
-      IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' )
-     
-      ! Compute gdep3w_0 (vertical sum of e3w)
-      WHERE (misfdep == 0) misfdep = 1
-      DO jj = 1,jpj
-         DO ji = 1,jpi
-            gdep3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1)
-            DO jk = 2, misfdep(ji,jj)
-               gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
-            END DO
-            IF (misfdep(ji,jj) .GE. 2) gdep3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj))
-            DO jk = misfdep(ji,jj) + 1, jpk
-               gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
-            END DO
-        END DO
-      END DO
-      !                                               ! ================= !
-      IF(lwp .AND. ll_print) THEN                     !   Control print   !
-         !                                            ! ================= !
-         DO jj = 1,jpj
-            DO ji = 1, jpi
-               ik = MAX( mbathy(ji,jj), 1 )
-               zprt(ji,jj,1) = e3t_0   (ji,jj,ik)
-               zprt(ji,jj,2) = e3w_0   (ji,jj,ik)
-               zprt(ji,jj,3) = e3u_0   (ji,jj,ik)
-               zprt(ji,jj,4) = e3v_0   (ji,jj,ik)
-               zprt(ji,jj,5) = e3f_0   (ji,jj,ik)
-               zprt(ji,jj,6) = gdep3w_0(ji,jj,ik)
-            END DO
-         END DO
-         WRITE(numout,*)
-         WRITE(numout,*) 'domzgr e3t(mbathy)'      ;   CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'domzgr e3w(mbathy)'      ;   CALL prihre(zprt(:,:,2),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'domzgr e3u(mbathy)'      ;   CALL prihre(zprt(:,:,3),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'domzgr e3v(mbathy)'      ;   CALL prihre(zprt(:,:,4),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'domzgr e3f(mbathy)'      ;   CALL prihre(zprt(:,:,5),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-         WRITE(numout,*)
-         WRITE(numout,*) 'domzgr gdep3w(mbathy)'   ;   CALL prihre(zprt(:,:,6),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
-      ENDIF  
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, zprt )
       CALL wrk_dealloc( jpi, jpj, zmask, zbathy, zrisfdep )
       CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('zgr_zps')
-      !
-   END SUBROUTINE zgr_zps
+
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_isf')
+      
+   END SUBROUTINE
 
    SUBROUTINE zgr_sco
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 5682)
@@ -39,5 +39,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: dtatem.F90 2392 2010-11-15 21:20:05Z gm $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 5682)
@@ -69,7 +69,6 @@
       !! ** Purpose :   Initialization of the dynamics and tracer fields.
       !!----------------------------------------------------------------------
-      ! - ML - needed for initialization of e3t_b
-      INTEGER  ::  ji,jj,jk     ! dummy loop indices
-      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::  zuvd    ! U & V data workspace
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace
       !!----------------------------------------------------------------------
       !
@@ -84,10 +83,8 @@
       IF( lk_c1d ) CALL dta_uvd_init          ! Initialization of U & V input data
 
-      rhd  (:,:,:  ) = 0._wp
-      rhop (:,:,:  ) = 0._wp
-      rn2  (:,:,:  ) = 0._wp
-      tsa  (:,:,:,:) = 0._wp   
-      rab_b(:,:,:,:) = 0._wp
-      rab_n(:,:,:,:) = 0._wp
+      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk
+      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk
+      tsa  (:,:,:,:) = 0._wp                                   ! set one for all to 0 at level jpk
+      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk
 
       IF( ln_rstart ) THEN                    ! Restart from a file
@@ -113,9 +110,4 @@
          ELSEIF( cp_cfg == 'gyre' ) THEN         
             CALL istate_gyre                     ! GYRE  configuration : start from pre-defined T-S fields
-        ELSEIF( cp_cfg == 'isomip' .OR. cp_cfg == 'isomip2') THEN
-            IF(lwp) WRITE(numout,*) 'Initialization of T+S for ISOMIP domain' 
-            tsn(:,:,:,jp_tem)=-1.9*tmask(:,:,:)          ! ISOMIP configuration : start from constant T+S fields 
-            tsn(:,:,:,jp_sal)=34.4*tmask(:,:,:)
-            tsb(:,:,:,:)=tsn(:,:,:,:)  
          ELSE                                    ! Initial T-S, U-V fields read in files
             IF ( ln_tsd_init ) THEN              ! read 3D T and S data at nit000
@@ -137,7 +129,11 @@
          CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) )        ! before potential and in situ densities
 #if ! defined key_c1d
-         IF( ln_zps )    CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv,  &        ! Partial steps: before horizontal gradient
-            &                                      rhd, gru , grv, aru, arv, gzu, gzv, ge3ru, ge3rv,  &             !
-            &                                      gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi  )  ! of t, s, rd at the last ocean level
+         IF( ln_zps .AND. .NOT. ln_isfcav)                                 &
+            &            CALL zps_hde    ( nit000, jpts, tsb, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
+            &                                            rhd, gru , grv    )  ! of t, s, rd at the last ocean level
+         IF( ln_zps .AND.       ln_isfcav)                                 &
+            &            CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
+            &                                            rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
+            &                                     gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
 #endif
          !   
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90	(revision 5682)
@@ -41,6 +41,6 @@
    REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin]
 #if defined key_lim3
-   REAL(wp), PUBLIC ::   rt0_snow = 273.16_wp        !: melting point of snow         [Kelvin]
-   REAL(wp), PUBLIC ::   rt0_ice  = 273.16_wp        !: melting point of ice          [Kelvin]
+   REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp        !: melting point of snow         [Kelvin]
+   REAL(wp), PUBLIC ::   rt0_ice  = 273.15_wp        !: melting point of ice          [Kelvin]
 #else
    REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp        !: melting point of snow         [Kelvin]
@@ -51,4 +51,5 @@
    REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin]
    REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J]
+   REAL(wp), PUBLIC ::   rau0_rcp                    !: = rau0 * rcp 
    REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp )
 
@@ -82,4 +83,8 @@
    REAL(wp), PUBLIC ::   xlic     =  300.33e+6_wp    !: volumetric latent heat fusion of ice                  [J/m3]
    REAL(wp), PUBLIC ::   xsn      =    2.8e+6_wp     !: volumetric latent heat of sublimation of snow         [J/m3]
+#endif
+#if defined key_lim3
+   REAL(wp), PUBLIC ::   r1_rhoic                    !: 1 / rhoic
+   REAL(wp), PUBLIC ::   r1_rhosn                    !: 1 / rhosn
 #endif
    !!----------------------------------------------------------------------
@@ -166,5 +171,8 @@
       lfus = xlsn / rhosn        ! latent heat of fusion of fresh ice
 #endif
-
+#if defined key_lim3
+      r1_rhoic = 1._wp / rhoic
+      r1_rhosn = 1._wp / rhosn
+#endif
       IF(lwp) THEN
          WRITE(numout,*)
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 5682)
@@ -17,4 +17,5 @@
    !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
    !!             -   ! 2010-10  (R. Furner, G. Madec) runoff and cla added directly here
+   !!            3.6  ! 2014-11  (P. Mathiot)          isf            added directly here
    !!----------------------------------------------------------------------
 
@@ -97,5 +98,5 @@
       !
       CALL wrk_alloc( jpi  , jpj+2, zwu               )
-      CALL wrk_alloc( jpi+4, jpj  , zwv, kjstart = -1 )
+      CALL wrk_alloc( jpi+4, jpj  , zwv, kistart = -1 )
       !
       IF( kt == nit000 ) THEN
@@ -236,5 +237,5 @@
       !
       CALL wrk_dealloc( jpi  , jpj+2, zwu               )
-      CALL wrk_dealloc( jpi+4, jpj  , zwv, kjstart = -1 )
+      CALL wrk_dealloc( jpi+4, jpj  , zwv, kistart = -1 )
       !
       IF( nn_timing == 1 )  CALL timing_stop('div_cur')
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 5682)
@@ -5,5 +5,6 @@
    !!==============================================================================
    !! History :  1.0  !  2006-11  (G. Madec)  Original code
-   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
+   !!            3.3  !  2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase
+   !!            3.6  !  2015-05  (N. Ducousso, G. Madec)  add Hollingsworth scheme as an option 
    !!----------------------------------------------------------------------
 
@@ -17,4 +18,5 @@
    USE dynkeg          ! kinetic energy gradient          (dyn_keg      routine)
    USE dynzad          ! vertical advection               (dyn_zad      routine)
+   !
    USE in_out_manager  ! I/O manager
    USE lib_mpp         ! MPP library
@@ -25,7 +27,9 @@
 
    PUBLIC dyn_adv       ! routine called by step module
-   PUBLIC dyn_adv_init  ! routine called by opa module
+   PUBLIC dyn_adv_init  ! routine called by opa  module
  
+   !                                    !* namdyn_adv namelist *
    LOGICAL, PUBLIC ::   ln_dynadv_vec   !: vector form flag
+   INTEGER, PUBLIC ::   nn_dynkeg       !: scheme of kinetic energy gradient: =0 C2 ; =1 Hollingsworth
    LOGICAL, PUBLIC ::   ln_dynadv_cen2  !: flux form - 2nd order centered scheme flag
    LOGICAL, PUBLIC ::   ln_dynadv_ubs   !: flux form - 3rd order UBS scheme flag
@@ -38,5 +42,5 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.6 , NEMO Consortium (2015)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -63,16 +67,16 @@
       SELECT CASE ( nadv )                  ! compute advection trend and add it to general trend
       CASE ( 0 )     
-                      CALL dyn_keg     ( kt )    ! vector form : horizontal gradient of kinetic energy
-                      CALL dyn_zad     ( kt )    ! vector form : vertical advection
+                      CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy
+                      CALL dyn_zad     ( kt )               ! vector form : vertical advection
       CASE ( 1 )     
-                      CALL dyn_keg     ( kt )    ! vector form : horizontal gradient of kinetic energy
-                      CALL dyn_zad_zts ( kt )    ! vector form : vertical advection with sub-timestepping
+                      CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy
+                      CALL dyn_zad_zts ( kt )               ! vector form : vertical advection with sub-timestepping
       CASE ( 2 ) 
-                      CALL dyn_adv_cen2( kt )    ! 2nd order centered scheme
+                      CALL dyn_adv_cen2( kt )               ! 2nd order centered scheme
       CASE ( 3 )   
-                      CALL dyn_adv_ubs ( kt )    ! 3rd order UBS      scheme
+                      CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme
       !
-      CASE (-1 )                                 ! esopa: test all possibility with control print
-                      CALL dyn_keg     ( kt )
+      CASE (-1 )                                            ! esopa: test all possibility with control print
+                      CALL dyn_keg     ( kt, nn_dynkeg )
                       CALL dyn_zad     ( kt )
                       CALL dyn_adv_cen2( kt )
@@ -92,10 +96,9 @@
       !!              momentum advection formulation & scheme and set nadv
       !!----------------------------------------------------------------------
-      INTEGER ::   ioptio
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      !!
-      NAMELIST/namdyn_adv/ ln_dynadv_vec, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts
+      INTEGER ::   ioptio, ios   ! Local integer
+      !
+      NAMELIST/namdyn_adv/ ln_dynadv_vec, nn_dynkeg, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts
       !!----------------------------------------------------------------------
-
+      !
       REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme
       READ  ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901)
@@ -112,8 +115,9 @@
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '       Namelist namdyn_adv : chose a advection formulation & scheme for momentum'
-         WRITE(numout,*) '          Vector/flux form (T/F)             ln_dynadv_vec  = ', ln_dynadv_vec
-         WRITE(numout,*) '          2nd order centred advection scheme ln_dynadv_cen2 = ', ln_dynadv_cen2
-         WRITE(numout,*) '          3rd order UBS advection scheme     ln_dynadv_ubs  = ', ln_dynadv_ubs
-         WRITE(numout,*) '      Sub timestepping of vertical advection ln_dynzad_zts  = ', ln_dynzad_zts
+         WRITE(numout,*) '          Vector/flux form (T/F)                           ln_dynadv_vec  = ', ln_dynadv_vec
+         WRITE(numout,*) '          = 0 standard scheme  ; =1 Hollingsworth scheme   nn_dynkeg      = ', nn_dynkeg
+         WRITE(numout,*) '          2nd order centred advection scheme               ln_dynadv_cen2 = ', ln_dynadv_cen2
+         WRITE(numout,*) '          3rd order UBS advection scheme                   ln_dynadv_ubs  = ', ln_dynadv_ubs
+         WRITE(numout,*) '          Sub timestepping of vertical advection           ln_dynzad_zts  = ', ln_dynzad_zts
       ENDIF
 
@@ -126,5 +130,7 @@
       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' )
       IF( ln_dynzad_zts .AND. .NOT. ln_dynadv_vec )   &
-          CALL ctl_stop( 'Sub timestepping of vertical advection requires vector form; set ln_dynadv_vec = .TRUE.' )
+         CALL ctl_stop( 'Sub timestepping of vertical advection requires vector form; set ln_dynadv_vec = .TRUE.' )
+      IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW )   &  
+         CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' )
 
       !                               ! Set nadv
@@ -137,6 +143,10 @@
       IF(lwp) THEN                    ! Print the choice
          WRITE(numout,*)
-         IF( nadv ==  0 )   WRITE(numout,*) '         vector form : keg + zad + vor is used'
+         IF( nadv ==  0 )   WRITE(numout,*) '         vector form : keg + zad + vor is used' 
          IF( nadv ==  1 )   WRITE(numout,*) '         vector form : keg + zad_zts + vor is used'
+         IF( nadv ==  0 .OR. nadv ==  1 ) THEN
+            IF( nn_dynkeg == nkeg_C2  )   WRITE(numout,*) 'with Centered standard keg scheme'
+            IF( nn_dynkeg == nkeg_HW  )   WRITE(numout,*) 'with Hollingsworth keg scheme'
+         ENDIF
          IF( nadv ==  2 )   WRITE(numout,*) '         flux form   : 2nd order scheme is used'
          IF( nadv ==  3 )   WRITE(numout,*) '         flux form   : UBS       scheme is used'
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 5682)
@@ -80,18 +80,23 @@
               ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  bfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu)
               va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  bfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv)
-              
-              ! (ISF) stability criteria for top friction
-              ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels
-              ikbv = mikv(ji,jj)
-              !
-              ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
-              ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  tfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu) &
-                 &             * (1.-umask(ji,jj,1))
-              va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  tfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv) &
-                 &             * (1.-vmask(ji,jj,1))
-              ! (ISF)
-              
            END DO
         END DO
+        
+        IF ( ln_isfcav ) THEN
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1
+                 ! (ISF) stability criteria for top friction
+                 ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels
+                 ikbv = mikv(ji,jj)
+                 !
+                 ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
+                 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  tfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu) &
+                    &             * (1.-umask(ji,jj,1))
+                 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  tfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv) &
+                    &             * (1.-vmask(ji,jj,1))
+                 ! (ISF)
+              END DO
+           END DO
+        END IF
 
         !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 5682)
@@ -16,4 +16,5 @@
    !!            3.4  !  2011-11  (H. Liu) hpg_prj: Original code for s-coordinates
    !!                 !           (A. Coward) suppression of hel, wdj and rot options
+   !!            3.6  !  2014-11  (P. Mathiot) hpg_isf: original code for ice shelf cavity
    !!----------------------------------------------------------------------
 
@@ -25,4 +26,5 @@
    !!       hpg_zps  : z-coordinate plus partial steps (interpolation)
    !!       hpg_sco  : s-coordinate (standard jacobian formulation)
+   !!       hpg_isf  : s-coordinate (sco formulation) adapted to ice shelf
    !!       hpg_djc  : s-coordinate (Density Jacobian with Cubic polynomial)
    !!       hpg_prj  : s-coordinate (Pressure Jacobian with Cubic polynomial)
@@ -55,4 +57,5 @@
    LOGICAL , PUBLIC ::   ln_hpg_djc      !: s-coordinate (Density Jacobian with Cubic polynomial)
    LOGICAL , PUBLIC ::   ln_hpg_prj      !: s-coordinate (Pressure Jacobian scheme)
+   LOGICAL , PUBLIC ::   ln_hpg_isf      !: s-coordinate similar to sco modify for isf
    LOGICAL , PUBLIC ::   ln_dynhpg_imp   !: semi-implicite hpg flag
 
@@ -97,4 +100,5 @@
       CASE (  3 )   ;   CALL hpg_djc    ( kt )      ! s-coordinate (Density Jacobian with Cubic polynomial)
       CASE (  4 )   ;   CALL hpg_prj    ( kt )      ! s-coordinate (Pressure Jacobian scheme)
+      CASE (  5 )   ;   CALL hpg_isf    ( kt )      ! s-coordinate similar to sco modify for ice shelf
       END SELECT
       !
@@ -128,5 +132,5 @@
       !!
       NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco,     &
-         &                 ln_hpg_djc, ln_hpg_prj, ln_dynhpg_imp
+         &                 ln_hpg_djc, ln_hpg_prj, ln_hpg_isf, ln_dynhpg_imp
       !!----------------------------------------------------------------------
       !
@@ -148,4 +152,5 @@
          WRITE(numout,*) '      z-coord. - partial steps (interpolation)          ln_hpg_zps    = ', ln_hpg_zps
          WRITE(numout,*) '      s-coord. (standard jacobian formulation)          ln_hpg_sco    = ', ln_hpg_sco
+         WRITE(numout,*) '      s-coord. (standard jacobian formulation) for isf  ln_hpg_isf    = ', ln_hpg_isf
          WRITE(numout,*) '      s-coord. (Density Jacobian: Cubic polynomial)     ln_hpg_djc    = ', ln_hpg_djc
          WRITE(numout,*) '      s-coord. (Pressure Jacobian: Cubic polynomial)    ln_hpg_prj    = ', ln_hpg_prj
@@ -158,8 +163,13 @@
                            & either  ln_hpg_sco or  ln_hpg_prj instead')
       !
-      IF( lk_vvl .AND. .NOT. (ln_hpg_sco.OR.ln_hpg_prj) )   &
+      IF( lk_vvl .AND. .NOT. (ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) )   &
          &   CALL ctl_stop('dyn_hpg_init : variable volume key_vvl requires:&
                            & the standard jacobian formulation hpg_sco or &
                            & the pressure jacobian formulation hpg_prj')
+
+      IF(       ln_hpg_isf .AND. .NOT. ln_isfcav )   &
+         &   CALL ctl_stop( ' hpg_isf not available if ln_isfcav = false ' )
+      IF( .NOT. ln_hpg_isf .AND.       ln_isfcav )   &
+         &   CALL ctl_stop( 'Only hpg_isf has been corrected to work with ice shelf cavity.' )
       !
       !                               ! Set nhpg from ln_hpg_... flags
@@ -169,4 +179,5 @@
       IF( ln_hpg_djc )   nhpg = 3
       IF( ln_hpg_prj )   nhpg = 4
+      IF( ln_hpg_isf )   nhpg = 5
       !
       !                               ! Consistency check
@@ -177,7 +188,9 @@
       IF( ln_hpg_djc )   ioptio = ioptio + 1
       IF( ln_hpg_prj )   ioptio = ioptio + 1
+      IF( ln_hpg_isf )   ioptio = ioptio + 1
       IF( ioptio /= 1 )   CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' )
-      IF( (ln_hpg_zco .OR. ln_hpg_zps .OR. ln_hpg_djc .OR. ln_hpg_prj ) .AND. nn_isf .NE. 0 )   &
-          &  CALL ctl_stop( 'Only hpg_sco has been corrected to work with ice shelf cavity.' )
+      ! 
+      ! initialisation of ice load
+      riceload(:,:)=0.0
       !
    END SUBROUTINE dyn_hpg_init
@@ -345,5 +358,4 @@
    END SUBROUTINE hpg_zps
 
-
    SUBROUTINE hpg_sco( kt )
       !!---------------------------------------------------------------------
@@ -366,4 +378,91 @@
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
       !!
+      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
+      REAL(wp) ::   zcoef0, zuap, zvap, znad   ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj )
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_sco : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OPA original scheme used'
+      ENDIF
+
+      ! Local constant initialization
+      zcoef0 = - grav * 0.5_wp
+      ! To use density and not density anomaly
+      IF ( lk_vvl ) THEN   ;     znad = 1._wp          ! Variable volume
+      ELSE                 ;     znad = 0._wp         ! Fixed volume
+      ENDIF
+
+      ! Surface value
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! hydrostatic pressure gradient along s-surfaces
+            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( fse3w(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )   &
+               &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) )
+            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( fse3w(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )   &
+               &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) )
+            ! s-coordinate pressure gradient correction
+            zuap = -zcoef0 * ( rhd   (ji+1,jj,1) + rhd   (ji,jj,1) + 2._wp * znad )   &
+               &           * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj)
+            zvap = -zcoef0 * ( rhd   (ji,jj+1,1) + rhd   (ji,jj,1) + 2._wp * znad )   &
+               &           * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj)
+            ! add to the general momentum trend
+            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap
+            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap
+         END DO
+      END DO
+
+      ! interior value (2=<jk=<jpkm1)
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! hydrostatic pressure gradient along s-surfaces
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   &
+                  &           * (  fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   &
+                  &              - fse3w(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  )
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   &
+                  &           * (  fse3w(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   &
+                  &              - fse3w(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  )
+               ! s-coordinate pressure gradient correction
+               zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
+                  &           * ( fsde3w(ji+1,jj  ,jk) - fsde3w(ji,jj,jk) ) / e1u(ji,jj)
+               zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
+                  &           * ( fsde3w(ji  ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj)
+               ! add to the general momentum trend
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap
+               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj )
+      !
+   END SUBROUTINE hpg_sco
+
+   SUBROUTINE hpg_isf( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE hpg_sco  ***
+      !!
+      !! ** Method  :   s-coordinate case. Jacobian scheme.
+      !!      The now hydrostatic pressure gradient at a given level, jk,
+      !!      is computed by taking the vertical integral of the in-situ
+      !!      density gradient along the model level from the suface to that
+      !!      level. s-coordinates (ln_sco): a corrective term is added
+      !!      to the horizontal pressure gradient :
+      !!         zhpi = grav .....  + 1/e1u mi(rhd) di[ grav dep3w ]
+      !!         zhpj = grav .....  + 1/e2v mj(rhd) dj[ grav dep3w ]
+      !!      add it to the general momentum trend (ua,va).
+      !!         ua = ua - 1/e1u * zhpi
+      !!         va = va - 1/e2v * zhpj
+      !!      iceload is added and partial cell case are added to the top and bottom
+      !!      
+      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !!
       INTEGER  ::   ji, jj, jk, iku, ikv, ikt, iktp1i, iktp1j                 ! dummy loop indices
       REAL(wp) ::   zcoef0, zuap, zvap, znad, ze3wu, ze3wv, zuapint, zvapint, zhpjint, zhpiint, zdzwt, zdzwtjp1, zdzwtip1             ! temporary scalars
@@ -379,5 +478,5 @@
      IF( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn:hpg_sco : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_isf : hydrostatic pressure gradient trend for ice shelf'
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OPA original scheme used'
       ENDIF
@@ -565,11 +664,6 @@
 !==================================================================================
 
-# if defined key_vectopt_loop
-         jj = 1
-         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-# else
       DO jj = 2, jpjm1
          DO ji = 2, jpim1
-# endif
             iku = mbku(ji,jj)
             ikv = mbkv(ji,jj)
@@ -598,7 +692,5 @@
                va(ji,jj,ikv)   =  va(ji,jj,ikv) + zhpj(ji,jj,ikv) + zvap
             END IF
-# if ! defined key_vectopt_loop
-         END DO
-# endif
+         END DO
       END DO
      
@@ -610,5 +702,5 @@
       CALL wrk_dealloc( jpi,jpj, ze3w, zp, zrhdtop_isf, zrhdtop_oce, ziceload, zdept, zpshpi, zpshpj)
       !
-   END SUBROUTINE hpg_sco
+   END SUBROUTINE hpg_isf
 
 
@@ -864,8 +956,10 @@
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdept, zrhh
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zsshu_n, zsshv_n
       !!----------------------------------------------------------------------
       !
       CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
       CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh )
+      CALL wrk_alloc( jpi,jpj, zsshu_n, zsshv_n )
       !
       IF( kt == nit000 ) THEN
@@ -948,8 +1042,19 @@
 
       ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1)
+
+      ! Prepare zsshu_n and zsshv_n
       DO jj = 2, jpjm1
         DO ji = 2, jpim1
-          zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshn(ji,jj) * znad)    ! probable bug: changed from sshu_n for ztilde compilation
-          zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshn(ji,jj) * znad)    ! probable bug: changed from sshv_n for ztilde compilation
+          zsshu_n(ji,jj) = (e12u(ji,jj) * sshn(ji,jj) + e12u(ji+1, jj) * sshn(ji+1,jj)) * &
+                         & r1_e12u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
+          zsshv_n(ji,jj) = (e12v(ji,jj) * sshn(ji,jj) + e12v(ji+1, jj) * sshn(ji,jj+1)) * &
+                         & r1_e12v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
+        END DO
+      END DO
+
+      DO jj = 2, jpjm1
+        DO ji = 2, jpim1
+          zu(ji,jj,1) = - ( fse3u(ji,jj,1) - zsshu_n(ji,jj) * znad) 
+          zv(ji,jj,1) = - ( fse3v(ji,jj,1) - zsshv_n(ji,jj) * znad)
         END DO
       END DO
@@ -1113,4 +1218,5 @@
       CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
       CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh )
+      CALL wrk_dealloc( jpi,jpj, zsshu_n, zsshv_n )
       !
    END SUBROUTINE hpg_prj
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 5682)
@@ -4,7 +4,8 @@
    !! Ocean dynamics:  kinetic energy gradient trend
    !!======================================================================
-   !! History :  1.0  !  87-09  (P. Andrich, m.-a. Foujols)  Original code
-   !!            7.0  !  97-05  (G. Madec)  Split dynber into dynkeg and dynhpg
-   !!            9.0  !  02-07  (G. Madec)  F90: Free form and module
+   !! History :  1.0  !  1987-09  (P. Andrich, M.-A. Foujols)  Original code
+   !!            7.0  !  1997-05  (G. Madec)  Split dynber into dynkeg and dynhpg
+   !!  NEMO      1.0  !  2002-07  (G. Madec)  F90: Free form and module
+   !!            3.6  !  2015-05  (N. Ducousso, G. Madec)  add Hollingsworth scheme as an option 
    !!----------------------------------------------------------------------
    
@@ -18,4 +19,5 @@
    !
    USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE lib_mpp         ! MPP library
    USE prtctl          ! Print control
@@ -28,8 +30,13 @@
    PUBLIC   dyn_keg    ! routine called by step module
    
+   INTEGER, PARAMETER, PUBLIC  ::   nkeg_C2  = 0   !: 2nd order centered scheme (standard scheme)
+   INTEGER, PARAMETER, PUBLIC  ::   nkeg_HW  = 1   !: Hollingsworth et al., QJRMS, 1983
+   !
+   REAL(wp) ::   r1_48 = 1._wp / 48._wp   !: =1/(4*2*6)
+   
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.6 , NEMO Consortium (2015)
    !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -37,5 +44,5 @@
 CONTAINS
 
-   SUBROUTINE dyn_keg( kt )
+   SUBROUTINE dyn_keg( kt, kscheme )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dyn_keg  ***
@@ -45,6 +52,12 @@
       !!      general momentum trend.
       !!
-      !! ** Method  :   Compute the now horizontal kinetic energy 
+      !! ** Method  : * kscheme = nkeg_C2 : 2nd order centered scheme that 
+      !!      conserve kinetic energy. Compute the now horizontal kinetic energy 
       !!         zhke = 1/2 [ mi-1( un^2 ) + mj-1( vn^2 ) ]
+      !!              * kscheme = nkeg_HW : Hollingsworth correction following
+      !!      Arakawa (2001). The now horizontal kinetic energy is given by:
+      !!         zhke = 1/6 [ mi-1(  2 * un^2 + ((un(j+1)+un(j-1))/2)^2  )
+      !!                    + mj-1(  2 * vn^2 + ((vn(i+1)+vn(i-1))/2)^2  ) ]
+      !!      
       !!      Take its horizontal gradient and add it to the general momentum
       !!      trend (ua,va).
@@ -54,6 +67,10 @@
       !! ** Action : - Update the (ua, va) with the hor. ke gradient trend
       !!             - send this trends to trd_dyn (l_trddyn=T) for post-processing
+      !!
+      !! ** References : Arakawa, A., International Geophysics 2001.
+      !!                 Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER, INTENT( in ) ::   kt        ! ocean time-step index
+      INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme 
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -63,40 +80,60 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('dyn_keg')
+      IF( nn_timing == 1 )   CALL timing_start('dyn_keg')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zhke )
+      CALL wrk_alloc( jpi,jpj,jpk,   zhke )
       !
       IF( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend'
+         IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend, scheme number=', kscheme
          IF(lwp) WRITE(numout,*) '~~~~~~~'
       ENDIF
 
       IF( l_trddyn ) THEN           ! Save ua and va trends
-         CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )
          ztrdu(:,:,:) = ua(:,:,:) 
          ztrdv(:,:,:) = va(:,:,:) 
       ENDIF
       
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         DO jj = 2, jpj         ! Horizontal kinetic energy at T-point
-            DO ji = fs_2, jpi   ! vector opt.
-               zu = 0.25 * (  un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
-                  &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)  )
-               zv = 0.25 * (  vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
-                  &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)  )
-               zhke(ji,jj,jk) = zv + zu
-!!gm simplier coding  ==>>   ~ faster
-!    don't forget to suppress local zu zv scalars
-!               zhke(ji,jj,jk) = 0.25 * (   un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
-!                  &                      + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   &
-!                  &                      + vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
-!                  &                      + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   )
-!!gm end <<==
-            END DO  
-         END DO  
-         DO jj = 2, jpjm1       ! add the gradient of kinetic energy to the general momentum trends
+      zhke(:,:,jpk) = 0._wp
+      
+      SELECT CASE ( kscheme )             !== Horizontal kinetic energy at T-point  ==!
+      !
+      CASE ( nkeg_C2 )                          !--  Standard scheme  --!
+         DO jk = 1, jpkm1
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zu =    un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
+                     &  + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)
+                  zv =    vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
+                     &  + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)
+                  zhke(ji,jj,jk) = 0.25_wp * ( zv + zu )
+               END DO  
+            END DO
+         END DO
+         !
+      CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --!
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1       
+               DO ji = fs_2, jpim1   ! vector opt.
+                  zu = 8._wp * ( un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)    &
+                     &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) )  &
+                     &   +     ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) )   &
+                     &   +     ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) * ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) )
+                     !
+                  zv = 8._wp * ( vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)    &
+                     &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) )  &
+                     &  +      ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) )   &
+                     &  +      ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) * ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) )
+                  zhke(ji,jj,jk) = r1_48 * ( zv + zu )
+               END DO  
+            END DO
+         END DO
+         CALL lbc_lnk( zhke, 'T', 1. )
+         !
+      END SELECT
+      !
+      DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==!
+         DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj)
@@ -104,34 +141,11 @@
             END DO 
          END DO
-!!gm idea to be tested  ==>>   is it faster on scalar computers ?
-!         DO jj = 2, jpjm1       ! add the gradient of kinetic energy to the general momentum trends
-!            DO ji = fs_2, fs_jpim1   ! vector opt.
-!               ua(ji,jj,jk) = ua(ji,jj,jk) - 0.25 * ( + un(ji+1,jj  ,jk) * un(ji+1,jj  ,jk)   &
-!                  &                                   + vn(ji+1,jj-1,jk) * vn(ji+1,jj-1,jk)   &
-!                  &                                   + vn(ji+1,jj  ,jk) * vn(ji+1,jj  ,jk)   &
-!                  !
-!                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
-!                  &                                   - vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
-!                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e1u(ji,jj)
-!                  !
-!               va(ji,jj,jk) = va(ji,jj,jk) - 0.25 * (   un(ji-1,jj+1,jk) * un(ji-1,jj+1,jk)   &
-!                  &                                   + un(ji  ,jj+1,jk) * un(ji  ,jj+1,jk)   &
-!                  &                                   + vn(ji  ,jj+1,jk) * vn(ji  ,jj+1,jk)   &
-!                  !
-!                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
-!                  &                                   - un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   &
-!                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e2v(ji,jj)
-!            END DO 
-!         END DO
-!!gm en idea            <<==
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      IF( l_trddyn ) THEN      ! save the Kinetic Energy trends for diagnostic
+      END DO
+      !
+      IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic
          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
          CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt )
-         CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )
       ENDIF
       !
@@ -139,7 +153,7 @@
          &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zhke )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zhke )
       !
-      IF( nn_timing == 1 )  CALL timing_stop('dyn_keg')
+      IF( nn_timing == 1 )   CALL timing_stop('dyn_keg')
       !
    END SUBROUTINE dyn_keg
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90	(revision 5682)
@@ -69,4 +69,5 @@
    !!----------------------------------------------------------------------
 
+   !! $Id$
  CONTAINS
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 5682)
@@ -266,6 +266,18 @@
                ! Add volume filter correction: compatibility with tracer advection scheme
                ! => time filter + conservation correction (only at the first level)
-               fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1)
-            !
+               IF ( nn_isf == 0) THEN   ! if no ice shelf melting
+                  fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) &
+                                 &                                          -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1)
+               ELSE                     ! if ice shelf melting
+                  DO jj = 1,jpj
+                     DO ji = 1,jpi
+                        jk = mikt(ji,jj)
+                        fse3t_b(ji,jj,jk) = fse3t_b(ji,jj,jk) - atfp * rdt * r1_rau0                       &
+                                          &                          * ( (emp_b(ji,jj)    - emp(ji,jj)   ) &
+                                          &                            - (rnf_b(ji,jj)    - rnf(ji,jj)   ) &
+                                          &                            + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) ) * tmask(ji,jj,jk)
+                     END DO
+                  END DO
+               END IF
             ENDIF
             !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 5682)
@@ -250,5 +250,5 @@
       IF( ( ioptio > 1 .AND. .NOT. lk_esopa ) .OR. ( ioptio == 0 .AND. .NOT. lk_c1d ) )   &
            &   CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' )
-      IF( ( lk_dynspg_ts .OR. lk_dynspg_exp ) .AND. nn_isf .NE. 0 )   &
+      IF( ( lk_dynspg_ts .OR. lk_dynspg_exp ) .AND. ln_isfcav )   &
            &   CALL ctl_stop( ' dynspg_ts and dynspg_exp not tested with ice shelf cavity ' )
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 5682)
@@ -22,4 +22,5 @@
    USE dom_oce         ! ocean space and time domain
    USE sbc_oce         ! surface boundary condition: ocean
+   USE sbcisf          ! ice shelf variable (fwfisf)
    USE dynspg_oce      ! surface pressure gradient variables
    USE phycst          ! physical constants
@@ -78,5 +79,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.5 , NEMO Consortium (2013)
-   !! $Id: dynspg_ts.F90
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -453,16 +454,17 @@
       !                                         ! Surface net water flux and rivers
       IF (ln_bt_fw) THEN
-         zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) )
+         zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) )
       ELSE
-         zssh_frc(:,:) = zraur * z1_2 * (emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:))
+         zssh_frc(:,:) = zraur * z1_2 * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:)   &
+                &                        + fwfisf(:,:) + fwfisf_b(:,:)                     )
       ENDIF
 #if defined key_asminc
       !                                         ! Include the IAU weighted SSH increment
       IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
-         zssh_frc(:,:) = zssh_frc(:,:) + ssh_iau(:,:)
-      ENDIF
-#endif
-      !                                   !* Fill boundary data arrays with AGRIF
-      !                                   ! -------------------------------------
+         zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:)
+      ENDIF
+#endif
+      !                                   !* Fill boundary data arrays for AGRIF
+      !                                   ! ------------------------------------
 #if defined key_agrif
          IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt )
@@ -555,5 +557,5 @@
                END DO
             END DO
-            CALL lbc_lnk( zwx, 'U', 1._wp )    ;   CALL lbc_lnk( zwy, 'V', 1._wp )
+            CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp )
             !
             zhup2_e (:,:) = hu_0(:,:) + zwx(:,:)                ! Ocean depth at U- and V-points
@@ -633,5 +635,5 @@
                END DO
             END DO
-            CALL lbc_lnk( zsshu_a, 'U', 1._wp )   ;   CALL lbc_lnk( zsshv_a, 'V', 1._wp )
+            CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp )
          ENDIF   
          !                                 
@@ -801,6 +803,5 @@
          !                                                 !  -----------------------
          !
-         CALL lbc_lnk( ua_e  , 'U', -1._wp )               ! local domain boundaries 
-         CALL lbc_lnk( va_e  , 'V', -1._wp )
+         CALL lbc_lnk_multi( ua_e, 'U', -1._wp, va_e , 'V', -1._wp )
 
 #if defined key_bdy  
@@ -857,5 +858,5 @@
             END DO
          END DO
-         CALL lbc_lnk( zsshu_a, 'U', 1._wp )   ;   CALL lbc_lnk( zsshv_a, 'V', 1._wp ) ! Boundary conditions
+         CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions
       ENDIF
       !
@@ -899,6 +900,5 @@
 #if defined key_agrif
       ! Save time integrated fluxes during child grid integration
-      ! (used to update coarse grid transports)
-      ! Useless with 2nd order momentum schemes
+      ! (used to update coarse grid transports at next time step)
       !
       IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw) ) THEN
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 5682)
@@ -95,12 +95,25 @@
          END DO   
       END DO
-      DO jj = 2, jpjm1              ! Surface and bottom values set to zero
-         DO ji = fs_2, fs_jpim1           ! vector opt.
-            zwuw(ji,jj, 1:miku(ji,jj) ) = 0._wp
-            zwvw(ji,jj, 1:mikv(ji,jj) ) = 0._wp
-            zwuw(ji,jj,jpk) = 0._wp
-            zwvw(ji,jj,jpk) = 0._wp
-         END DO  
-      END DO
+      !
+      ! Surface and bottom advective fluxes set to zero
+      IF ( ln_isfcav ) THEN
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1           ! vector opt.
+               zwuw(ji,jj, 1:miku(ji,jj) ) = 0._wp
+               zwvw(ji,jj, 1:mikv(ji,jj) ) = 0._wp
+               zwuw(ji,jj,jpk) = 0._wp
+               zwvw(ji,jj,jpk) = 0._wp
+            END DO
+         END DO
+      ELSE
+         DO jj = 2, jpjm1        
+            DO ji = fs_2, fs_jpim1           ! vector opt.
+               zwuw(ji,jj, 1 ) = 0._wp
+               zwvw(ji,jj, 1 ) = 0._wp
+               zwuw(ji,jj,jpk) = 0._wp
+               zwvw(ji,jj,jpk) = 0._wp
+            END DO  
+         END DO
+      END IF
 
       DO jk = 1, jpkm1              ! Vertical momentum advection at u- and v-points
@@ -196,9 +209,10 @@
          END DO
       END DO
-
-      DO jj = 2, jpjm1                    ! Surface and bottom advective fluxes set to zero
+      !
+      ! Surface and bottom advective fluxes set to zero
+      DO jj = 2, jpjm1        
          DO ji = fs_2, fs_jpim1           ! vector opt.
-            zwuw(ji,jj, 1:miku(ji,jj) ) = 0._wp
-            zwvw(ji,jj, 1:mikv(ji,jj) ) = 0._wp
+            zwuw(ji,jj, 1 ) = 0._wp
+            zwvw(ji,jj, 1 ) = 0._wp
             zwuw(ji,jj,jpk) = 0._wp
             zwvw(ji,jj,jpk) = 0._wp
@@ -228,6 +242,6 @@
             DO jj = 2, jpjm1                 ! vertical momentum advection at w-point
                DO ji = fs_2, fs_jpim1        ! vector opt.
-                  zwuw(ji,jj,jk) = ( zww(ji+1,jj  ,jk) + zww(ji,jj,jk) ) * ( zus(ji,jj,jk-1,jtn)-zus(ji,jj,jk,jtn) )
-                  zwvw(ji,jj,jk) = ( zww(ji  ,jj+1,jk) + zww(ji,jj,jk) ) * ( zvs(ji,jj,jk-1,jtn)-zvs(ji,jj,jk,jtn) )
+                  zwuw(ji,jj,jk) = ( zww(ji+1,jj  ,jk) + zww(ji,jj,jk) ) * ( zus(ji,jj,jk-1,jtn)-zus(ji,jj,jk,jtn) ) !* wumask(ji,jj,jk)
+                  zwvw(ji,jj,jk) = ( zww(ji  ,jj+1,jk) + zww(ji,jj,jk) ) * ( zvs(ji,jj,jk-1,jtn)-zvs(ji,jj,jk,jtn) ) !* wvmask(ji,jj,jk)
                END DO  
             END DO   
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 5682)
@@ -105,10 +105,16 @@
                avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1)
                avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1)
-               ikbu = miku(ji,jj)       ! ocean top level at u- and v-points 
-               ikbv = mikv(ji,jj)       ! (first wet ocean u- and v-points)
-               IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * fse3uw(ji,jj,ikbu)
-               IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * fse3vw(ji,jj,ikbv)
-            END DO
-         END DO
+            END DO
+         END DO
+         IF ( ln_isfcav ) THEN
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  ikbu = miku(ji,jj)       ! ocean top level at u- and v-points 
+                  ikbv = mikv(ji,jj)       ! (first wet ocean u- and v-points)
+                  IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * fse3uw(ji,jj,ikbu)
+                  IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * fse3vw(ji,jj,ikbv)
+               END DO
+            END DO
+         END IF
       ENDIF
 
@@ -145,12 +151,18 @@
                ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * bfrua(ji,jj) * ua_b(ji,jj) / ze3ua
                va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * bfrva(ji,jj) * va_b(ji,jj) / ze3va
-               ikbu = miku(ji,jj)         ! top ocean level at u- and v-points 
-               ikbv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
-               ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,ikbu) + r_vvl   * fse3u_a(ji,jj,ikbu)
-               ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,ikbv) + r_vvl   * fse3v_a(ji,jj,ikbv)
-               ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua
-               va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va
-            END DO
-         END DO
+            END DO
+         END DO
+         IF ( ln_isfcav ) THEN
+            DO jj = 2, jpjm1        
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ikbu = miku(ji,jj)         ! top ocean level at u- and v-points 
+                  ikbv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
+                  ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,ikbu) + r_vvl   * fse3u_a(ji,jj,ikbu)
+                  ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,ikbv) + r_vvl   * fse3v_a(ji,jj,ikbv)
+                  ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua
+                  va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va
+               END DO
+            END DO
+         END IF
       ENDIF
 #endif
@@ -167,9 +179,9 @@
                ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,jk) + r_vvl   * fse3u_a(ji,jj,jk)   ! after scale factor at T-point
                zcoef = - p2dt / ze3ua      
-               zzwi          = zcoef * avmu (ji,jj,jk  ) / fse3uw(ji,jj,jk  )
-               zwi(ji,jj,jk) = zzwi  * umask(ji,jj,jk)
-               zzws          = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 
-               zws(ji,jj,jk) = zzws  * umask(ji,jj,jk+1)
-               zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws
+               zzwi          = zcoef * avmu  (ji,jj,jk  ) / fse3uw(ji,jj,jk  )
+               zwi(ji,jj,jk) = zzwi  * wumask(ji,jj,jk  )
+               zzws          = zcoef * avmu  (ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 
+               zws(ji,jj,jk) = zzws  * wumask(ji,jj,jk+1)
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
             END DO
          END DO
@@ -198,7 +210,7 @@
       !
       !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-      DO jj = 2, jpjm1   
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            DO jk = miku(ji,jj)+1, jpkm1
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
                zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
             END DO
@@ -208,14 +220,18 @@
       DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,miku(ji,jj)) + r_vvl   * fse3u_a(ji,jj,miku(ji,jj)) 
 #if defined key_dynspg_ts
-            ua(ji,jj,miku(ji,jj)) = ua(ji,jj,miku(ji,jj)) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
-               &                                      / ( ze3ua * rau0 ) 
+            ze3ua =  ( 1._wp - r_vvl ) * fse3u_n(ji,jj,1) + r_vvl   * fse3u_a(ji,jj,1) 
+            ua(ji,jj,1) = ua(ji,jj,1) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
+               &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1) 
 #else
-            ua(ji,jj,miku(ji,jj)) = ub(ji,jj,miku(ji,jj)) &
-               &                   + p2dt *(ua(ji,jj,miku(ji,jj)) +  0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
-               &                                  / ( fse3u(ji,jj,miku(ji,jj)) * rau0     ) ) 
-#endif
-            DO jk = miku(ji,jj)+1, jpkm1
+            ua(ji,jj,1) = ub(ji,jj,1) &
+               &                   + p2dt *(ua(ji,jj,1) +  0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
+               &                                      / ( fse3u(ji,jj,1) * rau0     ) * umask(ji,jj,1) ) 
+#endif
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
 #if defined key_dynspg_ts
                zrhs = ua(ji,jj,jk)   ! zrhs=right hand side
@@ -231,5 +247,9 @@
          DO ji = fs_2, fs_jpim1   ! vector opt.
             ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
-            DO jk = jpk-2, miku(ji,jj), -1
+         END DO
+      END DO
+      DO jk = jpk-2, 1, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
                ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk)
             END DO
@@ -260,8 +280,8 @@
                zcoef = - p2dt / ze3va
                zzwi          = zcoef * avmv (ji,jj,jk  ) / fse3vw(ji,jj,jk  )
-               zwi(ji,jj,jk) =  zzwi * vmask(ji,jj,jk)
+               zwi(ji,jj,jk) =  zzwi * wvmask(ji,jj,jk)
                zzws          = zcoef * avmv (ji,jj,jk+1) / fse3vw(ji,jj,jk+1)
-               zws(ji,jj,jk) =  zzws * vmask(ji,jj,jk+1)
-               zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws
+               zws(ji,jj,jk) =  zzws * wvmask(ji,jj,jk+1)
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
             END DO
          END DO
@@ -290,7 +310,7 @@
       !
       !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
-      DO jj = 2, jpjm1   
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            DO jk = mikv(ji,jj)+1, jpkm1        
+      DO jk = 2, jpkm1        
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
                zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
             END DO
@@ -300,14 +320,18 @@
       DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,mikv(ji,jj)) + r_vvl   * fse3v_a(ji,jj,mikv(ji,jj)) 
 #if defined key_dynspg_ts            
-            va(ji,jj,mikv(ji,jj)) = va(ji,jj,mikv(ji,jj)) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
+            ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl   * fse3v_a(ji,jj,1) 
+            va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
                &                                      / ( ze3va * rau0 ) 
 #else
-            va(ji,jj,mikv(ji,jj)) = vb(ji,jj,mikv(ji,jj)) &
-               &                   + p2dt *(va(ji,jj,mikv(ji,jj)) +  0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
-               &                                                       / ( fse3v(ji,jj,mikv(ji,jj)) * rau0     )  )
-#endif
-            DO jk = mikv(ji,jj)+1, jpkm1
+            va(ji,jj,1) = vb(ji,jj,1) &
+               &                   + p2dt *(va(ji,jj,1) +  0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
+               &                                                       / ( fse3v(ji,jj,1) * rau0     )  )
+#endif
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
 #if defined key_dynspg_ts
                zrhs = va(ji,jj,jk)   ! zrhs=right hand side
@@ -323,5 +347,9 @@
          DO ji = fs_2, fs_jpim1   ! vector opt.
             va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
-            DO jk = jpk-2, mikv(ji,jj), -1
+         END DO
+      END DO
+      DO jk = jpk-2, 1, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
                va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk)
             END DO
@@ -349,10 +377,16 @@
               avmu(ji,jj,ikbu+1) = 0.e0
               avmv(ji,jj,ikbv+1) = 0.e0
-              ikbu = miku(ji,jj)         ! ocean top level at u- and v-points 
-              ikbv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
-              IF (ikbu > 1) avmu(ji,jj,ikbu) = 0.e0
-              IF (ikbv > 1) avmv(ji,jj,ikbv) = 0.e0
            END DO
         END DO
+        IF (ln_isfcav) THEN
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1
+                 ikbu = miku(ji,jj)         ! ocean top level at u- and v-points 
+                 ikbv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
+                 IF (ikbu > 1) avmu(ji,jj,ikbu) = 0.e0
+                 IF (ikbv > 1) avmv(ji,jj,ikbv) = 0.e0
+              END DO
+           END DO
+        END IF
       ENDIF
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 5682)
@@ -21,5 +21,4 @@
    USE domvvl          ! Variable volume
    USE divcur          ! hor. divergence and curl      (div & cur routines)
-   USE iom             ! I/O library
    USE restart         ! only for lrst_oce
    USE in_out_manager  ! I/O manager
@@ -31,7 +30,5 @@
    USE bdy_par         
    USE bdydyn2d        ! bdy_ssh routine
-   USE iom
 #if defined key_agrif
-   USE agrif_opa_update
    USE agrif_opa_interp
 #endif
@@ -137,6 +134,4 @@
       !                                           !           outputs            !
       !                                           !------------------------------!
-      CALL iom_put( "ssh" , sshn )   ! sea surface height
-      if( iom_use('ssh2') )   CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height
       !
       IF(ln_ctl)   CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha  - : ', mask1=tmask, ovlap=1 )
@@ -228,22 +223,4 @@
 #endif
       !
-      !                                           !------------------------------!
-      !                                           !           outputs            !
-      !                                           !------------------------------!
-      CALL iom_put( "woce", wn )   ! vertical velocity
-      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value
-         CALL wrk_alloc( jpi, jpj, z2d ) 
-         CALL wrk_alloc( jpi, jpj, jpk, z3d ) 
-         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
-         z2d(:,:) = rau0 * e12t(:,:)
-         DO jk = 1, jpk
-            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
-         END DO
-         CALL iom_put( "w_masstr" , z3d )  
-         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
-         CALL wrk_dealloc( jpi, jpj, z2d  ) 
-         CALL wrk_dealloc( jpi, jpj, jpk, z3d ) 
-      ENDIF
-      !
       IF( nn_timing == 1 )  CALL timing_stop('wzv')
 
@@ -290,12 +267,9 @@
       ELSE                                         !** Leap-Frog time-stepping: Asselin filter + swap
          sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) )     ! before <-- now filtered
-         IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:) - emp(:,:) ) * ssmask(:,:)
+         IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:)    - emp(:,:)    &
+                                &                                 - rnf_b(:,:)    + rnf(:,:)    &
+                                &                                 + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:)
          sshn(:,:) = ssha(:,:)                           ! now <-- after
       ENDIF
-      !
-      ! Update velocity at AGRIF zoom boundaries
-#if defined key_agrif
-      IF ( .NOT.Agrif_Root() ) CALL Agrif_Update_Dyn( kt )
-#endif
       !
       IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask, ovlap=1 )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90	(revision 5682)
@@ -36,5 +36,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
-   !! $Header:
+   !! $Id$
    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 5682)
@@ -50,5 +50,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
-   !! $Header:
+   !! $Id$
    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90	(revision 5682)
@@ -146,5 +146,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2011)
-   !! $Id: sbc_oce.F90 3340 2012-04-02 11:05:35Z sga $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90	(revision 5682)
@@ -33,5 +33,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2011)
-   !! $Id:$
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90	(revision 5682)
@@ -76,5 +76,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2011)
-   !! $Id:$
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90	(revision 5682)
@@ -28,5 +28,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2011)
-   !! $Id:$
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90	(revision 5682)
@@ -41,5 +41,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2011)
-   !! $Id:$
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90	(revision 5682)
@@ -67,5 +67,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2011)
-   !! $Id:$
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90	(revision 5682)
@@ -42,5 +42,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2011)
-   !! $Id:$
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -64,4 +64,5 @@
                                                                                             ! start and count arrays
       LOGICAL                      ::   ll_found_restart
+      CHARACTER(len=256)           ::   cl_path
       CHARACTER(len=256)           ::   cl_filename
       CHARACTER(len=NF90_MAX_NAME) ::   cl_dname
@@ -70,13 +71,15 @@
       !!----------------------------------------------------------------------
 
-      ! Find a restart file
+      ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts. 
+      cl_path = TRIM(cn_ocerst_indir)
+      IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/'
       cl_filename = ' '
       IF ( lk_mpp ) THEN
          cl_filename = ' '
          WRITE( cl_filename, '("restart_icebergs_",I4.4,".nc")' ) narea-1
-         INQUIRE( file=TRIM(cl_filename), exist=ll_found_restart )
+         INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart )
       ELSE
          cl_filename = 'restart_icebergs.nc'
-         INQUIRE( file=TRIM(cl_filename), exist=ll_found_restart )
+         INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart )
       ENDIF
 
@@ -86,7 +89,7 @@
 
       IF (nn_verbose_level >= 0 .AND. lwp)  &
-         WRITE(numout,'(2a)') 'icebergs, read_restart_bergs: found restart file = ',TRIM(cl_filename)
-
-      nret = NF90_OPEN(TRIM(cl_filename), NF90_NOWRITE, ncid)
+         WRITE(numout,'(2a)') 'icebergs, read_restart_bergs: found restart file = ',TRIM(cl_path)//TRIM(cl_filename)
+
+      nret = NF90_OPEN(TRIM(cl_path)//TRIM(cl_filename), NF90_NOWRITE, ncid)
       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_open failed')
 
@@ -228,4 +231,5 @@
       INTEGER ::   jn   ! dummy loop index
       INTEGER ::   ix_dim, iy_dim, ik_dim, in_dim
+      CHARACTER(len=256)     :: cl_path
       CHARACTER(len=256)     :: cl_filename
       TYPE(iceberg), POINTER :: this
@@ -233,12 +237,15 @@
       !!----------------------------------------------------------------------
 
+      ! Assume we write iceberg restarts to same directory as ocean restarts.
+      cl_path = TRIM(cn_ocerst_outdir)
+      IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/'
       IF( lk_mpp ) THEN
-         WRITE(cl_filename,'("icebergs_",I8.8,"_restart_",I4.4,".nc")') kt, narea-1
+         WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart_",I4.4,".nc")') TRIM(cexper), kt, narea-1
       ELSE
-         WRITE(cl_filename,'("icebergs_",I8.8,"_restart.nc")') kt
-      ENDIF
-      IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_filename)
-
-      nret = NF90_CREATE(TRIM(cl_filename), NF90_CLOBBER, ncid)
+         WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart.nc")') TRIM(cexper), kt
+      ENDIF
+      IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_path)//TRIM(cl_filename)
+
+      nret = NF90_CREATE(TRIM(cl_path)//TRIM(cl_filename), NF90_CLOBBER, ncid)
       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_create failed')
 
@@ -372,5 +379,5 @@
          ENDIF
       ENDDO
-      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_filename),' var: stored_ice  written'
+      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_ice  written'
 
       nret = NF90_PUT_VAR( ncid, nkountid, num_bergs(:) )
@@ -379,5 +386,5 @@
       nret = NF90_PUT_VAR( ncid, nsheatid, berg_grid%stored_heat(:,:) )
       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var stored_heat failed')
-      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_filename),' var: stored_heat written'
+      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_heat written'
 
       nret = NF90_PUT_VAR( ncid, ncalvid , src_calving(:,:) )
@@ -385,5 +392,5 @@
       nret = NF90_PUT_VAR( ncid, ncalvhid, src_calving_hflx(:,:) )
       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var calving_hflx failed')
-      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_filename),' var: calving written'
+      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: calving written'
 
       IF ( ASSOCIATED(first_berg) ) THEN
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90	(revision 5682)
@@ -46,5 +46,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2011)
-   !! $Id:$
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90	(revision 5682)
@@ -31,4 +31,5 @@
    PUBLIC   icb_thm ! routine called in icbstp.F90 module
 
+   !! $Id$
 CONTAINS
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90	(revision 5682)
@@ -44,5 +44,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2011)
-   !! $Id:$
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90	(revision 5682)
@@ -51,5 +51,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2011)
-   !! $Id:$
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!-------------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 5682)
@@ -26,6 +26,9 @@
    CHARACTER(lc) ::   cn_exp           !: experiment name used for output filename
    CHARACTER(lc) ::   cn_ocerst_in     !: suffix of ocean restart name (input)
+   CHARACTER(lc) ::   cn_ocerst_indir  !: restart input directory
    CHARACTER(lc) ::   cn_ocerst_out    !: suffix of ocean restart name (output)
+   CHARACTER(lc) ::   cn_ocerst_outdir !: restart output directory
    LOGICAL       ::   ln_rstart        !: start from (F) rest or (T) a restart file
+   LOGICAL       ::   ln_rst_list      !: output restarts at list of times (T) or by frequency (F)
    INTEGER       ::   nn_no            !: job number
    INTEGER       ::   nn_rstctl        !: control of the time step (0, 1 or 2)
@@ -38,7 +41,9 @@
    INTEGER       ::   nn_write         !: model standard output frequency
    INTEGER       ::   nn_stock         !: restart file frequency
+   INTEGER, DIMENSION(10) :: nn_stocklist  !: restart dump times
    LOGICAL       ::   ln_dimgnnn       !: type of dimgout. (F): 1 file for all proc
                                                        !:                  (T): 1 file per proc
    LOGICAL       ::   ln_mskland       !: mask land points in NetCDF outputs (costly: + ~15%)
+   LOGICAL       ::   ln_cfmeta        !: output additional data to netCDF files required for compliance with the CF metadata standard
    LOGICAL       ::   ln_clobber       !: clobber (overwrite) an existing file
    INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
@@ -78,4 +83,5 @@
    INTEGER       ::   nwrite                      !: model standard output frequency
    INTEGER       ::   nstock                      !: restart file frequency
+   INTEGER, DIMENSION(10) :: nstocklist           !: restart dump times
 
    !!----------------------------------------------------------------------
@@ -84,5 +90,7 @@
    INTEGER ::   nitrst                !: time step at which restart file should be written
    LOGICAL ::   lrst_oce              !: logical to control the oce restart write 
-   INTEGER ::   numror, numrow        !: logical unit for cean restart (read and write)
+   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90)
+   INTEGER ::   numrow                !: logical unit for ocean restart (write)
+   INTEGER ::   nrst_lst              !: number of restart to output next
 
    !!----------------------------------------------------------------------
@@ -142,4 +150,5 @@
    LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl
    LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area
+   CHARACTER(lc) ::   cxios_context         !: context name used in xios
 
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 5682)
@@ -33,5 +33,5 @@
    USE icb_oce, ONLY :   nclasses, class_num       !  !: iceberg classes
 #if defined key_lim3
-   USE par_ice
+   USE ice    , ONLY :   jpl
 #elif defined key_lim2
    USE par_ice_2
@@ -61,5 +61,5 @@
 #if defined key_iomput
    PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr
-   PRIVATE set_grid, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate
+   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate
 # endif
 
@@ -98,13 +98,13 @@
       CHARACTER(len=10) :: clname
       INTEGER           ::   ji
-      !!----------------------------------------------------------------------
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( z_bnds(jpk,2) )
 
       clname = cdname
       IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
-# if defined key_mpp_mpi
       CALL xios_context_initialize(TRIM(clname), mpi_comm_opa)
-# else
-      CALL xios_context_initialize(TRIM(clname), 0)
-# endif
       CALL iom_swap( cdname )
 
@@ -121,12 +121,24 @@
       CALL set_scalar
 
-      IF( TRIM(cdname) == "nemo" ) THEN  
+      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN  
          CALL set_grid( "T", glamt, gphit ) 
          CALL set_grid( "U", glamu, gphiu )
          CALL set_grid( "V", glamv, gphiv )
          CALL set_grid( "W", glamt, gphit )
-      ENDIF
-
-      IF( TRIM(cdname) == "nemo_crs" ) THEN  
+         CALL set_grid_znl( gphit )
+         !
+         IF( ln_cfmeta ) THEN   ! Add additional grid metadata
+            CALL iom_set_domain_attr("grid_T", area = e12t(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_V", area = e12v(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_W", area = e12t(nldi:nlei, nldj:nlej))
+            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
+            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
+            CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv )
+            CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit )
+         ENDIF
+      ENDIF
+
+      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN  
          CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
          !
@@ -135,8 +147,19 @@
          CALL set_grid( "V", glamv_crs, gphiv_crs ) 
          CALL set_grid( "W", glamt_crs, gphit_crs ) 
+         CALL set_grid_znl( gphit_crs )
           !
          CALL dom_grid_glo   ! Return to parent grid domain
-      ENDIF
-
+         !
+         IF( ln_cfmeta ) THEN   ! Add additional grid metadata
+            CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej))
+            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
+            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs )
+            CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs )
+            CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
+         ENDIF
+      ENDIF
 
       ! vertical grid definition
@@ -145,4 +168,17 @@
       CALL iom_set_axis_attr( "depthv", gdept_1d )
       CALL iom_set_axis_attr( "depthw", gdepw_1d )
+
+      ! Add vertical grid bounds
+      z_bnds(:      ,1) = gdepw_1d(:)
+      z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk)
+      z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk)
+      CALL iom_set_axis_attr( "deptht", bounds=z_bnds )
+      CALL iom_set_axis_attr( "depthu", bounds=z_bnds )
+      CALL iom_set_axis_attr( "depthv", bounds=z_bnds )
+      z_bnds(:    ,2) = gdept_1d(:)
+      z_bnds(2:jpk,1) = gdept_1d(1:jpkm1)
+      z_bnds(1    ,1) = gdept_1d(1) - e3w_1d(1)
+      CALL iom_set_axis_attr( "depthw", bounds=z_bnds )
+
 # if defined key_floats
       CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) )
@@ -152,4 +188,6 @@
 #endif
       CALL iom_set_axis_attr( "icbcla", class_num )
+      CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )
+      CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )
       
       ! automatic definitions of some of the xml attributs
@@ -162,4 +200,7 @@
       
       CALL xios_update_calendar(0)
+
+      DEALLOCATE( z_bnds )
+
 #endif
       
@@ -543,5 +584,5 @@
    END SUBROUTINE iom_g1d
 
-   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
+   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
       INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file
       INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read
@@ -551,12 +592,17 @@
       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading 
       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis
+      LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to
+                                                                               ! look for and use a file attribute
+                                                                               ! called open_ocean_jstart to set the start
+                                                                               ! value for the 2nd dimension (netcdf only)
       !
       IF( kiomid > 0 ) THEN
          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   &
-              &                                                     ktime=ktime, kstart=kstart, kcount=kcount )
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
+              &                                                     lrowattr=lrowattr )
       ENDIF
    END SUBROUTINE iom_g2d
 
-   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
+   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
       INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file
       INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read
@@ -566,8 +612,13 @@
       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading 
       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis
+      LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to
+                                                                                 ! look for and use a file attribute
+                                                                                 ! called open_ocean_jstart to set the start
+                                                                                 ! value for the 2nd dimension (netcdf only)
       !
       IF( kiomid > 0 ) THEN
          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   &
-              &                                                     ktime=ktime, kstart=kstart, kcount=kcount )
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
+              &                                                     lrowattr=lrowattr )
       ENDIF
    END SUBROUTINE iom_g3d
@@ -576,5 +627,6 @@
    SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   &
          &                  pv_r1d, pv_r2d, pv_r3d,   &
-         &                  ktime , kstart, kcount  )
+         &                  ktime , kstart, kcount,   &
+         &                  lrowattr                )
       !!-----------------------------------------------------------------------
       !!                  ***  ROUTINE  iom_get_123d  ***
@@ -593,6 +645,12 @@
       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis 
       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis
+      LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to
+                                                                           ! look for and use a file attribute
+                                                                           ! called open_ocean_jstart to set the start
+                                                                           ! value for the 2nd dimension (netcdf only)
       !
       LOGICAL                        ::   llnoov      ! local definition to read overlap
+      LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute
+      INTEGER                        ::   jstartrow   ! start point for 2nd dimension optionally set by file attribute
       INTEGER                        ::   jl          ! loop on number of dimension 
       INTEGER                        ::   idom        ! type of domain
@@ -604,5 +662,5 @@
       INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes
       INTEGER                        ::   ji, jj      ! loop counters
-      INTEGER                        ::   irankpv       ! 
+      INTEGER                        ::   irankpv     ! 
       INTEGER                        ::   ind1, ind2  ! substring index
       INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis
@@ -628,4 +686,21 @@
       IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
       IF( PRESENT(kstart) .AND. idom /= jpdom_unknown   ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown')
+
+      luse_jattr = .false.
+      IF( PRESENT(lrowattr) ) THEN
+         IF( lrowattr .AND. idom /= jpdom_data   ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data')
+         IF( lrowattr .AND. idom == jpdom_data   ) luse_jattr = .true.
+      ENDIF
+      IF( luse_jattr ) THEN
+         SELECT CASE (iom_file(kiomid)%iolib)
+         CASE (jpioipsl, jprstdimg )
+             CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)')
+             luse_jattr = .false.
+         CASE (jpnf90   )   
+             ! Ok
+         CASE DEFAULT    
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+         END SELECT
+      ENDIF
 
       ! Search for the variable in the data base (eventually actualize data)
@@ -701,6 +776,12 @@
             ELSE 
                IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array
-                  IF(     idom == jpdom_data    ) THEN ; istart(1:2) = (/ mig(1), mjg(1) /)  ! icnt(1:2) done bellow
-                  ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done bellow
+                  IF(     idom == jpdom_data    ) THEN
+                     jstartrow = 1
+                     IF( luse_jattr ) THEN
+                        CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+                        jstartrow = MAX(1,jstartrow)
+                     ENDIF
+                     istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below
+                  ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done below
                   ENDIF
                   ! we do not read the overlap                     -> we start to read at nldi, nldj
@@ -1067,11 +1148,13 @@
 
    SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj,   &
-      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask )
-      CHARACTER(LEN=*)                 , INTENT(in) ::   cdid
-      INTEGER                , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj
-      INTEGER                , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj
-      INTEGER                , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj
-      REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) ::   lonvalue, latvalue
-      LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) ::   mask
+      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     &
+      &                                    nvertex, bounds_lon, bounds_lat, area )
+      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
+      INTEGER                  , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj
+      INTEGER                  , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj
+      INTEGER                  , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex
+      REAL(wp), DIMENSION(:)   , OPTIONAL, INTENT(in) ::   lonvalue, latvalue
+      REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area
+      LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask
 
       IF ( xios_is_valid_domain     (cdid) ) THEN
@@ -1079,5 +1162,6 @@
             &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
             &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       &
-            &    lonvalue=lonvalue, latvalue=latvalue,mask=mask )
+            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  &
+            &    bounds_lat=bounds_lat, area=area )
       ENDIF
 
@@ -1086,5 +1170,6 @@
             &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
             &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       &
-            &    lonvalue=lonvalue, latvalue=latvalue,mask=mask )
+            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  &
+            &    bounds_lat=bounds_lat, area=area )
       ENDIF
       CALL xios_solve_inheritance()
@@ -1093,9 +1178,14 @@
 
 
-   SUBROUTINE iom_set_axis_attr( cdid, paxis )
+   SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds )
       CHARACTER(LEN=*)      , INTENT(in) ::   cdid
-      REAL(wp), DIMENSION(:), INTENT(in) ::   paxis
-      IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=size(paxis),value=paxis )
-      IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=size(paxis),value=paxis )
+      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   paxis
+      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds
+      IF ( PRESENT(paxis) ) THEN
+         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=SIZE(paxis), value=paxis )
+         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis )
+      ENDIF
+      IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds )
+      IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds )
       CALL xios_solve_inheritance()
    END SUBROUTINE iom_set_axis_attr
@@ -1106,6 +1196,8 @@
       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op
       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_offset
-      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr     ( cdid, freq_op=freq_op, freq_offset=freq_offset )
-      IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr       &
+    &     ( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr  &
+    &                    ( cdid, freq_op=freq_op, freq_offset=freq_offset )
       CALL xios_solve_inheritance()
    END SUBROUTINE iom_set_field_attr
@@ -1160,5 +1252,5 @@
       CALL iom_swap( cdname )   ! swap to cdname context
       CALL xios_update_calendar(kt)
-      IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context
+      IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context
       !
    END SUBROUTINE iom_setkt
@@ -1170,5 +1262,5 @@
          CALL iom_swap( cdname )   ! swap to cdname context
          CALL xios_context_finalize() ! finalize the context
-         IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context
+         IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context
       ENDIF
       !
@@ -1213,4 +1305,142 @@
 
 
+   SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE set_grid_bounds  ***
+      !!
+      !! ** Purpose :   define horizontal grid corners
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=1) , INTENT(in) :: cdgrd
+      !
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           :: plon_cnr, plat_cnr  ! Lat/lon coordinates of a contiguous vertex of cell (i,j)
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coordinates of the point of cell (i,j)
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)   :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_fld       ! Working array to determine where to rotate cells
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_rot       ! Lat/lon working array for rotation of cells
+      !
+      INTEGER :: icnr, jcnr                                      ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
+      !                                                          ! represents the bottom-left corner of cell (i,j)
+      INTEGER :: ji, jj, jn, ni, nj
+
+      ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2)  )
+
+      ! Offset of coordinate representing bottom-left corner
+      SELECT CASE ( TRIM(cdgrd) )
+         CASE ('T', 'W')
+            icnr = -1 ; jcnr = -1
+         CASE ('U')
+            icnr =  0 ; jcnr = -1
+         CASE ('V')
+            icnr = -1 ; jcnr =  0
+      END SELECT
+
+      ni = nlei-nldi+1 ; nj = nlej-nldj+1  ! Dimensions of subdomain interior
+
+      z_fld(:,:) = 1._wp
+      CALL lbc_lnk( z_fld, cdgrd, -1. )    ! Working array for location of northfold
+
+      ! Cell vertices that can be defined
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
+            z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
+            z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
+            z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
+            z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
+            z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
+            z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
+            z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
+         END DO
+      END DO
+
+      ! Cell vertices on boundries
+      DO jn = 1, 4
+         CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp )
+         CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp )
+      END DO
+
+      ! Zero-size cells at closed boundaries if cell points provided,
+      ! otherwise they are closed cells with unrealistic bounds
+      IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN
+         IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
+            DO jn = 1, 4        ! (West or jpni = 1), closed E-W
+               z_bnds(jn,1,:,1) = plat_pnt(1,:)  ;  z_bnds(jn,1,:,2) = plon_pnt(1,:)
+            END DO
+         ENDIF
+         IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
+            DO jn = 1, 4        ! (East or jpni = 1), closed E-W
+               z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:)  ;  z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:)
+            END DO
+         ENDIF
+         IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN
+            DO jn = 1, 4        ! South or (jpnj = 1, not symmetric)
+               z_bnds(jn,:,1,1) = plat_pnt(:,1)  ;  z_bnds(jn,:,1,2) = plon_pnt(:,1)
+            END DO
+         ENDIF
+         IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN
+            DO jn = 1, 4        ! (North or jpnj = 1), no north fold
+               z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj)  ;  z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj)
+            END DO
+         ENDIF
+      ENDIF
+
+      ! Rotate cells at the north fold
+      IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( z_fld(ji,jj) == -1. ) THEN
+                  z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:)
+                  z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:)
+                  z_bnds(:,ji,jj,:) = z_rot(:,:)
+               ENDIF
+            END DO
+         END DO
+
+      ! Invert cells at the symmetric equator
+      ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN
+         DO ji = 1, jpi
+            z_rot(1:2,:) = z_bnds(3:4,ji,1,:)
+            z_rot(3:4,:) = z_bnds(1:2,ji,1,:)
+            z_bnds(:,ji,1,:) = z_rot(:,:)
+         END DO
+      ENDIF
+
+      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           &
+                                               bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 )
+
+      DEALLOCATE( z_bnds, z_fld, z_rot ) 
+
+   END SUBROUTINE set_grid_bounds
+
+
+   SUBROUTINE set_grid_znl( plat )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_grid_znl  ***
+      !!
+      !! ** Purpose :   define grids for zonal mean
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
+      !
+      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon
+      INTEGER  :: ni,nj, ix, iy
+
+      
+      ni=nlei-nldi+1 ; nj=nlej-nldj+1            ! define zonal mean domain (jpj*jpk)
+      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0.
+
+      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
+      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   &
+         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
+      !
+      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
+      CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo)
+      CALL iom_update_file_name('ptr')
+      !
+   END SUBROUTINE set_grid_znl
+
    SUBROUTINE set_scalar
       !!----------------------------------------------------------------------
@@ -1220,8 +1450,9 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(1) ::   zz = 1.
+      REAL(wp), DIMENSION(1)   ::   zz = 1.
       !!----------------------------------------------------------------------
       CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1)
       CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
+      
       zz=REAL(narea,wp)
       CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
@@ -1296,4 +1527,5 @@
       zlatpira = (/ -19.0, -14.0,  -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /)
       CALL set_mooring( zlonpira, zlatpira )
+
       
    END SUBROUTINE set_xmlatt
@@ -1443,4 +1675,5 @@
             END DO
 
+            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
             IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname )
             IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname )
@@ -1490,4 +1723,6 @@
       ENDIF
       
+!$AGRIF_DO_NOT_TREAT      
+! Should be fixed in the conv
       IF( llfull ) THEN 
          clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
@@ -1500,4 +1735,5 @@
          WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday                          ! date of the end of run
       ENDIF
+!$AGRIF_END_DO_NOT_TREAT      
 
    END FUNCTION iom_sdate
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 5682)
@@ -61,6 +61,6 @@
       INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters: 
 
-      CHARACTER(LEN=100) ::   clinfo           ! info character
-      CHARACTER(LEN=100) ::   cltmp            ! temporary character
+      CHARACTER(LEN=256) ::   clinfo           ! info character
+      CHARACTER(LEN=256) ::   cltmp            ! temporary character
       INTEGER            ::   iln              ! lengths of character
       INTEGER            ::   istop            ! temporary storage of nstop
@@ -393,5 +393,5 @@
       INTEGER, DIMENSION(4) :: idimsz               ! dimensions size  
       INTEGER, DIMENSION(4) :: idimid               ! dimensions id
-      CHARACTER(LEN=100)    :: clinfo               ! info character
+      CHARACTER(LEN=256)    :: clinfo               ! info character
       CHARACTER(LEN= 12), DIMENSION(4) :: cltmp     ! temporary character
       INTEGER               :: if90id               ! nf90 file identifier
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 5682)
@@ -24,5 +24,4 @@
    USE trdmxl_oce      ! ocean active mixed layer tracers trends variables
    USE divcur          ! hor. divergence and curl      (div & cur routines)
-   USE sbc_ice, ONLY : lk_lim3
 
    IMPLICIT NONE
@@ -57,12 +56,20 @@
       !!
       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
-      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name
+      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
+      CHARACTER(lc)       ::   clpath   ! full path to ocean output restart file
       !!----------------------------------------------------------------------
       !
       IF( kt == nit000 ) THEN   ! default definitions
          lrst_oce = .FALSE.   
-         nitrst = nitend
-      ENDIF
-      IF( MOD( kt - 1, nstock ) == 0 ) THEN   
+         IF( ln_rst_list ) THEN
+            nrst_lst = 1
+            nitrst = nstocklist( nrst_lst )
+         ELSE
+            nitrst = nitend
+         ENDIF
+      ENDIF
+
+      ! frequency-based restart dumping (nn_stock)
+      IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN   
          ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment
          nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
@@ -73,24 +80,30 @@
       ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1
       IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN
-         ! beware of the format used to write kt (default is i8.8, that should be large enough...)
-         IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
-         ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
-         ENDIF
-         ! create the file
-         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out)
-         IF(lwp) THEN
-            WRITE(numout,*)
-            SELECT CASE ( jprstlib )
-            CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ocean restart binary file: '//clname
-            CASE DEFAULT         ;   WRITE(numout,*) '             open ocean restart NetCDF file: '//clname
-            END SELECT
-            IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression'
-            IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt
-            ELSE                          ;   WRITE(numout,*) '             kt = '             , kt
+         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
+            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
             ENDIF
-         ENDIF
-         !
-         CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib )
-         lrst_oce = .TRUE.
+            ! create the file
+            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out)
+            clpath = TRIM(cn_ocerst_outdir)
+            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+            IF(lwp) THEN
+               WRITE(numout,*)
+               SELECT CASE ( jprstlib )
+               CASE ( jprstdimg )   ;   WRITE(numout,*)                            &
+                   '             open ocean restart binary file: ',TRIM(clpath)//clname
+               CASE DEFAULT         ;   WRITE(numout,*)                            &
+                   '             open ocean restart NetCDF file: ',TRIM(clpath)//clname
+               END SELECT
+               IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression'
+               IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt
+               ELSE                          ;   WRITE(numout,*) '             kt = '             , kt
+               ENDIF
+            ENDIF
+            !
+            CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib )
+            lrst_oce = .TRUE.
+         ENDIF
       ENDIF
       !
@@ -120,6 +133,4 @@
                      CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     )
                      CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      )
-                     !
-      IF( lk_lim3 )  CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) )
                      !
                      CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields
@@ -134,7 +145,4 @@
                      CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       )
 #endif
-                  IF( lk_lim3 ) THEN
-                     CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev'  , fraqsr_1lev     ) !clem modif
-                  ENDIF
       IF( kt == nitrst ) THEN
          CALL iom_close( numrow )     ! close the restart file (only at last time step)
@@ -142,4 +150,9 @@
 !!gm  not sure what to do here   ===>>>  ask to Sebastian
          lrst_oce = .FALSE.
+            IF( ln_rst_list ) THEN
+               nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1))
+               nitrst = nstocklist( nrst_lst )
+            ENDIF
+            lrst_oce = .FALSE.
       ENDIF
       !
@@ -156,6 +169,7 @@
       !!                the file has already been opened
       !!----------------------------------------------------------------------
-      INTEGER  ::   jlibalt = jprstlib
-      LOGICAL  ::   llok
+      INTEGER        ::   jlibalt = jprstlib
+      LOGICAL        ::   llok
+      CHARACTER(lc)  ::   clpath   ! full path to ocean output restart file
       !!----------------------------------------------------------------------
       !
@@ -171,11 +185,13 @@
          ENDIF
 
+         clpath = TRIM(cn_ocerst_indir)
+         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
          IF ( jprstlib == jprstdimg ) THEN
            ! eventually read netcdf file (monobloc)  for restarting on different number of processors
            ! if {cn_ocerst_in}.nc exists, then set jlibalt to jpnf90
-           INQUIRE( FILE = TRIM(cn_ocerst_in)//'.nc', EXIST = llok )
+           INQUIRE( FILE = TRIM(cn_ocerst_indir)//'/'//TRIM(cn_ocerst_in)//'.nc', EXIST = llok )
            IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
          ENDIF
-         CALL iom_open( cn_ocerst_in, numror, kiolib = jlibalt )
+         CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt )
       ENDIF
    END SUBROUTINE rst_read_open
@@ -214,5 +230,4 @@
          CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   )
          CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    )
-         IF( lk_lim3 )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )
       ELSE
          neuler = 0
@@ -257,14 +272,4 @@
          ENDIF
 
-         IF( lk_lim3 .AND. .NOT. lk_vvl ) THEN
-            DO jk = 1, jpk
-               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
-            END DO
-         ENDIF
-
-      ENDIF
-      !
-      IF( lk_lim3 ) THEN
-         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev )
       ENDIF
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 5682)
@@ -22,4 +22,9 @@
    USE lib_mpp          ! distributed memory computing library
 
+
+   INTERFACE lbc_lnk_multi
+      MODULE PROCEDURE mpp_lnk_2d_9
+   END INTERFACE
+
    INTERFACE lbc_lnk
       MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
@@ -39,4 +44,5 @@
 
    PUBLIC lbc_lnk       ! ocean lateral boundary conditions
+   PUBLIC lbc_lnk_multi ! modified ocean lateral boundary conditions
    PUBLIC lbc_lnk_e
    PUBLIC lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 5682)
@@ -71,4 +71,5 @@
    PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc
    PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
+   PUBLIC   mpp_lnk_2d_9 
    PUBLIC   mppscatter, mppgather
    PUBLIC   mpp_ini_ice, mpp_ini_znl
@@ -78,4 +79,8 @@
    PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb
 
+   TYPE arrayptr
+      REAL , DIMENSION (:,:),  POINTER :: pt2d
+   END TYPE arrayptr
+   
    !! * Interfaces
    !! define generic interface for these routine as they are called sometimes
@@ -164,5 +169,5 @@
 
 
-   FUNCTION mynode( ldtxt, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )
       !!----------------------------------------------------------------------
       !!                  ***  routine mynode  ***
@@ -171,4 +176,5 @@
       !!----------------------------------------------------------------------
       CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt
+      CHARACTER(len=*)             , INTENT(in   ) ::   ldname
       INTEGER                      , INTENT(in   ) ::   kumnam_ref     ! logical unit for reference namelist
       INTEGER                      , INTENT(in   ) ::   kumnam_cfg     ! logical unit for configuration namelist
@@ -292,4 +298,12 @@
       ENDIF
 
+#if defined key_agrif
+      IF (Agrif_Root()) THEN
+         CALL Agrif_MPI_Init(mpi_comm_opa)
+      ELSE
+         CALL Agrif_MPI_set_grid_comm(mpi_comm_opa)
+      ENDIF
+#endif
+
       CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
       CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )
@@ -297,6 +311,6 @@
 
       IF( mynode == 0 ) THEN
-        CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
-        WRITE(kumond, nammpp)      
+         CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
+         WRITE(kumond, nammpp)      
       ENDIF
       !
@@ -510,4 +524,290 @@
       !
    END SUBROUTINE mpp_lnk_3d
+
+   SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_multiple  ***
+      !!
+      !! ** Purpose :   Message passing management for multiple 2d arrays
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !!----------------------------------------------------------------------
+
+      INTEGER :: num_fields
+      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
+      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
+      !                                                               ! = T , U , V , F , W and I points
+      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
+      !                                                               ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL    , INTENT(in   ) ::   cd_mpp       ! fill the overlap area only
+      REAL(wp)        , OPTIONAL    , INTENT(in   ) ::   pval         ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jl   ! dummy loop indices
+      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields),  &
+         &      zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields)   )
+
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !
+      !First Array
+      DO ii = 1 , num_fields
+         IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+            !
+            ! WARNING pt2d is defined only between nld and nle
+            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+               pt2d_array(ii)%pt2d(nldi  :nlei  , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej)
+               pt2d_array(ii)%pt2d(1     :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi     , nlej)
+               pt2d_array(ii)%pt2d(nlei+1:nlci  , jj) = pt2d_array(ii)%pt2d(     nlei, nlej) 
+            END DO
+            DO ji = nlci+1, jpi                 ! added column(s) (full)
+               pt2d_array(ii)%pt2d(ji, nldj  :nlej  ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej)
+               pt2d_array(ii)%pt2d(ji, 1     :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj     )
+               pt2d_array(ii)%pt2d(ji, nlej+1:jpj   ) = pt2d_array(ii)%pt2d(nlei,      nlej)
+            END DO
+            !
+         ELSE                              ! standard close or cyclic treatment
+            !
+            !                                   ! East-West boundaries
+            IF( nbondi == 2 .AND.   &                ! Cyclic east-west
+               &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+               pt2d_array(ii)%pt2d(  1  , : ) = pt2d_array(ii)%pt2d( jpim1, : )                                    ! west
+               pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d(   2  , : )                                    ! east
+            ELSE                                     ! closed
+               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(            1 : jpreci,:) = zland    ! south except F-point
+                                                   pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi   ,:) = zland    ! north
+            ENDIF
+            !                                   ! North-South boundaries (always closed)
+               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(:,             1:jprecj ) = zland    ! south except F-point
+                                                   pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj    ) = zland    ! north
+            !
+         ENDIF
+      END DO
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      DO ii = 1 , num_fields
+         SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+            iihom = nlci-nreci
+            DO jl = 1, jpreci
+               zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : )
+               zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : )
+            END DO
+         END SELECT
+      END DO
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci - jpreci
+      !
+
+      DO ii = 1 , num_fields
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
+            END DO
+         CASE ( 0 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii)
+               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii)
+            END DO
+         END SELECT
+      END DO
+      
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      !First Array
+      DO ii = 1 , num_fields
+         IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, jprecj
+               zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl )
+               zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl )
+            END DO
+         ENDIF
+      END DO
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj - jprecj
+      !
+
+      DO ii = 1 , num_fields
+         !First Array
+         SELECT CASE ( nbondj )
+         CASE ( -1 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii )
+            END DO
+         CASE ( 0 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii)
+               pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii )
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii )
+            END DO
+         END SELECT
+      END DO
+      
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      DO ii = 1 , num_fields
+         !First Array
+         IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+            !
+            SELECT CASE ( jpni )
+            CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) )   ! only 1 northern proc, no mpp
+            CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d_array(ii)%pt2d( : , : ), type_array(ii), psgn_array(ii) )   ! for all northern procs.
+            END SELECT
+            !
+         ENDIF
+         !
+      END DO
+      
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
+      !
+   END SUBROUTINE mpp_lnk_2d_multiple
+
+   
+   SUBROUTINE load_array(pt2d,cd_type,psgn,pt2d_array, type_array, psgn_array,num_fields)
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), TARGET   ,   INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points
+      REAL(wp)                    , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary
+      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array
+      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
+      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
+      INTEGER                      , INTENT (inout):: num_fields 
+      !!---------------------------------------------------------------------
+      num_fields=num_fields+1
+      pt2d_array(num_fields)%pt2d=>pt2d
+      type_array(num_fields)=cd_type
+      psgn_array(num_fields)=psgn
+   END SUBROUTINE load_array
+   
+   
+   SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
+      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
+      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      ! Second 2D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA    
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
+      ! define the nature of ptab array grid-points
+      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
+      ! =-1 the sign change across the north fold boundary
+      REAL(wp)                                      , INTENT(in   ) ::   psgnA    
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI   
+      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array 
+      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W and I points
+      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
+      INTEGER :: num_fields
+      !!---------------------------------------------------------------------
+
+      num_fields = 0
+
+      !! Load the first array
+      CALL load_array(pt2dA,cd_typeA,psgnA,pt2d_array, type_array, psgn_array,num_fields)
+
+      !! Look if more arrays are added
+      IF(PRESENT (psgnB) )CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnC) )CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnD) )CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnE) )CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnF) )CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnG) )CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnH) )CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnI) )CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields)
+      
+      CALL mpp_lnk_2d_multiple(pt2d_array,type_array,psgn_array,num_fields,cd_mpp,pval)
+   END SUBROUTINE mpp_lnk_2d_9
 
 
@@ -3184,4 +3484,5 @@
    LOGICAL, PUBLIC            ::   ln_nnogather          !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used)
    INTEGER :: ncomm_ice
+   INTEGER, PUBLIC            ::   mpi_comm_opa          ! opa local communicator
    !!----------------------------------------------------------------------
 CONTAINS
@@ -3192,11 +3493,13 @@
    END FUNCTION lib_mpp_alloc
 
-   FUNCTION mynode( ldtxt, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value)
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value)
       INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
       CHARACTER(len=*),DIMENSION(:) ::   ldtxt
+      CHARACTER(len=*) ::   ldname
       INTEGER ::   kumnam_ref, knumnam_cfg , kumond , kstop
-      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0
+      IF( PRESENT( localComm ) ) mpi_comm_opa = localComm
+      function_value = 0
       IF( .FALSE. )   ldtxt(:) = 'never done'
-      CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
+      CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
    END FUNCTION mynode
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 5682)
@@ -45,4 +45,5 @@
       INTEGER ::  inum                        ! temporary logical unit
       INTEGER ::  idir                        ! temporary integers
+      INTEGER ::  jstartrow                   ! temporary integers
       INTEGER ::   ios                        ! Local integer output status for namelist read
       INTEGER ::   &
@@ -100,11 +101,25 @@
       ! open the file
       ! Remember that at this level in the code, mpp is not yet initialized, so
-      ! the file must be open with jpdom_unknown, and kstart amd kcount forced 
+      ! the file must be open with jpdom_unknown, and kstart and kcount forced 
+      jstartrow = 1
       IF ( ln_zco ) THEN 
          CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
-         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+          ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
+          ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
+         CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+         jstartrow = MAX(1,jstartrow)
+         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) )
       ELSE
          CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
-         CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+         IF ( ln_isfcav ) THEN
+             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+         ELSE
+             ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
+             ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
+             CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+             jstartrow = MAX(1,jstartrow)
+             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/)   &
+                &                                                   , kcount=(/jpiglo,jpjglo/) )
+         ENDIF
       ENDIF
       CALL iom_close (inum)
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90	(revision 5682)
@@ -140,4 +140,5 @@
       !!----------------------------------------------------------------------
       USE ldftra_oce, ONLY:   aht0
+      USE iom
       !
       LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
@@ -150,5 +151,5 @@
       CHARACTER (len=15) ::   clexp
       INTEGER,     POINTER, DIMENSION(:,:)  :: icof
-      INTEGER, ALLOCATABLE, DIMENSION(:,:)  :: idata
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d  ! temporary array to read ahmcoef file
       !!----------------------------------------------------------------------
       !                                
@@ -232,45 +233,12 @@
          ! Read 2d integer array to specify western boundary increase in the
          ! ===================== equatorial strip (20N-20S) defined at t-points
-         
-         ALLOCATE( idata(jpidta,jpjdta), STAT=ierror )
-         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_c2d_orca: unable to allocate idata array' )
          !
-         CALL ctl_opn( inum, 'ahmcoef', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
-         READ(inum,9101) clexp, iim, ijm
-         READ(inum,'(/)')
-         ifreq = 40
-         il1 = 1
-         DO jn = 1, jpidta/ifreq+1
-            READ(inum,'(/)')
-            il2 = MIN( jpidta, il1+ifreq-1 )
-            READ(inum,9201) ( ii, ji = il1, il2, 5 )
-            READ(inum,'(/)')
-            DO jj = jpjdta, 1, -1
-               READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 )
-            END DO
-            il1 = il1 + ifreq
-         END DO
-
-         DO jj = 1, nlcj
-            DO ji = 1, nlci
-               icof(ji,jj) = idata( mig(ji), mjg(jj) )
-            END DO
-         END DO
-         DO jj = nlcj+1, jpj
-            DO ji = 1, nlci
-               icof(ji,jj) = icof(ji,nlcj)
-            END DO
-         END DO
-         DO jj = 1, jpj
-            DO ji = nlci+1, jpi
-               icof(ji,jj) = icof(nlci,jj)
-            END DO
-         END DO
-
-9101     FORMAT(1x,a15,2i8)
-9201     FORMAT(3x,13(i3,12x))
-9202     FORMAT(i3,41i3)
-         
-         DEALLOCATE(idata)
+         ALLOCATE( ztemp2d(jpi,jpj) )
+         ztemp2d(:,:) = 0.
+         CALL iom_open ( 'ahmcoef.nc', inum )
+         CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d)
+         icof(:,:)  = NINT(ztemp2d(:,:))
+         CALL iom_close( inum )
+         DEALLOCATE(ztemp2d)
 
          ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator)
@@ -369,4 +337,5 @@
       !!----------------------------------------------------------------------
       USE ldftra_oce, ONLY:   aht0
+      USE iom
       !
       LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
@@ -380,10 +349,9 @@
       CHARACTER (len=15) ::   clexp
       INTEGER,     POINTER, DIMENSION(:,:)  :: icof
-      INTEGER, ALLOCATABLE, DIMENSION(:,:)  :: idata
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d  ! temporary array to read ahmcoef file
       !!----------------------------------------------------------------------
       !                                
       CALL wrk_alloc( jpi   , jpj   , icof  )
       !                                
-
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient'
@@ -464,47 +432,11 @@
          ! Read 2d integer array to specify western boundary increase in the
          ! ===================== equatorial strip (20N-20S) defined at t-points
-         
-         ALLOCATE( idata(jpidta,jpjdta), STAT=ierror )
-         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_c2d_orca_R1: unable to allocate idata array' )
-         !
-         CALL ctl_opn( inum, 'ahmcoef', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   &
-            &           1, numout, lwp )
-         REWIND inum
-         READ(inum,9101) clexp, iim, ijm
-         READ(inum,'(/)')
-         ifreq = 40
-         il1 = 1
-         DO jn = 1, jpidta/ifreq+1
-            READ(inum,'(/)')
-            il2 = MIN( jpidta, il1+ifreq-1 )
-            READ(inum,9201) ( ii, ji = il1, il2, 5 )
-            READ(inum,'(/)')
-            DO jj = jpjdta, 1, -1
-               READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 )
-            END DO
-            il1 = il1 + ifreq
-         END DO
-
-         DO jj = 1, nlcj
-            DO ji = 1, nlci
-               icof(ji,jj) = idata( mig(ji), mjg(jj) )
-            END DO
-         END DO
-         DO jj = nlcj+1, jpj
-            DO ji = 1, nlci
-               icof(ji,jj) = icof(ji,nlcj)
-            END DO
-         END DO
-         DO jj = 1, jpj
-            DO ji = nlci+1, jpi
-               icof(ji,jj) = icof(nlci,jj)
-            END DO
-         END DO
-
-9101     FORMAT(1x,a15,2i8)
-9201     FORMAT(3x,13(i3,12x))
-9202     FORMAT(i3,41i3)
-         
-         DEALLOCATE(idata)
+         ALLOCATE( ztemp2d(jpi,jpj) )
+         ztemp2d(:,:) = 0.
+         CALL iom_open ( 'ahmcoef.nc', inum )
+         CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d)
+         icof(:,:)  = NINT(ztemp2d(:,:))
+         CALL iom_close( inum )
+         DEALLOCATE(ztemp2d)
 
          ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator)
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90	(revision 5682)
@@ -27,4 +27,5 @@
       !!----------------------------------------------------------------------
       USE ldftra_oce, ONLY :   aht0
+      USE iom
       !!
       LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
@@ -193,4 +194,5 @@
       !!----------------------------------------------------------------------
       USE ldftra_oce, ONLY:   aht0
+      USE iom
       !!
       LOGICAL, INTENT(in) ::   ld_print   ! If true, output arrays on numout
@@ -204,11 +206,11 @@
       CHARACTER (len=15) ::   clexp
       INTEGER , POINTER, DIMENSION(:,:)  :: icof
-      INTEGER , POINTER, DIMENSION(:,:)  :: idata
       REAL(wp), POINTER, DIMENSION(:  )  :: zcoef   
       REAL(wp), POINTER, DIMENSION(:,:)  :: zahm0
+      !
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ztemp2d  ! temporary array to read ahmcoef file
       !!----------------------------------------------------------------------
       !
       CALL wrk_alloc( jpi   , jpj   , icof  )
-      CALL wrk_alloc( jpidta, jpjdta, idata )
       CALL wrk_alloc( jpk   ,         zcoef )
       CALL wrk_alloc( jpi   , jpj   , zahm0 )
@@ -221,41 +223,12 @@
       ! Read 2d integer array to specify western boundary increase in the
       ! ===================== equatorial strip (20N-20S) defined at t-points
-
-      CALL ctl_opn( inum, 'ahmcoef', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
-      READ(inum,9101) clexp, iim, ijm
-      READ(inum,'(/)')
-      ifreq = 40
-      il1 = 1
-      DO jn = 1, jpidta/ifreq+1
-         READ(inum,'(/)')
-         il2 = MIN( jpidta, il1+ifreq-1 )
-         READ(inum,9201) ( ii, ji = il1, il2, 5 )
-         READ(inum,'(/)')
-         DO jj = jpjdta, 1, -1
-            READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 )
-         END DO
-         il1 = il1 + ifreq
-      END DO
-      
-      DO jj = 1, nlcj
-         DO ji = 1, nlci
-            icof(ji,jj) = idata( mig(ji), mjg(jj) )
-         END DO
-      END DO
-      DO jj = nlcj+1, jpj
-         DO ji = 1, nlci
-            icof(ji,jj) = icof(ji,nlcj)
-         END DO
-      END DO
-      DO jj = 1, jpj
-         DO ji = nlci+1, jpi
-            icof(ji,jj) = icof(nlci,jj)
-         END DO
-      END DO
-      
-9101  FORMAT(1x,a15,2i8)
-9201  FORMAT(3x,13(i3,12x))
-9202  FORMAT(i3,41i3)
-      
+      ALLOCATE( ztemp2d(jpi,jpj) )
+      ztemp2d(:,:) = 0.
+      CALL iom_open ( 'ahmcoef.nc', inum )
+      CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d)
+      icof(:,:)  = NINT(ztemp2d(:,:))
+      CALL iom_close( inum )
+      DEALLOCATE(ztemp2d)
+
       ! Set ahm1 and ahm2
       ! =================
@@ -455,5 +428,4 @@
       !
       CALL wrk_dealloc( jpi   , jpj   , icof  )
-      CALL wrk_dealloc( jpidta, jpjdta, idata )
       CALL wrk_dealloc( jpk   ,         zcoef )
       CALL wrk_dealloc( jpi   , jpj   , zahm0 )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90	(revision 5682)
@@ -31,5 +31,5 @@
    !!----------------------------------------------------------------------
    !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id: ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z  $
+   !! $Id$
    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    !!----------------------------------------------------------------------
@@ -51,5 +51,5 @@
    !!----------------------------------------------------------------------
    !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id: ldfdyn_c3d.h90 1581 2009-08-05 14:53:12Z smasson $ 
+   !! $Id$ 
    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 5682)
@@ -142,7 +142,12 @@
             DO jj = 1, jpjm1
                DO ji = 1, jpim1
-! IF should be useless check zpshde (PM)
-               IF ( mbku(ji,jj) > 1 ) zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)
-               IF ( mbkv(ji,jj) > 1 ) zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj)
+                  zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)
+                  zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj)
+               END DO
+            END DO
+         ENDIF
+         IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
                IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 
                IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj)
@@ -151,6 +156,7 @@
          ENDIF
          !
-         zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2)
-         DO jk = 1, jpkm1
+         !==   Local vertical density gradient at T-point   == !   (evaluated from N^2)
+         ! interior value
+         DO jk = 2, jpkm1
             !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
             !                                !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0
@@ -162,9 +168,13 @@
          END DO
          ! surface initialisation 
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-              zdzr(ji,jj,1:mikt(ji,jj)) = 0._wp
-            END DO
-         END DO
+         zdzr(:,:,1) = 0._wp 
+         IF ( ln_isfcav ) THEN
+            ! if isf need to overwrite the interior value at at the first ocean point
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  zdzr(ji,jj,1:mikt(ji,jj)) = 0._wp
+               END DO
+            END DO
+         END IF
          !
          !                          !==   Slopes just below the mixed layer   ==!
@@ -175,14 +185,23 @@
          ! ===========================      | vslp = d/dj( prd ) / d/dz( prd )
          !
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = hmlpt(ji  ,jj)
-               IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = hmlpt(ji+1,jj)
-               IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj), hmlpt(ji+1,jj))
-               IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = hmlpt(ji  ,jj)
-               IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = hmlpt(ji,jj+1)
-               IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji,jj+1))
+         IF ( ln_isfcav ) THEN
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj  ),                   5._wp)
+                  IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji+1,jj  ),                   5._wp)
+                  IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj  ), hmlpt(ji+1,jj  ), 5._wp)
+                  IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj  ),                   5._wp)
+                  IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj+1),                   5._wp)
+                  IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj  ), hmlpt(ji  ,jj+1), 5._wp)
+               ENDDO
             ENDDO
-         ENDDO
+         ELSE
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zhmlpu(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji+1,jj  ), 5._wp)
+                  zhmlpv(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji  ,jj+1), 5._wp)
+               ENDDO
+            ENDDO
+         END IF
          DO jk = 2, jpkm1                            !* Slopes at u and v points
             DO jj = 2, jpjm1
@@ -198,21 +217,18 @@
                   zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav )  )
                   !                                      ! uslp and vslp output in zwz and zww, resp.
-                  zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 
-                  zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 
+                  zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj  ,jk) )
+                  zfj = MAX( omlmask(ji,jj,jk), omlmask(ji  ,jj+1,jk) )
                   ! thickness of water column between surface and level k at u/v point
-                  zdepu = 0.5_wp * (( fsdept(ji,jj,jk) + fsdept(ji+1,jj  ,jk) )                   &
-                             - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj  ) )  &
-                             - fse3u(ji,jj,miku(ji,jj))                                         )
-                  zdepv = 0.5_wp * (( fsdept(ji,jj,jk) + fsdept(ji  ,jj+1,jk) )                   &
-                             - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) &
-                             - fse3v(ji,jj,mikv(ji,jj))                                         )
-                  zwz(ji,jj,jk) = ( 1. - zfi) * zau / ( zbu - zeps )                                              &
-                     &                 + zfi  * uslpml(ji,jj)                                                     &
-                     &                        * zdepu / MAX( zhmlpu(ji,jj), 5._wp )
-                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * umask(ji,jj,jk) * umask(ji,jj,jk-1)
-                  zww(ji,jj,jk) = ( 1. - zfj) * zav / ( zbv - zeps )                                              &
-                     &                 + zfj  * vslpml(ji,jj)                                                     &
-                     &                        * zdepv / MAX( zhmlpv(ji,jj), 5._wp ) 
-                  zww(ji,jj,jk) = zww(ji,jj,jk) * vmask(ji,jj,jk) * vmask(ji,jj,jk-1)
+                  zdepu = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji+1,jj  ,jk) )                              &
+                                   - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj  ) ) - fse3u(ji,jj,miku(ji,jj)) )
+                  zdepv = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji  ,jj+1,jk) )                              &
+                                   - 2 * MAX( risfdep(ji,jj), risfdep(ji  ,jj+1) ) - fse3v(ji,jj,mikv(ji,jj)) )
+                  !
+                  zwz(ji,jj,jk) = ( 1. - zfi) * zau / ( zbu - zeps )                                          &
+                     &                 + zfi  * uslpml(ji,jj) * zdepu / zhmlpu(ji,jj)
+                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * wumask(ji,jj,jk)
+                  zww(ji,jj,jk) = ( 1. - zfj) * zav / ( zbv - zeps )                                          &
+                     &                 + zfj  * vslpml(ji,jj) * zdepv / zhmlpv(ji,jj) 
+                  zww(ji,jj,jk) = zww(ji,jj,jk) * wvmask(ji,jj,jk)
                   
                  
@@ -266,8 +282,8 @@
                   uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   &
                      &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp   &
-                     &                            *   umask(ji,jj,jk-1) !* umask(ji,jj,jk) * umask(ji,jj,jk+1)
+                     &                            *   umask(ji,jj,jk-1)
                   vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   &
                      &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp   &
-                     &                            *   vmask(ji,jj,jk-1) !* vmask(ji,jj,jk) * vmask(ji,jj,jk+1)
+                     &                            *   vmask(ji,jj,jk-1)
                END DO
             END DO
@@ -282,5 +298,5 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   !                                  !* Local vertical density gradient evaluated from N^2
-                  zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
+                  zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) * wmask(ji,jj,jk)
                   !                                  !* Slopes at w point
                   !                                        ! i- & j-gradient of density at w-points
@@ -298,10 +314,10 @@
                   zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj )  )
                   !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.)
-                  zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )    ! zfk=1 in the ML otherwise zfk=0
+                  zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0
                   zck = ( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj), 10._wp )
                   zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) &
-                     &            + zck * wslpiml(ji,jj) * zfk  ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
+                     &            + zck * wslpiml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
                   zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) &
-                     &            + zck * wslpjml(ji,jj) * zfk  ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
+                     &            + zck * wslpjml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
 
 !!gm  modif to suppress omlmask....  (as in Griffies operator)
@@ -356,6 +372,6 @@
                   zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   &
                      &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25
-                  wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * tmask(ji,jj,jk-1) * tmask(ji,jj,jk)
-                  wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * tmask(ji,jj,jk-1) * tmask(ji,jj,jk)
+                  wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * wmask(ji,jj,jk)
+                  wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * wmask(ji,jj,jk)
                END DO
             END DO
@@ -423,7 +439,7 @@
                   vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 
                   wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) &
-                    &                              * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5 
+                    &                              * wmask(ji,jj,jk) * 0.5 
                   wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) &
-                    &                              * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5 
+                    &                              * wmask(ji,jj,jk) * 0.5 
                END DO 
             END DO 
@@ -736,6 +752,8 @@
             DO ji = 1, jpi
                ik = nmln(ji,jj) - 1
-               IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN   ;   omlmask(ji,jj,jk) = 1._wp
-               ELSE                  ;   omlmask(ji,jj,jk) = 0._wp
+               IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN
+                  omlmask(ji,jj,jk) = 1._wp
+               ELSE
+                  omlmask(ji,jj,jk) = 0._wp
                ENDIF
             END DO
@@ -794,6 +812,6 @@
             zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj )  )
             !                        !- i- & j-slope at w-points (wslpiml, wslpjml)
-            wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik)
-            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik)
+            wslpiml(ji,jj) = zai / ( zbi - zeps ) * wmask (ji,jj,ik)
+            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * wmask (ji,jj,ik)
          END DO
       END DO
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90	(revision 5682)
@@ -31,5 +31,5 @@
    !!----------------------------------------------------------------------
    !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id: ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z  $
+   !! $Id$
    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 5682)
@@ -6,6 +6,4 @@
    !!======================================================================
 
-   !!----------------------------------------------------------------------
-   !!   'key_diaobs' : Switch on the observation diagnostic computation
    !!----------------------------------------------------------------------
    !!   dia_obs_init : Reading and prepare observations
@@ -15,5 +13,5 @@
    !!   fin_date     : Compute the final date YYYYMMDD.HHMMSS
    !!----------------------------------------------------------------------
-   !! * Modules used   
+   !! * Modules used
    USE wrk_nemo                 ! Memory Allocation
    USE par_kind                 ! Precision variables
@@ -21,7 +19,6 @@
    USE par_oce
    USE dom_oce                  ! Ocean space and time domain variables
-   USE obs_fbm, ONLY: ln_cl4    ! Class 4 diagnostic switch
-   USE obs_read_prof            ! Reading and allocation of observations (Coriolis)
-   USE obs_read_surf            ! Reading and allocation of SLA observations  
+   USE obs_read_prof            ! Reading and allocation of profile obs
+   USE obs_read_surf            ! Reading and allocation of surface obs
    USE obs_readmdt              ! Reading and allocation of MDT for SLA.
    USE obs_prep                 ! Preparation of obs. (grid search etc).
@@ -45,65 +42,31 @@
       &   dia_obs_dealloc  ! Deallocate dia_obs data
 
-   !! * Shared Module variables
-   LOGICAL, PUBLIC, PARAMETER :: &
-#if defined key_diaobs
-      & lk_diaobs = .TRUE.   !: Logical switch for observation diangostics
-#else
-      & lk_diaobs = .FALSE.  !: Logical switch for observation diangostics
-#endif
-
    !! * Module variables
-   LOGICAL, PUBLIC :: ln_t3d         !: Logical switch for temperature profiles
-   LOGICAL, PUBLIC :: ln_s3d         !: Logical switch for salinity profiles
-   LOGICAL, PUBLIC :: ln_sla         !: Logical switch for sea level anomalies 
-   LOGICAL, PUBLIC :: ln_sst         !: Logical switch for sea surface temperature
-   LOGICAL, PUBLIC :: ln_seaice      !: Logical switch for sea ice concentration
-   LOGICAL, PUBLIC :: ln_vel3d       !: Logical switch for velocity component (u,v) observations
-   LOGICAL, PUBLIC :: ln_ssh         !: Logical switch for sea surface height
-   LOGICAL, PUBLIC :: ln_sss         !: Logical switch for sea surface salinity
-   LOGICAL, PUBLIC :: ln_sstnight    !: Logical switch for night mean SST observations
-   LOGICAL, PUBLIC :: ln_nea         !: Remove observations near land
-   LOGICAL, PUBLIC :: ln_altbias     !: Logical switch for altimeter bias  
-   LOGICAL, PUBLIC :: ln_ignmis      !: Logical switch for ignoring missing files
-   LOGICAL, PUBLIC :: ln_s_at_t      !: Logical switch to compute model S at T observations
-
-   REAL(KIND=dp), PUBLIC :: dobsini   !: Observation window start date YYYYMMDD.HHMMSS
-   REAL(KIND=dp), PUBLIC :: dobsend   !: Observation window end date YYYYMMDD.HHMMSS
-  
-   INTEGER, PUBLIC :: numobtypes   !: Number of observation types to read in.
-   INTEGER, PUBLIC :: n1dint       !: Vertical interpolation method
-   INTEGER, PUBLIC :: n2dint       !: Horizontal interpolation method 
-   INTEGER, DIMENSION(:), ALLOCATABLE :: nvarsprof !Number of profile variables
-   INTEGER, DIMENSION(:), ALLOCATABLE :: nextrprof !Number of profile extra variables
-   INTEGER, DIMENSION(:), ALLOCATABLE :: nvarssurf !Number of surface variables
-   INTEGER, DIMENSION(:), ALLOCATABLE :: nextrsurf !Number of surface extra variables
+   LOGICAL, PUBLIC :: ln_diaobs   !: Logical switch for the obs operator
+   LOGICAL :: ln_sstnight         !: Logical switch for night mean SST obs
+
+   INTEGER :: nn_1dint       !: Vertical interpolation method
+   INTEGER :: nn_2dint       !: Horizontal interpolation method
    INTEGER, DIMENSION(imaxavtypes) :: &
-      & dailyavtypes !: Data types which are daily average
-
-   TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: surfdata   ! Initial surface data
-   TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: surfdataqc ! Surface data after quality control
-   TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: profdata   ! Initial profile data
-   TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: profdataqc ! Profile data after quality control
-
-   CHARACTER(len=6),   PUBLIC, DIMENSION(:),   ALLOCATABLE :: obstypesprof
-   CHARACTER(len=6),   PUBLIC, DIMENSION(:),   ALLOCATABLE :: obstypessurf
-
-
-      
-   INTEGER, PARAMETER :: MaxNumFiles = 1000
-   
-   LOGICAL, DIMENSION(MaxNumFiles) :: &
-      & ln_profb_ena, & !: Is the feedback files from ENACT data ?
-   !                    !: If so use dailyavtypes
-      & ln_profb_enatim !: Change tim for 820 enact data set.
-   
-   LOGICAL, DIMENSION(MaxNumFiles) :: &
-      & ln_velfb_av   !: Is the velocity feedback files daily average?
-   LOGICAL, DIMENSION(:), ALLOCATABLE :: &
-      & ld_enact     !: Profile data is ENACT so use dailyavtypes
-   LOGICAL, DIMENSION(:), ALLOCATABLE :: &
-      & ld_velav     !: Velocity data is daily averaged
-   LOGICAL, DIMENSION(:), ALLOCATABLE :: &
-      & ld_sstnight  !: SST observation corresponds to night mean
+      & nn_profdavtypes      !: Profile data types representing a daily average
+   INTEGER :: nproftypes     !: Number of profile obs types
+   INTEGER :: nsurftypes     !: Number of surface obs types
+   INTEGER, DIMENSION(:), ALLOCATABLE :: &
+      & nvarsprof, &         !: Number of profile variables
+      & nvarssurf            !: Number of surface variables
+   INTEGER, DIMENSION(:), ALLOCATABLE :: &
+      & nextrprof, &         !: Number of profile extra variables
+      & nextrsurf            !: Number of surface extra variables
+
+   TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: &
+      & surfdata, &          !: Initial surface data
+      & surfdataqc           !: Surface data after quality control
+   TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: &
+      & profdata, &          !: Initial profile data
+      & profdataqc           !: Profile data after quality control
+
+   CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE :: &
+      & cobstypesprof, &     !: Profile obs types
+      & cobstypessurf        !: Surface obs types
 
    !!----------------------------------------------------------------------
@@ -136,119 +99,184 @@
 
       !! * Local declarations
-      CHARACTER(len=128) :: profbfiles(MaxNumFiles)
-      CHARACTER(len=128) :: sstfbfiles(MaxNumFiles)
-      CHARACTER(len=128) :: slafbfiles(MaxNumFiles)
-      CHARACTER(len=128) :: seaicefbfiles(MaxNumFiles)
-      CHARACTER(len=128) :: velfbfiles(MaxNumFiles)
-      CHARACTER(LEN=128) :: bias_file
-      CHARACTER(LEN=20)  :: datestr=" ", timestr=" "
-
-      NAMELIST/namobs/ln_t3d, ln_s3d, ln_sla, ln_sss, ln_ssh,         &
-         &            ln_sst, ln_seaice, ln_vel3d,                    &
+      INTEGER, PARAMETER :: &
+         & jpmaxnfiles = 1000    ! Maximum number of files for each obs type
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & ifilesprof, &         ! Number of profile files
+         & ifilessurf            ! Number of surface files
+      INTEGER :: ios             ! Local integer output status for namelist read
+      INTEGER :: jtype           ! Counter for obs types
+      INTEGER :: jvar            ! Counter for variables
+      INTEGER :: jfile           ! Counter for files
+
+      CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: &
+         & cn_profbfiles, &      ! T/S profile input filenames
+         & cn_sstfbfiles, &      ! Sea surface temperature input filenames
+         & cn_slafbfiles, &      ! Sea level anomaly input filenames
+         & cn_sicfbfiles, &      ! Seaice concentration input filenames
+         & cn_velfbfiles         ! Velocity profile input filenames
+      CHARACTER(LEN=128) :: &
+         & cn_altbiasfile        ! Altimeter bias input filename
+      CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: &
+         & clproffiles, &        ! Profile filenames
+         & clsurffiles           ! Surface filenames
+
+      LOGICAL :: ln_t3d          ! Logical switch for temperature profiles
+      LOGICAL :: ln_s3d          ! Logical switch for salinity profiles
+      LOGICAL :: ln_sla          ! Logical switch for sea level anomalies 
+      LOGICAL :: ln_sst          ! Logical switch for sea surface temperature
+      LOGICAL :: ln_sic          ! Logical switch for sea ice concentration
+      LOGICAL :: ln_vel3d        ! Logical switch for velocity (u,v) obs
+      LOGICAL :: ln_nea          ! Logical switch to remove obs near land
+      LOGICAL :: ln_altbias      ! Logical switch for altimeter bias
+      LOGICAL :: ln_ignmis       ! Logical switch for ignoring missing files
+      LOGICAL :: ln_s_at_t       ! Logical switch to compute model S at T obs
+      LOGICAL :: llvar1          ! Logical for profile variable 1
+      LOGICAL :: llvar2          ! Logical for profile variable 1
+      LOGICAL :: llnightav       ! Logical for calculating night-time averages
+
+      REAL(dp) :: rn_dobsini     ! Obs window start date YYYYMMDD.HHMMSS
+      REAL(dp) :: rn_dobsend     ! Obs window end date   YYYYMMDD.HHMMSS
+      REAL(wp), DIMENSION(jpi,jpj) :: &
+         & zglam1, &             ! Model longitudes for profile variable 1
+         & zglam2                ! Model longitudes for profile variable 2
+      REAL(wp), DIMENSION(jpi,jpj) :: &
+         & zgphi1, &             ! Model latitudes for profile variable 1
+         & zgphi2                ! Model latitudes for profile variable 2
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
+         & zmask1, &             ! Model land/sea mask associated with variable 1
+         & zmask2                ! Model land/sea mask associated with variable 2
+
+      NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla,              &
+         &            ln_sst, ln_sic, ln_vel3d,                       &
          &            ln_altbias, ln_nea, ln_grid_global,             &
-         &            ln_grid_search_lookup, ln_cl4,                  &
+         &            ln_grid_search_lookup,                          &
          &            ln_ignmis, ln_s_at_t, ln_sstnight,              &
-         &            ln_profb_ena, ln_profb_enatim,                  &
-         &            profbfiles, slafbfiles, sssfbfiles,             &
-         &            sshfbfiles, sstfbfiles, seaicefbfiles,          &
-         &            velfbfiles, bias_file, grid_search_file,        &
-         &            dobsini, dobsend, n1dint, n2dint,               &
-         &            nmsshc, mdtcorr, mdtcutoff,                     &
-         &            grid_search_res, dailyavtypes
-
-      INTEGER :: jtype
-      INTEGER :: ios                 ! Local integer output status for namelist read
-      INTEGER, DIMENSION(:), ALLOCATABLE :: jnumfilesprof
-      INTEGER, DIMENSION(:), ALLOCATABLE :: jnumfilessurf
-      CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: obsfilesprof
-      CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: obsfilessurf
-      LOGICAL :: lmask(MaxNumFiles)
+         &            cn_profbfiles, cn_slafbfiles,                   &
+         &            cn_sstfbfiles, cn_sicfbfiles,                   &
+         &            cn_velfbfiles, cn_altbiasfile,                  &
+         &            cn_gridsearchfile, rn_gridsearchres,            &
+         &            rn_dobsini, rn_dobsend, nn_1dint, nn_2dint,     &
+         &            nn_msshc, rn_mdtcorr, rn_mdtcutoff,             &
+         &            nn_profdavtypes
+
       !-----------------------------------------------------------------------
       ! Read namelist parameters
       !-----------------------------------------------------------------------
 
-      profbfiles(:) = ''
-      slafbfiles(:) = ''
-      sstfbfiles(:) = ''
-      seaicefbfiles(:) = ''
-      velfbfiles(:) = ''
-      dailyavtypes(:) = -1
-      dailyavtypes(1) = 820
-      ln_profb_ena(:) = .FALSE.
-      ln_profb_enatim(:) = .TRUE.
-      ln_velfb_av(:) = .FALSE.
-      ln_ignmis = .FALSE.
-
-      CALL ini_date( dobsini )
-      CALL fin_date( dobsend )
-
-      ! Read Namelist namobs : control observation diagnostics
-      REWIND( numnam_ref )              ! Namelist namobs in reference namelist : Diagnostic: control observation
+      ! Some namelist arrays need initialising
+      cn_profbfiles(:) = ''
+      cn_slafbfiles(:) = ''
+      cn_sstfbfiles(:) = ''
+      cn_sicfbfiles(:) = ''
+      cn_velfbfiles(:) = ''
+      nn_profdavtypes(:) = -1
+
+      CALL ini_date( rn_dobsini )
+      CALL fin_date( rn_dobsend )
+
+      ! Read namelist namobs : control observation diagnostics
+      REWIND( numnam_ref )   ! Namelist namobs in reference namelist
       READ  ( numnam_ref, namobs, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in reference namelist', lwp )
 
-      REWIND( numnam_cfg )              ! Namelist namobs in configuration namelist : Diagnostic: control observation
+      REWIND( numnam_cfg )   ! Namelist namobs in configuration namelist
       READ  ( numnam_cfg, namobs, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namobs )
 
-      !Set up list of observation types to be used
-      numproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d /) )
-      numsurftypes = COUNT( (/ln_sla, ln_sss, ln_sst, ln_seaice /) )
-      IF ( numproftypes > 0 ) THEN
-      
-         ALLOCATE( obstypesprof(numproftypes) )
-         ALLOCATE( jnumfilesprof(numproftypes) )
-         ALLOCATE( obsfilesprof(numproftypes, MaxNumFiles) )
-      
-         DO jtype = 1, numproftypes
-            IF (ln_t3d .OR. ln_s3d) THEN
-               obsfilesprof(:,jtype) = profbfiles(:)
-               obstypesprof(jtype) = 'prof'
-            ENDIF
-            IF (ln_vel3d) THEN
-               obsfilesprof(:,jtype) = velfbfiles(:)
-               obstypesprof(jtype) = 'vel'
-            ENDIF
-         
-            lmask(:) = .FALSE.
-            WHERE (obsfilesprof(jtype,:) /= '') lmask(:) = .TRUE.
-            jnumfilesprof(jtype) = COUNT(lmask)
-         END DO
-         
-      ENDIF
-      
-      IF ( numsurftypes > 0 ) THEN
-      
-         ALLOCATE( obstypessurf(numsurftypes) )
-         ALLOCATE( jnumfilessurf(numproftypes) )
-         ALLOCATE( obsfilessurf(numsurftypes, MaxNumFiles) )
-         
-         DO jtype = 1, numsurftypes
-            IF (ln_sla) THEN
-               obsfilessurf(:,jtype) = slafbfiles(:)
-               obstypessurf(jtype) = 'sla'
-            ENDIF
-            IF (ln_sss) THEN
-               obsfilessurf(:,jtype) = sssfbfiles(:)
-               obstypessurf(jtype) = 'sss'
-            ENDIF
-            IF (ln_sst) THEN
-               obsfilessurf(:,jtype) = sstfbfiles(:)
-               obstypessurf(jtype) = 'sst'
-            ENDIF
+      IF ( .NOT. ln_diaobs ) THEN
+         IF(lwp) WRITE(numout,cform_war)
+         IF(lwp) WRITE(numout,*)' ln_diaobs is set to false so not calling dia_obs'
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Set up list of observation types to be used
+      ! and the files associated with each type
+      !-----------------------------------------------------------------------
+
+      nproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d /) )
+      nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic /) )
+
+      IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN
+         IF(lwp) WRITE(numout,cform_war)
+         IF(lwp) WRITE(numout,*) ' ln_diaobs is set to true, but all obs operator logical flags', &
+            &                    ' ln_t3d, ln_s3d, ln_sla, ln_sst, ln_sic, ln_vel3d', &
+            &                    ' are set to .FALSE. so turning off calls to dia_obs'
+         nwarn = nwarn + 1
+         ln_diaobs = .FALSE.
+         RETURN
+      ENDIF
+
+      IF ( nproftypes > 0 ) THEN
+
+         ALLOCATE( cobstypesprof(nproftypes) )
+         ALLOCATE( ifilesprof(nproftypes) )
+         ALLOCATE( clproffiles(nproftypes,jpmaxnfiles) )
+
+         jtype = 0
+         IF (ln_t3d .OR. ln_s3d) THEN
+            jtype = jtype + 1
+            clproffiles(jtype,:) = cn_profbfiles(:)
+            cobstypesprof(jtype) = 'prof  '
+            ifilesprof(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clproffiles(jtype,jfile)) /= '' ) &
+                  ifilesprof(jtype) = ifilesprof(jtype) + 1
+            END DO
+         ENDIF
+         IF (ln_vel3d) THEN
+            jtype = jtype + 1
+            clproffiles(jtype,:) = cn_velfbfiles(:)
+            cobstypesprof(jtype) = 'vel   '
+            ifilesprof(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clproffiles(jtype,jfile)) /= '' ) &
+                  ifilesprof(jtype) = ifilesprof(jtype) + 1
+            END DO
+         ENDIF
+
+      ENDIF
+
+      IF ( nsurftypes > 0 ) THEN
+
+         ALLOCATE( cobstypessurf(nsurftypes) )
+         ALLOCATE( ifilessurf(nsurftypes) )
+         ALLOCATE( clsurffiles(nsurftypes, jpmaxnfiles) )
+
+         jtype = 0
+         IF (ln_sla) THEN
+            jtype = jtype + 1
+            clsurffiles(jtype,:) = cn_slafbfiles(:)
+            cobstypessurf(jtype) = 'sla   '
+            ifilessurf(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) &
+                  ifilessurf(jtype) = ifilessurf(jtype) + 1
+            END DO
+         ENDIF
+         IF (ln_sst) THEN
+            jtype = jtype + 1
+            clsurffiles(jtype,:) = cn_sstfbfiles(:)
+            cobstypessurf(jtype) = 'sst   '
+            ifilessurf(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) &
+                  ifilessurf(jtype) = ifilessurf(jtype) + 1
+            END DO
+         ENDIF
 #if defined key_lim2 || defined key_lim3
-            IF (ln_seaice) THEN
-               obsfilessurf(:,jtype) = seaicefbfiles(:)
-               obstypessurf(jtype) = 'seaice'
-            ENDIF
+         IF (ln_sic) THEN
+            jtype = jtype + 1
+            clsurffiles(jtype,:) = cn_sicfbfiles(:)
+            cobstypessurf(jtype) = 'sic   '
+            ifilessurf(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) &
+                  ifilessurf(jtype) = ifilessurf(jtype) + 1
+            END DO
+         ENDIF
 #endif
 
-            lmask(:) = .FALSE.
-            WHERE (obsfilessurf(jtype,:) /= '') lmask(:) = .TRUE.
-            jnumfilessurf(jtype) = COUNT(lmask)
-         
-         END DO
-         
       ENDIF
 
@@ -259,52 +287,54 @@
          WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) '          Namelist namobs : set observation diagnostic parameters' 
-         WRITE(numout,*) '             Logical switch for T profile observations          ln_t3d = ', ln_t3d
-         WRITE(numout,*) '             Logical switch for S profile observations          ln_s3d = ', ln_s3d
-         WRITE(numout,*) '             Logical switch for SLA observations                ln_sla = ', ln_sla
-         WRITE(numout,*) '             Logical switch for SSH observations                ln_ssh = ', ln_ssh
-         WRITE(numout,*) '             Logical switch for SST observations                ln_sst = ', ln_sst
-         WRITE(numout,*) '             Logical switch for night-time SST obs         ln_sstnight = ', ln_sstnight
-         WRITE(numout,*) '             Logical switch for SSS observations                ln_sss = ', ln_sss
-         WRITE(numout,*) '             Logical switch for Sea Ice observations         ln_seaice = ', ln_seaice
-         WRITE(numout,*) '             Logical switch for velocity observations         ln_vel3d = ', ln_vel3d
-         WRITE(numout,*) '             Global distribution of observations        ln_grid_global = ',ln_grid_global
-         WRITE(numout,*) &
-   '             Logical switch for obs grid search w/lookup table  ln_grid_search_lookup = ',ln_grid_search_lookup
+         WRITE(numout,*) '             Logical switch for T profile observations                ln_t3d = ', ln_t3d
+         WRITE(numout,*) '             Logical switch for S profile observations                ln_s3d = ', ln_s3d
+         WRITE(numout,*) '             Logical switch for SLA observations                      ln_sla = ', ln_sla
+         WRITE(numout,*) '             Logical switch for SST observations                      ln_sst = ', ln_sst
+         WRITE(numout,*) '             Logical switch for Sea Ice observations                  ln_sic = ', ln_sic
+         WRITE(numout,*) '             Logical switch for velocity observations               ln_vel3d = ', ln_vel3d
+         WRITE(numout,*) '             Global distribution of observations              ln_grid_global = ',ln_grid_global
+         WRITE(numout,*) '             Logical switch for obs grid search lookup ln_grid_search_lookup = ',ln_grid_search_lookup
          IF (ln_grid_search_lookup) &
-            WRITE(numout,*) '             Grid search lookup file header       grid_search_file = ', grid_search_file
-         WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS        dobsini = ', dobsin
-         WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS          dobsend = ', dobsend
-         WRITE(numout,*) '             Type of vertical interpolation method          n1dint = ', n1dint
-         WRITE(numout,*) '             Type of horizontal interpolation method        n2dint = ', n2dint
-         WRITE(numout,*) '             Rejection of observations near land swithch    ln_nea = ', ln_nea
-         WRITE(numout,*) '             MSSH correction scheme                         nmsshc = ', nmsshc
-         WRITE(numout,*) '             MDT  correction                               mdtcorr = ', mdtcorr
-         WRITE(numout,*) '             MDT cutoff for computed correction          mdtcutoff = ', mdtcutoff
-         WRITE(numout,*) '             Logical switch for alt bias                ln_altbias = ', ln_altbias
-         WRITE(numout,*) '             Logical switch for ignoring missing files   ln_ignmis = ', ln_ignmis
-         WRITE(numout,*) '             Daily average types                                   = ', dailyavtypes
-
-         IF ( numproftypes > 0 ) THEN
-            DO jtype = 1, numproftypes
-               DO ji = 1, jnumfilesprof(jtype)
-                  WRITE(numout,'(1X,2A)') '             '//obstypesprof(jtype)//' input observation file names  = ', &
-                     TRIM(obsfilesprof(jtype,ji))
-                  IF ( TRIM(obstypesprof(jtype)) == 'prof' ) &
-                     WRITE(numout,'(1X,2A)') '       Enact feedback input time setting switch    ln_profb_enatim = ', ln_profb_enatim(ji)
+            WRITE(numout,*) '             Grid search lookup file header                cn_gridsearchfile = ', cn_gridsearchfile
+         WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS               rn_dobsini = ', rn_dobsini
+         WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS                 rn_dobsend = ', rn_dobsend
+         WRITE(numout,*) '             Type of vertical interpolation method                  nn_1dint = ', nn_1dint
+         WRITE(numout,*) '             Type of horizontal interpolation method                nn_2dint = ', nn_2dint
+         WRITE(numout,*) '             Rejection of observations near land switch               ln_nea = ', ln_nea
+         WRITE(numout,*) '             MSSH correction scheme                                 nn_msshc = ', nn_msshc
+         WRITE(numout,*) '             MDT  correction                                      rn_mdtcorr = ', rn_mdtcorr
+         WRITE(numout,*) '             MDT cutoff for computed correction                 rn_mdtcutoff = ', rn_mdtcutoff
+         WRITE(numout,*) '             Logical switch for alt bias                          ln_altbias = ', ln_altbias
+         WRITE(numout,*) '             Logical switch for ignoring missing files             ln_ignmis = ', ln_ignmis
+         WRITE(numout,*) '             Daily average types                             nn_profdavtypes = ', nn_profdavtypes
+         WRITE(numout,*) '             Logical switch for night-time SST obs               ln_sstnight = ', ln_sstnight
+         WRITE(numout,*) '          Number of profile obs types: ',nproftypes
+
+         IF ( nproftypes > 0 ) THEN
+            DO jtype = 1, nproftypes
+               DO jfile = 1, ifilesprof(jtype)
+                  WRITE(numout,'(1X,2A)') '             '//cobstypesprof(jtype)//' input observation file names  = ', &
+                     TRIM(clproffiles(jtype,jfile))
                END DO
             END DO
          ENDIF
-         
-         IF ( numsurftypes > 0 ) THEN
-            DO jtype = 1, numsurftypes
-               DO ji = 1, jnumfilessurf(jtype)
-                  WRITE(numout,'(1X,2A)') '             '//obstypessurf(jtype)//' input observation file names  = ', &
-                     TRIM(obsfilessurf(jtype,ji))
+
+         WRITE(numout,*)'          Number of surface obs types: ',nsurftypes
+         IF ( nsurftypes > 0 ) THEN
+            DO jtype = 1, nsurftypes
+               DO jfile = 1, ifilessurf(jtype)
+                  WRITE(numout,'(1X,2A)') '             '//cobstypessurf(jtype)//' input observation file names  = ', &
+                     TRIM(clsurffiles(jtype,jfile))
                END DO
             END DO
          ENDIF
-
-      ENDIF
-      
+         WRITE(numout,*) '~~~~~~~~~~~~'
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Obs operator parameter checking and initialisations
+      !-----------------------------------------------------------------------
+
       IF ( ln_vel3d .AND. ( .NOT. ln_grid_global ) ) THEN
          CALL ctl_stop( 'Velocity data only works with ln_grid_global=.true.' )
@@ -312,97 +342,113 @@
       ENDIF
 
-      CALL obs_typ_init
-      
-      CALL mppmap_init
-      
-      ! Parameter control
-#if defined key_diaobs
-      IF ( numobtypes == 0 ) THEN
-         IF(lwp) WRITE(numout,cform_war)
-         IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', &
-            &                    ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d are all set to .FALSE.'
-         nwarn = nwarn + 1
-      ENDIF
-#endif
-
-      CALL obs_grid_setup( )
-      IF ( ( n1dint < 0 ).OR.( n1dint > 1 ) ) THEN
+      IF ( ( nn_1dint < 0 ) .OR. ( nn_1dint > 1 ) ) THEN
          CALL ctl_stop(' Choice of vertical (1D) interpolation method', &
             &                    ' is not available')
       ENDIF
-      IF ( ( n2dint < 0 ).OR.( n2dint > 4 ) ) THEN
+
+      IF ( ( nn_2dint < 0 ) .OR. ( nn_2dint > 4 ) ) THEN
          CALL ctl_stop(' Choice of horizontal (2D) interpolation method', &
             &                    ' is not available')
       ENDIF
 
+      CALL obs_typ_init
+
+      CALL mppmap_init
+
+      CALL obs_grid_setup( )
+
       !-----------------------------------------------------------------------
       ! Depending on switches read the various observation types
       !-----------------------------------------------------------------------
-      
-      IF ( numproftypes > 0 ) THEN
-      
-         ALLOCATE(profdata(numproftypes))
-         ALLOCATE(profdataqc(numproftypes))
-         ALLOCATE(nvarsprof(numproftypes))
-         ALLOCATE(nextrprof(numproftypes))
-            
-         DO jtype = 1, numproftypes
-      
+
+      IF ( nproftypes > 0 ) THEN
+
+         ALLOCATE(profdata(nproftypes))
+         ALLOCATE(profdataqc(nproftypes))
+         ALLOCATE(nvarsprof(nproftypes))
+         ALLOCATE(nextrprof(nproftypes))
+
+         DO jtype = 1, nproftypes
+
             nvarsprof(jtype) = 2
-            IF ( TRIM(obstypesprof(jtype)) == 'prof' ) nextrprof(jtype) = 1
-            IF ( TRIM(obstypesprof(jtype)) == 'vel' )  nextrprof(jtype) = 2
-
-            !Read in profile or velocity obs types
-            CALL obs_rea_prof( profdata(jtype),          &
-               &               jnumfilesprof(jtype),       &
-               &               obsfilesprof(jtype,1:jnumfilesprof(jtype)), &
-               &               nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2,             &
-               &               dobsini, dobsend, ln_t3d, ln_s3d, &
-               &               ln_ignmis, ln_s_at_t, .TRUE., .FALSE., &
-               &               kdailyavtypes = dailyavtypes )
-            
-            DO jvar = 1, nvars
+            IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN
+               nextrprof(jtype) = 1
+               llvar1 = ln_t3d
+               llvar2 = ln_s3d
+               zglam1 = glamt
+               zgphi1 = gphit
+               zmask1 = tmask
+               zglam2 = glamt
+               zgphi2 = gphit
+               zmask2 = tmask
+            ENDIF
+            IF ( TRIM(cobstypesprof(jtype)) == 'vel' )  THEN
+               nextrprof(jtype) = 2
+               llvar1 = ln_vel3d
+               llvar2 = ln_vel3d
+               zglam1 = glamu
+               zgphi1 = gphiu
+               zmask1 = umask
+               zglam2 = glamv
+               zgphi2 = gphiv
+               zmask2 = vmask
+            ENDIF
+
+            !Read in profile or profile obs types
+            CALL obs_rea_prof( profdata(jtype), ifilesprof(jtype),       &
+               &               clproffiles(jtype,1:ifilesprof(jtype)), &
+               &               nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, &
+               &               rn_dobsini, rn_dobsend, llvar1, llvar2, &
+               &               ln_ignmis, ln_s_at_t, .FALSE., &
+               &               kdailyavtypes = nn_profdavtypes )
+
+            DO jvar = 1, nvarsprof(jtype)
                CALL obs_prof_staend( profdata(jtype), jvar )
             END DO
-         
-            CALL obs_pre_prof( profdata(jtype), profdataqc(jtype),   &
-               &              ln_t3d, ln_s3d, ln_nea, &
-               &              kdailyavtypes = dailyavtypes )
+
+            CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), &
+               &               llvar1, llvar2, &
+               &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  &
+               &               ln_nea, kdailyavtypes = nn_profdavtypes )
 
          END DO
 
-         DEALLOCATE( jnumfilesprof, obsfilesprof )
-
-      ENDIF
-
-      IF ( numsurftypes > 0 ) THEN
-      
-         ALLOCATE(surfdata(numsurftypes))
-         ALLOCATE(surfdatatqc(numsurftypes))
-         ALLOCATE(nvarssurf(numsurftypes))
-         ALLOCATE(nextrsurf(numsurftypes))
-         
-         DO jtype = 1, numsurftypes
-      
+         DEALLOCATE( ifilesprof, clproffiles )
+
+      ENDIF
+
+      IF ( nsurftypes > 0 ) THEN
+
+         ALLOCATE(surfdata(nsurftypes))
+         ALLOCATE(surfdataqc(nsurftypes))
+         ALLOCATE(nvarssurf(nsurftypes))
+         ALLOCATE(nextrsurf(nsurftypes))
+
+         DO jtype = 1, nsurftypes
+
             nvarssurf(jtype) = 1
             nextrsurf(jtype) = 0
-            IF ( TRIM(obstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2
+            llnightav = .FALSE.
+            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2
+            IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) llnightav = ln_sstnight
 
             !Read in surface obs types
-            CALL obs_rea_surf( surfdata(jtype), jnumfilessurf(jtype), &
-               &               obsfilessurf(jtype,1:jnumfilessurf(jtype)), &
+            CALL obs_rea_surf( surfdata(jtype), ifilessurf(jtype), &
+               &               clsurffiles(jtype,1:ifilessurf(jtype)), &
                &               nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, &
-               &               dobsini, dobsend, ln_ignmis, .FALSE. )
+               &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav )
 
             CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea )
-         
-            IF ( TRIM(obstypessurf(jtype)) == 'sla' ) THEN
-               CALL obs_rea_mdt( surfdataqc(jtype), n2dint )
-               IF ( ln_altbias ) CALL obs_rea_altbias ( surfdataqc(jtype), n2dint, bias_file )
+
+            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN
+               CALL obs_rea_mdt( surfdataqc(jtype), nn_2dint )
+               IF ( ln_altbias ) CALL obs_rea_altbias ( surfdataqc(jtype), nn_2dint, cn_altbiasfile )
             ENDIF
 
-            DEALLOCATE( jnumfilessurf, obsfilessurf )
-
          END DO
+
+         DEALLOCATE( ifilessurf, clsurffiles )
+
+      ENDIF
 
    END SUBROUTINE dia_obs_init
@@ -415,13 +461,9 @@
       !!
       !! ** Method  : Call the observation operators on each time step to
-      !!              compute the model equivalent of the following date:
-      !!               - T profiles
-      !!               - S profiles
-      !!               - Sea surface height (referenced to a mean)
-      !!               - Sea surface temperature
-      !!               - Sea surface salinity
-      !!               - Velocity component (U,V) profiles
-      !!
-      !! ** Action  : 
+      !!              compute the model equivalent of the following data:
+      !!               - Profile data, currently T/S or U/V
+      !!               - Surface data, currently SST, SLA or sea-ice concentration.
+      !!
+      !! ** Action  :
       !!
       !! History :
@@ -432,22 +474,20 @@
       !!        !  07-04  (G. Smith) Generalized surface operators
       !!        !  08-10  (M. Valdivieso) obs operator for velocity profiles
+      !!        !  15-08  (M. Martin) Combined surface/profile routines.
       !!----------------------------------------------------------------------
       !! * Modules used
-      USE dom_oce, ONLY : &             ! Ocean space and time domain variables
-         & rdt,           &                       
-         & gdept_1d,       &             
-         & tmask, umask, vmask                            
-      USE phycst, ONLY : &              ! Physical constants
-         & rday                         
-      USE oce, ONLY : &                 ! Ocean dynamics and tracers variables
-         & tsn,  &             
-         & un, vn,  &
+      USE phycst, ONLY : &         ! Physical constants
+         & rday
+      USE oce, ONLY : &            ! Ocean dynamics and tracers variables
+         & tsn,       &
+         & un,        &
+         & vn,        &
          & sshn
 #if defined  key_lim3
-      USE ice, ONLY : &                     ! LIM Ice model variables
+      USE ice, ONLY : &            ! LIM3 Ice model variables
          & frld
 #endif
 #if defined key_lim2
-      USE ice_2, ONLY : &                     ! LIM Ice model variables
+      USE ice_2, ONLY : &          ! LIM2 Ice model variables
          & frld
 #endif
@@ -455,14 +495,27 @@
 
       !! * Arguments
-      INTEGER, INTENT(IN) :: kstp                         ! Current timestep
+      INTEGER, INTENT(IN) :: kstp  ! Current timestep
       !! * Local declarations
-      INTEGER :: idaystp                ! Number of timesteps per day
-      INTEGER :: jtype                  ! data loop variable
-      INTEGER :: jvar                   ! Variable number    
+      INTEGER :: idaystp           ! Number of timesteps per day
+      INTEGER :: jtype             ! Data loop variable
+      INTEGER :: jvar              ! Variable number
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
+         & zprofvar1, &            ! Model values for 1st variable in a prof ob
+         & zprofvar2               ! Model values for 2nd variable in a prof ob
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
+         & zprofmask1, &           ! Mask associated with zprofvar1
+         & zprofmask2              ! Mask associated with zprofvar2
+      REAL(wp), DIMENSION(jpi,jpj)     :: &
+         & zsurfvar                ! Model values equivalent to surface ob.
+      REAL(wp), DIMENSION(jpi,jpj) :: &
+         & zglam1,    &            ! Model longitudes for prof variable 1
+         & zglam2,    &            ! Model longitudes for prof variable 2
+         & zgphi1,    &            ! Model latitudes for prof variable 1
+         & zgphi2                  ! Model latitudes for prof variable 2
 #if ! defined key_lim2 && ! defined key_lim3
-      REAL(wp), POINTER, DIMENSION(:,:) :: frld   
+      REAL(wp), POINTER, DIMENSION(:,:) :: frld
 #endif
-      CHARACTER(LEN=20) :: datestr=" ",timestr=" "
- 
+      LOGICAL :: llnightav        ! Logical for calculating night-time average
+
 #if ! defined key_lim2 && ! defined key_lim3
       CALL wrk_alloc(jpi,jpj,frld) 
@@ -473,4 +526,5 @@
          WRITE(numout,*) 'dia_obs : Call the observation operators', kstp
          WRITE(numout,*) '~~~~~~~'
+         CALL FLUSH(numout)
       ENDIF
 
@@ -484,57 +538,70 @@
 #endif
       !-----------------------------------------------------------------------
-      ! Depending on switches call various observation operators
-      !-----------------------------------------------------------------------
-
-      IF ( numproftypes > 0 ) THEN
-         DO jtype = 1, numproftypes
-      
-            SELECT CASE ( TRIM(obstypesprof(jtype)) )
+      ! Call the profile and surface observation operators
+      !-----------------------------------------------------------------------
+
+      IF ( nproftypes > 0 ) THEN
+
+         DO jtype = 1, nproftypes
+
+            SELECT CASE ( TRIM(cobstypesprof(jtype)) )
             CASE('prof')
-               profvar1(:,:,:) = tsn(:,:,:,jp_tem)
-               profvar2(:,:,:) = tsn(:,:,:,jp_sal)
-               profmask1(:,:,:) = tmask(:,:,:)
-               profmask2(:,:,:) = tmask(:,:,:)
+               zprofvar1(:,:,:) = tsn(:,:,:,jp_tem)
+               zprofvar2(:,:,:) = tsn(:,:,:,jp_sal)
+               zprofmask1(:,:,:) = tmask(:,:,:)
+               zprofmask2(:,:,:) = tmask(:,:,:)
+               zglam1(:,:) = glamt(:,:)
+               zglam2(:,:) = glamt(:,:)
+               zgphi1(:,:) = gphit(:,:)
+               zgphi2(:,:) = gphit(:,:)
             CASE('vel')
-               profvar1(:,:,:) = un(:,:,:)
-               profvar2(:,:,:) = vn(:,:,:)
-               profmask1(:,:,:) = umask(:,:,:)
-               profmask2(:,:,:) = vmask(:,:,:)
+               zprofvar1(:,:,:) = un(:,:,:)
+               zprofvar2(:,:,:) = vn(:,:,:)
+               zprofmask1(:,:,:) = umask(:,:,:)
+               zprofmask2(:,:,:) = vmask(:,:,:)
+               zglam1(:,:) = glamu(:,:)
+               zglam2(:,:) = glamv(:,:)
+               zgphi1(:,:) = gphiu(:,:)
+               zgphi2(:,:) = gphiv(:,:)
             END SELECT
-            
-            CALL obs_prof_opt( profdataqc(jtype),                       &
-               &               kstp, jpi, jpj, jpk, nit000, idaystp,   &
-               &               profvar1, profvar2,   &
-               &               gdept_1d, profmask1, profmask2, n1dint, n2dint,        &
-               &               kdailyavtypes = dailyavtypes )
-            
+
+            CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk,  &
+               &               nit000, idaystp,                         &
+               &               zprofvar1, zprofvar2,                    &
+               &               gdept_1d, zprofmask1, zprofmask2,        &
+               &               zglam1, zglam2, zgphi1, zgphi2,          &
+               &               nn_1dint, nn_2dint,                      &
+               &               kdailyavtypes = nn_profdavtypes )
+
          END DO
 
       ENDIF
 
-      IF ( numsurftypes > 0 ) THEN
-         DO jtype = 1, numsurftypes
-      
-            SELECT CASE ( TRIM(obstypessurf(jtype)) )
+      IF ( nsurftypes > 0 ) THEN
+
+         DO jtype = 1, nsurftypes
+
+            SELECT CASE ( TRIM(cobstypessurf(jtype)) )
             CASE('sst')
-               surfvar(:,:) = tsn(:,:,1,jp_tem)
+               zsurfvar(:,:) = tsn(:,:,1,jp_tem)
+               llnightav = ln_sstnight
             CASE('sla')
-               surfvar(:,:) = sshn(:,:)
-            CASE('sss')
-               surfvar(:,:) = tsn(:,:,1,jp_sal)
+               zsurfvar(:,:) = sshn(:,:)
+               llnightav = .FALSE.
 #if defined key_lim2 || defined key_lim3
-            CASE('seaice')
-               surfvar(:,:) = 1._wp - frld(:,:)
+            CASE('sic')
+               zsurfvar(:,:) = 1._wp - frld(:,:)
+               llnightav = .FALSE.
 #endif
             END SELECT
-         
-            CALL obs_surf_opt( surfdatqc(jtype),             &
-               &               kstp, jpi, jpj, nit000, surfvar, &
-               &               tmask(:,:,1), n2dint, ld_sstnight )
-            
+
+            CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj,       &
+               &               nit000, idaystp, zsurfvar, tmask(:,:,1), &
+               &               nn_2dint, llnightav )
+
          END DO
-         
-      ENDIF
-      
+
+      ENDIF
+
 #if ! defined key_lim2 && ! defined key_lim3
       CALL wrk_dealloc(jpi,jpj,frld) 
@@ -542,5 +609,5 @@
 
    END SUBROUTINE dia_obs
-  
+
    SUBROUTINE dia_obs_wri 
       !!----------------------------------------------------------------------
@@ -559,38 +626,40 @@
       !!        !  07-03  (K. Mogensen) General handling of profiles
       !!        !  08-09  (M. Valdivieso) Velocity component (U,V) profiles
+      !!        !  15-08  (M. Martin) Combined writing for prof and surf types
       !!----------------------------------------------------------------------
       IMPLICIT NONE
 
       !! * Local declarations
-
       INTEGER :: jtype                    ! Data set loop variable
+
       !-----------------------------------------------------------------------
       ! Depending on switches call various observation output routines
       !-----------------------------------------------------------------------
 
-      IF ( numproftypes > 0 ) THEN
-         DO jtype = 1, numproftypes
-      
+      IF ( nproftypes > 0 ) THEN
+
+         DO jtype = 1, nproftypes
+
             CALL obs_prof_decompress( profdataqc(jtype), &
                &                      profdata(jtype), .TRUE., numout )
 
-            CALL obs_wri_prof( obstypesprof(jtype), profdata(jtype), n2dint )
-         
+            CALL obs_wri_prof( profdata(jtype), nn_2dint )
+
          END DO
-         
-      ENDIF
-
-      IF ( numsurftypes > 0 ) THEN
-         DO jtype = 1, numsurftypes
-      
-            CALL obs_surf_decompress( surfdatqc(jtype), &
+
+      ENDIF
+
+      IF ( nsurftypes > 0 ) THEN
+
+         DO jtype = 1, nsurftypes
+
+            CALL obs_surf_decompress( surfdataqc(jtype), &
                &                      surfdata(jtype), .TRUE., numout )
 
-            CALL obs_wri_surf( obstypessurf(jtype), surfdata(jtype), n2dint )
+            CALL obs_wri_surf( surfdata(jtype) )
 
          END DO
-         
-      ENDIF
-
+
+      ENDIF
 
    END SUBROUTINE dia_obs_wri
@@ -609,11 +678,14 @@
       !!
       !!----------------------------------------------------------------------
-      !! obs_grid deallocation
+      ! obs_grid deallocation
       CALL obs_grid_deallocate
 
-      !! diaobs deallocation
-      IF ( numproftypes > 0 ) DEALLOCATE(profdata, profdataqc, nvarsprof, nextrprof)
-      IF ( numsurftypes > 0 ) DEALLOCATE(surfdata, surfdataqc, nvarssurf, nextrsurf)
-      
+      ! diaobs deallocation
+      IF ( nproftypes > 0 ) &
+         &   DEALLOCATE( cobstypesprof, profdata, profdataqc, nvarsprof, nextrprof )
+
+      IF ( nsurftypes > 0 ) &
+         &   DEALLOCATE( cobstypessurf, surfdata, surfdataqc, nvarssurf, nextrsurf )
+
    END SUBROUTINE dia_obs_dealloc
 
@@ -621,10 +693,10 @@
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE ini_date  ***
-      !!          
-      !! ** Purpose : Get initial data in double precision YYYYMMDD.HHMMSS format
-      !!
-      !! ** Method  : Get initial data in double precision YYYYMMDD.HHMMSS format
-      !!
-      !! ** Action  : Get initial data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Purpose : Get initial date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Method  : Get initial date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Action  : Get initial date in double precision YYYYMMDD.HHMMSS format
       !!
       !! History :
@@ -637,6 +709,4 @@
       USE phycst, ONLY : &            ! Physical constants
          & rday
-!      USE daymod, ONLY : &            ! Time variables
-!         & nmonth_len           
       USE dom_oce, ONLY : &           ! Ocean space and time domain variables
          & rdt
@@ -645,5 +715,5 @@
 
       !! * Arguments
-      REAL(KIND=dp), INTENT(OUT) :: ddobsini                         ! Initial date in YYYYMMDD.HHMMSS
+      REAL(dp), INTENT(OUT) :: ddobsini  ! Initial date in YYYYMMDD.HHMMSS
 
       !! * Local declarations
@@ -653,13 +723,13 @@
       INTEGER :: ihou
       INTEGER :: imin
-      INTEGER :: imday         ! Number of days in month.
-      REAL(KIND=wp) :: zdayfrc ! Fraction of day
-
-      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
-
-      !!----------------------------------------------------------------------
-      !! Initial date initialization (year, month, day, hour, minute)
-      !! (This assumes that the initial date is for 00z))
-      !!----------------------------------------------------------------------
+      INTEGER :: imday       ! Number of days in month.
+      INTEGER, DIMENSION(12) :: &
+         &       imonth_len  ! Length in days of the months of the current year
+      REAL(wp) :: zdayfrc    ! Fraction of day
+
+      !----------------------------------------------------------------------
+      ! Initial date initialization (year, month, day, hour, minute)
+      ! (This assumes that the initial date is for 00z))
+      !----------------------------------------------------------------------
       iyea =   ndate0 / 10000
       imon = ( ndate0 - iyea * 10000 ) / 100
@@ -668,7 +738,7 @@
       imin = 0
 
-      !!----------------------------------------------------------------------
-      !! Compute number of days + number of hours + min since initial time
-      !!----------------------------------------------------------------------
+      !----------------------------------------------------------------------
+      ! Compute number of days + number of hours + min since initial time
+      !----------------------------------------------------------------------
       iday = iday + ( nit000 -1 ) * rdt / rday
       zdayfrc = ( nit000 -1 ) * rdt / rday
@@ -677,10 +747,10 @@
       imin = int( (zdayfrc * 24 - ihou) * 60 )
 
-      !!-----------------------------------------------------------------------
-      !! Convert number of days (iday) into a real date
-      !!----------------------------------------------------------------------
+      !-----------------------------------------------------------------------
+      ! Convert number of days (iday) into a real date
+      !----------------------------------------------------------------------
 
       CALL calc_month_len( iyea, imonth_len )
-      
+
       DO WHILE ( iday > imonth_len(imon) )
          iday = iday - imonth_len(imon)
@@ -693,7 +763,7 @@
       END DO
 
-      !!----------------------------------------------------------------------
-      !! Convert it into YYYYMMDD.HHMMSS format.
-      !!----------------------------------------------------------------------
+      !----------------------------------------------------------------------
+      ! Convert it into YYYYMMDD.HHMMSS format.
+      !----------------------------------------------------------------------
       ddobsini = iyea * 10000_dp + imon * 100_dp + &
          &       iday + ihou * 0.01_dp + imin * 0.0001_dp
@@ -705,10 +775,10 @@
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE fin_date  ***
-      !!          
-      !! ** Purpose : Get final data in double precision YYYYMMDD.HHMMSS format
-      !!
-      !! ** Method  : Get final data in double precision YYYYMMDD.HHMMSS format
-      !!
-      !! ** Action  : Get final data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Purpose : Get final date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Method  : Get final date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Action  : Get final date in double precision YYYYMMDD.HHMMSS format
       !!
       !! History :
@@ -720,6 +790,4 @@
       USE phycst, ONLY : &            ! Physical constants
          & rday
-!      USE daymod, ONLY : &            ! Time variables
-!         & nmonth_len                
       USE dom_oce, ONLY : &           ! Ocean space and time domain variables
          & rdt
@@ -728,5 +796,5 @@
 
       !! * Arguments
-      REAL(KIND=dp), INTENT(OUT) :: ddobsfin                   ! Final date in YYYYMMDD.HHMMSS
+      REAL(dp), INTENT(OUT) :: ddobsfin ! Final date in YYYYMMDD.HHMMSS
 
       !! * Local declarations
@@ -736,9 +804,9 @@
       INTEGER :: ihou
       INTEGER :: imin
-      INTEGER :: imday         ! Number of days in month.
-      REAL(KIND=wp) :: zdayfrc       ! Fraction of day
-         
-      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
-            
+      INTEGER :: imday       ! Number of days in month.
+      INTEGER, DIMENSION(12) :: &
+         &       imonth_len  ! Length in days of the months of the current year
+      REAL(wp) :: zdayfrc    ! Fraction of day
+
       !-----------------------------------------------------------------------
       ! Initial date initialization (year, month, day, hour, minute)
@@ -750,5 +818,5 @@
       ihou = 0
       imin = 0
-      
+
       !-----------------------------------------------------------------------
       ! Compute number of days + number of hours + min since initial time
@@ -765,5 +833,5 @@
 
       CALL calc_month_len( iyea, imonth_len )
-      
+
       DO WHILE ( iday > imonth_len(imon) )
          iday = iday - imonth_len(imon)
@@ -783,4 +851,4 @@
 
     END SUBROUTINE fin_date
-    
+
 END MODULE diaobs
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 5682)
@@ -52,5 +52,5 @@
 
    !! Default values
-   REAL, PUBLIC :: grid_search_res = 0.5    ! Resolution of grid
+   REAL, PUBLIC :: rn_gridsearchres = 0.5   ! Resolution of grid
    INTEGER, PRIVATE :: gsearch_nlons_def    ! Num of longitudes
    INTEGER, PRIVATE :: gsearch_nlats_def    ! Num of latitudes
@@ -83,5 +83,5 @@
    LOGICAL, PUBLIC :: ln_grid_global         ! Use global distribution of observations
    CHARACTER(LEN=44), PUBLIC :: &
-      & grid_search_file    ! file name head for grid search lookup 
+      & cn_gridsearchfile    ! file name head for grid search lookup 
 
    !!----------------------------------------------------------------------
@@ -690,12 +690,12 @@
          
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*)'Grid search resolution : ', grid_search_res
-         
-         gsearch_nlons_def  = NINT( 360.0_wp / grid_search_res ) 
-         gsearch_nlats_def  = NINT( 180.0_wp / grid_search_res )
-         gsearch_lonmin_def = -180.0_wp + 0.5_wp * grid_search_res
-         gsearch_latmin_def =  -90.0_wp + 0.5_wp * grid_search_res
-         gsearch_dlon_def   = grid_search_res
-         gsearch_dlat_def   = grid_search_res
+         IF(lwp) WRITE(numout,*)'Grid search resolution : ', rn_gridsearchres
+         
+         gsearch_nlons_def  = NINT( 360.0_wp / rn_gridsearchres ) 
+         gsearch_nlats_def  = NINT( 180.0_wp / rn_gridsearchres )
+         gsearch_lonmin_def = -180.0_wp + 0.5_wp * rn_gridsearchres
+         gsearch_latmin_def =  -90.0_wp + 0.5_wp * rn_gridsearchres
+         gsearch_dlon_def   = rn_gridsearchres
+         gsearch_dlat_def   = rn_gridsearchres
          
          IF (lwp) THEN
@@ -710,8 +710,8 @@
          IF ( ln_grid_global ) THEN
             WRITE(cfname, FMT="(A,'_',A)") &
-               &          TRIM(grid_search_file), 'global.nc'
+               &          TRIM(cn_gridsearchfile), 'global.nc'
          ELSE
             WRITE(cfname, FMT="(A,'_',I4.4,'of',I4.4,'by',I4.4,'.nc')") &
-               &          TRIM(grid_search_file), nproc, jpni, jpnj
+               &          TRIM(cn_gridsearchfile), nproc, jpni, jpnj
          ENDIF
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90	(revision 5682)
@@ -115,5 +115,5 @@
       !!               ***  ROUTINE obs_mpp_find_obs_proc ***
       !!          
-      !! ** Purpose : From the array kobsp containing the results of the grid
+      !! ** Purpose : From the array kobsp containing the results of the
       !!              grid search on each processor the processor return a
       !!              decision of which processors should hold the observation.
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 5682)
@@ -11,22 +11,24 @@
    !!----------------------------------------------------------------------
 
-   !! * Modules used   
+   !! * Modules used
    USE par_kind, ONLY : &         ! Precision variables
       & wp
    USE in_out_manager             ! I/O manager
    USE obs_inter_sup              ! Interpolation support
-   USE obs_inter_h2d, ONLY : &    ! Horizontal interpolation to the observation pt
+   USE obs_inter_h2d, ONLY : &    ! Horizontal interpolation to the obs pt
       & obs_int_h2d, &
       & obs_int_h2d_init
-   USE obs_inter_z1d, ONLY : &    ! Vertical interpolation to the observation pt
+   USE obs_inter_z1d, ONLY : &    ! Vertical interpolation to the obs pt
       & obs_int_z1d,    &
       & obs_int_z1d_spl
-   USE obs_const,  ONLY :     &
-      & obfillflt		  ! Fillvalue   
-   USE dom_oce,       ONLY : &
-      & glamt, glamu, glamv, &
-      & gphit, gphiu, gphiv
-   USE lib_mpp,       ONLY : &
+   USE obs_const,  ONLY :    &    ! Obs fill value
+      & obfillflt
+   USE dom_oce,       ONLY : &    ! Model lats/lons
+      & glamt, &
+      & gphit
+   USE lib_mpp,       ONLY : &    ! Warning and stopping routines
       & ctl_warn, ctl_stop
+   USE sbcdcy,        ONLY : &    ! For calculation of where it is night-time
+      & sbc_dcy, nday_qsr
 
    IMPLICIT NONE
@@ -35,8 +37,9 @@
    PRIVATE
 
-   PUBLIC obs_prof_opt, &  ! Compute the model counterpart of profile observations
-      &   obs_surf_opt     ! Compute the model counterpart of surface observations
-
-   INTEGER, PARAMETER, PUBLIC :: imaxavtypes = 20 ! Max number of daily avgd obs types
+   PUBLIC obs_prof_opt, &  ! Compute the model counterpart of profile obs
+      &   obs_surf_opt     ! Compute the model counterpart of surface obs
+
+   INTEGER, PARAMETER, PUBLIC :: &
+      & imaxavtypes = 20   ! Max number of daily avgd obs types
 
    !!----------------------------------------------------------------------
@@ -48,7 +51,10 @@
 CONTAINS
 
-   SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, &
-      &                     pvar1, pvar2, pgdept, pmask1, k1dint, k2dint, &
-      &                     kdailyavtypes )
+   SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk,          &
+      &                     kit000, kdaystp,                      &
+      &                     pvar1, pvar2, pgdept, pmask1, pmask2, &
+      &                     plam1, plam2, pphi1, pphi2,           &
+      &                     k1dint, k2dint, kdailyavtypes )
+
       !!-----------------------------------------------------------------------
       !!
@@ -99,5 +105,5 @@
       !!      ! 15-02 (M. Martin) Combined routine for all profile types
       !!-----------------------------------------------------------------------
-  
+
       !! * Modules used
       USE obs_profiles_def ! Definition of storage space for profile obs.
@@ -106,23 +112,30 @@
 
       !! * Arguments
-      TYPE(obs_prof), INTENT(INOUT) :: prodatqc  ! Subset of profile data not failing screening
-      INTEGER, INTENT(IN) :: kt        ! Time step
-      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
+      TYPE(obs_prof), INTENT(INOUT) :: &
+         & prodatqc                  ! Subset of profile data passing QC
+      INTEGER, INTENT(IN) :: kt      ! Time step
+      INTEGER, INTENT(IN) :: kpi     ! Model grid parameters
       INTEGER, INTENT(IN) :: kpj
       INTEGER, INTENT(IN) :: kpk
-      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
-                                       !   (kit000-1 = restart time)
-      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header)
-      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
-      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                    
+      INTEGER, INTENT(IN) :: kit000  ! Number of the first time step
+                                     !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k1dint  ! Vertical interpolation type (see header)
+      INTEGER, INTENT(IN) :: k2dint  ! Horizontal interpolation type (see header)
+      INTEGER, INTENT(IN) :: kdaystp ! Number of time steps per day
       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
-         & pvar1,    &    ! Model field 1
-         & pvar2,    &    ! Model field 2
-         & pmask1,   &    ! Land-sea mask 1
-         & pmask2         ! Land-sea mask 2
+         & pvar1,    &               ! Model field 1
+         & pvar2,    &               ! Model field 2
+         & pmask1,   &               ! Land-sea mask 1
+         & pmask2                    ! Land-sea mask 2
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & plam1,    &               ! Model longitudes for variable 1
+         & plam2,    &               ! Model longitudes for variable 2
+         & pphi1,    &               ! Model latitudes for variable 1
+         & pphi2                     ! Model latitudes for variable 2
       REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
-         & pgdept       ! Model array of depth levels
+         & pgdept                    ! Model array of depth levels
       INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
-         & kdailyavtypes! Types for daily averages
+         & kdailyavtypes             ! Types for daily averages
+
       !! * Local declarations
       INTEGER ::   ji
@@ -138,4 +151,9 @@
       INTEGER, DIMENSION(imaxavtypes) :: &
          & idailyavtypes
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi1, &
+         & igrdi2, &
+         & igrdj1, &
+         & igrdj2
       REAL(KIND=wp) :: zlam
       REAL(KIND=wp) :: zphi
@@ -144,5 +162,4 @@
          & zobsmask1, &
          & zobsmask2, &
-         & zobsmask, &
          & zobsk,    &
          & zobs2k
@@ -162,66 +179,70 @@
          & zgphi1, &
          & zgphi2
-      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
-         & igrdi1, &
-         & igrdi2, &
-         & igrdj1, &
-         & igrdj2
+      LOGICAL :: ld_dailyav
 
       !------------------------------------------------------------------------
       ! Local initialization 
       !------------------------------------------------------------------------
-      ! ... Record and data counters
+      ! Record and data counters
       inrc = kt - kit000 + 2
       ipro = prodatqc%npstp(inrc)
- 
+
       ! Daily average types
+      ld_dailyav = .FALSE.
       IF ( PRESENT(kdailyavtypes) ) THEN
          idailyavtypes(:) = kdailyavtypes(:)
+         IF ( ANY (idailyavtypes(:) /= -1) ) ld_dailyav = .TRUE.
       ELSE
          idailyavtypes(:) = -1
       ENDIF
 
-      ! Initialize daily mean for first timestep
+      ! Daily means are calculated for values over timesteps:
+      !  [1 <= kt <= kdaystp], [kdaystp+1 <= kt <= 2*kdaystp], ...
       idayend = MOD( kt - kit000 + 1, kdaystp )
 
-      ! Added kt == 0 test to catch restart case 
-      IF ( idayend == 1 .OR. kt == 0) THEN
-         IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt
+      IF ( ld_dailyav ) THEN
+
+         ! Initialize daily mean for first timestep of the day
+         IF ( idayend == 1 .OR. kt == 0 ) THEN
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     prodatqc%vdmean(ji,jj,jk,1) = 0.0
+                     prodatqc%vdmean(ji,jj,jk,2) = 0.0
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
          DO jk = 1, jpk
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  prodatqc%vdmean(ji,jj,jk,1) = 0.0
-                  prodatqc%vdmean(ji,jj,jk,2) = 0.0
+                  ! Increment field 1 for computing daily mean
+                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+                     &                        + pvar1(ji,jj,jk)
+                  ! Increment field 2 for computing daily mean
+                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+                     &                        + pvar2(ji,jj,jk)
                END DO
             END DO
          END DO
-      ENDIF
-
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ! Increment field 1 for computing daily mean
-               prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
-                  &                        + pvar1(ji,jj,jk)
-               ! Increment field 2 for computing daily mean
-               prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
-                  &                        + pvar2(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-   
-      ! Compute the daily mean at the end of day
-      zdaystp = 1.0 / REAL( kdaystp )
-      IF ( idayend == 0 ) THEN
-         DO jk = 1, jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
-                     &                        * zdaystp
-                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
-                  &                           * zdaystp
+
+         ! Compute the daily mean at the end of day
+         zdaystp = 1.0 / REAL( kdaystp )
+         IF ( idayend == 0 ) THEN
+            IF (lwp) WRITE(numout,*) 'Calculating prodatqc%vdmean on time-step: ',kt
+            CALL FLUSH(numout)
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+                        &                        * zdaystp
+                     prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+                        &                        * zdaystp
+                  END DO
                END DO
             END DO
-         END DO
+         ENDIF
+
       ENDIF
 
@@ -262,16 +283,16 @@
       END DO
 
-      CALL obs_int_comm_2d( 2, 2, ipro, igrdi1, igrdj1, glamt1, zglam1 )
-      CALL obs_int_comm_2d( 2, 2, ipro, igrdi1, igrdj1, gphit1, zgphi1 )
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdi1, igrdj1, plam1, zglam1 )
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdi1, igrdj1, pphi1, zgphi1 )
       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi1, igrdj1, pmask1, zmask1 )
       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi1, igrdj1, pvar1,   zint1 )
       
-      CALL obs_int_comm_2d( 2, 2, ipro, igrdi2, igrdj2, glamt2, zglam2 )
-      CALL obs_int_comm_2d( 2, 2, ipro, igrdi2, igrdj2, gphit2, zgphi2 )
-      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi2, igrdj2, pmask1, zmask2 )
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdi2, igrdj2, plam2, zglam2 )
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdi2, igrdj2, pphi2, zgphi2 )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi2, igrdj2, pmask2, zmask2 )
       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi2, igrdj2, pvar2,   zint2 )
 
       ! At the end of the day also get interpolated means
-      IF ( idayend == 0 ) THEN
+      IF ( ld_dailyav .AND. idayend == 0 ) THEN
 
          ALLOCATE( &
@@ -292,5 +313,5 @@
 
          IF ( kt /= prodatqc%mstp(jobs) ) THEN
-            
+
             IF(lwp) THEN
                WRITE(numout,*)
@@ -307,8 +328,8 @@
             CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' )
          ENDIF
-         
+
          zlam = prodatqc%rlam(jobs)
          zphi = prodatqc%rphi(jobs)
-         
+
          ! Horizontal weights and vertical mask
 
@@ -333,26 +354,16 @@
             zobsk(:) = obfillflt
 
-	    IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN
+            IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN
 
                IF ( idayend == 0 )  THEN
-                  
                   ! Daily averaged data
-                  
                   CALL obs_int_h2d( kpk, kpk,      &
                      &              zweig1, zinm1(:,:,:,iobs), zobsk )
-                  
-                  
-               ELSE
-               
-                  CALL ctl_stop( ' A nonzero' //     &
-                     &           ' number of average profile data should' // &
-                     &           ' only occur at the end of a given day' )
 
                ENDIF
-	       
+
             ELSE 
-               
+
                ! Point data
-
                CALL obs_int_h2d( kpk, kpk,      &
                   &              zweig1, zint1(:,:,:,iobs), zobsk )
@@ -364,10 +375,10 @@
             ! polynomial at obs points
             !-------------------------------------------------------------
-            
+
             IF ( k1dint == 1 ) THEN
                CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   &
-                  &                  pgdept, zobsmask )
+                  &                  pgdept, zobsmask1 )
             ENDIF
-            
+
             !-----------------------------------------------------------------
             !  Vertical interpolation to the observation point
@@ -381,5 +392,5 @@
                & zobsk, zobs2k,                   &
                & prodatqc%var(1)%vmod(ista:iend), &
-               & pgdept, zobsmask )
+               & pgdept, zobsmask1 )
 
          ENDIF
@@ -394,20 +405,12 @@
 
                   ! Daily averaged data
-                  
                   CALL obs_int_h2d( kpk, kpk,      &
                      &              zweig2, zinm2(:,:,:,iobs), zobsk )
-                  
-               ELSE
-
-                  CALL ctl_stop( ' A nonzero' //     &
-                     &           ' number of average profile data should' // &
-                     &           ' only occur at the end of a given day' )
 
                ENDIF
 
             ELSE
-               
+
                ! Point data
-
                CALL obs_int_h2d( kpk, kpk,      &
                   &              zweig2, zint2(:,:,:,iobs), zobsk )
@@ -420,10 +423,10 @@
             ! polynomial at obs points
             !-------------------------------------------------------------
-            
+
             IF ( k1dint == 1 ) THEN
                CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, &
-                  &                  pgdept, zobsmask )
+                  &                  pgdept, zobsmask2 )
             ENDIF
-            
+
             !----------------------------------------------------------------
             !  Vertical interpolation to the observation point
@@ -437,10 +440,10 @@
                & zobsk, zobs2k, &
                & prodatqc%var(2)%vmod(ista:iend),&
-               & pgdept, zobsmask )
+               & pgdept, zobsmask2 )
 
          ENDIF
 
       END DO
- 
+
       ! Deallocate the data for interpolation
       DEALLOCATE( &
@@ -458,6 +461,7 @@
          & zint2   &
          & )
+
       ! At the end of the day also get interpolated means
-      IF ( idayend == 0 ) THEN
+      IF ( ld_dailyav .AND. idayend == 0 ) THEN
          DEALLOCATE( &
             & zinm1,  &
@@ -467,9 +471,11 @@
 
       prodatqc%nprofup = prodatqc%nprofup + ipro 
-      
+
    END SUBROUTINE obs_prof_opt
 
-   SUBROUTINE obs_surf_opt( surfdataqc, kt, kpi, kpj, kit000, &
-      &                    psurf, psurfmask, k2dint, ld_nightav )
+   SUBROUTINE obs_surf_opt( surfdataqc, kt, kpi, kpj,         &
+      &                    kit000, kdaystp, psurf, psurfmask, &
+      &                    k2dint, ldnightav )
+
       !!-----------------------------------------------------------------------
       !!
@@ -491,5 +497,5 @@
       !!        - bilinear (quadrilateral grid)    (k2dint = 3)
       !!        - polynomial (quadrilateral grid)  (k2dint = 4)
-      !!  
+      !!
       !!
       !! ** Action  :
@@ -499,5 +505,5 @@
       !!      ! 15-02 (M. Martin) Combined routine for surface types
       !!-----------------------------------------------------------------------
-  
+
       !! * Modules used
       USE obs_surf_def  ! Definition of storage space for surface observations
@@ -506,15 +512,18 @@
 
       !! * Arguments
-      TYPE(obs_surf), INTENT(INOUT) :: surfdataqc     ! Subset of surface data not failing screening
-      INTEGER, INTENT(IN) :: kt      ! Time step
-      INTEGER, INTENT(IN) :: kpi     ! Model grid parameters
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & surfdataqc                  ! Subset of surface data passing QC
+      INTEGER, INTENT(IN) :: kt        ! Time step
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
       INTEGER, INTENT(IN) :: kpj
-      INTEGER, INTENT(IN) :: kit000   ! Number of the first time step 
-                                      !   (kit000-1 = restart time)
-      INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header)
-      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
-         & psurf,  &    ! Model surface field
-         & psurfmask    ! Land-sea mask
-         
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
+                                       !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
+      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & psurf,  &                   ! Model surface field
+         & psurfmask                   ! Land-sea mask
+      LOGICAL, INTENT(IN) :: ldnightav ! Logical for averaging night-time data
+
       !! * Local declarations
       INTEGER :: ji
@@ -524,29 +533,39 @@
       INTEGER :: isurf
       INTEGER :: iobs
-      REAL(KIND=wp) :: zlam
-      REAL(KIND=wp) :: zphi
-      REAL(KIND=wp) :: zext(1), zobsmask(1)
-      REAL(kind=wp), DIMENSION(2,2,1) :: &
-         & zweig
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
-         & zmask, &
-         & zsurf, &
-         & zglam, &
-         & zgphi
+      INTEGER :: idayend
       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
          & igrdi, &
          & igrdj
+      INTEGER, DIMENSION(:,:), SAVE, ALLOCATABLE :: &
+         & icount_night,      &
+         & imask_night
+      REAL(wp) :: zlam
+      REAL(wp) :: zphi
+      REAL(wp), DIMENSION(1) :: zext, zobsmask
+      REAL(wp) :: zdaystp
+      REAL(wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask,  &
+         & zsurf,  &
+         & zsurfm, &
+         & zglam,  &
+         & zgphi
+      REAL(wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: &
+         & zintmp,  &
+         & zouttmp, &
+         & zmeanday    ! to compute model sst in region of 24h daylight (pole)
 
       !------------------------------------------------------------------------
       ! Local initialization 
       !------------------------------------------------------------------------
-      ! ... Record and data counters
+      ! Record and data counters
       inrc = kt - kit000 + 2
       isurf = surfdataqc%nsstp(inrc)
-      
-      IF ( ld_nightav ) THEN
+
+      IF ( ldnightav ) THEN
 
       ! Initialize array for night mean
-         IF ( kt .EQ. 0 ) THEN
+         IF ( kt == 0 ) THEN
             ALLOCATE ( icount_night(kpi,kpj) )
             ALLOCATE ( imask_night(kpi,kpj) )
@@ -557,10 +576,10 @@
          ENDIF
 
-         ! Initialize daily mean for first timestep
+         ! Night-time means are calculated for night-time values over timesteps:
+         !  [1 <= kt <= kdaystp], [kdaystp+1 <= kt <= 2*kdaystp], .....
          idayend = MOD( kt - kit000 + 1, kdaystp )
 
-         ! Added kt == 0 test to catch restart case 
-         IF ( idayend == 1 .OR. kt == 0) THEN
-            IF (lwp) WRITE(numout,*) 'Reset surfdataqc%vdmean on time-step: ',kt
+         ! Initialize night-time mean for first timestep of the day
+         IF ( idayend == 1 .OR. kt == 0 ) THEN
             DO jj = 1, jpj
                DO ji = 1, jpi
@@ -580,22 +599,23 @@
                ! Increment the temperature field for computing night mean and counter
                surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj)  &
-                      &                        + psurf(ji,jj)*imask_night(ji,jj)
-               zmeanday(ji,jj)        = zmeanday(ji,jj) + psurf(ji,jj)
-               icount_night(ji,jj) = icount_night(ji,jj) + imask_night(ji,jj)
+                      &                    + psurf(ji,jj) * REAL( imask_night(ji,jj) )
+               zmeanday(ji,jj)          = zmeanday(ji,jj) + psurf(ji,jj)
+               icount_night(ji,jj)      = icount_night(ji,jj) + imask_night(ji,jj)
             END DO
          END DO
-   
-         ! Compute the daily mean at the end of day
-
+
+         ! Compute the night-time mean at the end of the day
          zdaystp = 1.0 / REAL( kdaystp )
-
-         IF ( idayend == 0 ) THEN 
+         IF ( idayend == 0 ) THEN
+            IF (lwp) WRITE(numout,*) 'Calculating surfdataqc%vdmean on time-step: ',kt
             DO jj = 1, jpj
                DO ji = 1, jpi
                   ! Test if "no night" point
-                  IF ( icount_night(ji,jj) .NE. 0 ) THEN
+                  IF ( icount_night(ji,jj) > 0 ) THEN
                      surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj) &
-                       &                        / icount_night(ji,jj) 
+                       &                        / REAL( icount_night(ji,jj) )
                   ELSE
+                     !At locations where there is no night (e.g. poles),
+                     ! calculate daily mean instead of night-time mean.
                      surfdataqc%vdmean(ji,jj) = zmeanday(ji,jj) * zdaystp
                   ENDIF
@@ -616,5 +636,5 @@
          & zsurf(2,2,isurf)  &
          & )
-      
+
       DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf
          iobs = jobs - surfdataqc%nsurfup
@@ -639,5 +659,5 @@
 
       ! At the end of the day get interpolated means
-      IF ( idayend == 0 .AND. ld_nightav ) THEN
+      IF ( idayend == 0 .AND. ldnightav ) THEN
 
          ALLOCATE( &
@@ -656,5 +676,5 @@
 
          IF ( kt /= surfdataqc%mstp(jobs) ) THEN
-            
+
             IF(lwp) THEN
                WRITE(numout,*)
@@ -669,8 +689,8 @@
                   &            ' ntyp    = ', surfdataqc%ntyp(jobs)
             ENDIF
-            CALL ctl_stop( 'obs_sla_opt', 'Inconsistent time' )
-            
-         ENDIF
-         
+            CALL ctl_stop( 'obs_surf_opt', 'Inconsistent time' )
+
+         ENDIF
+
          zlam = surfdataqc%rlam(jobs)
          zphi = surfdataqc%rphi(jobs)
@@ -680,27 +700,14 @@
             &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
             &                   zmask(:,:,iobs), zweig, zobsmask )
-         
 
          ! Interpolate the model field to the observation point
-         IF ( ld_nightav ) THEN
-
-           IF ( idayend == 0 )  THEN
-               ! Daily averaged data
-               CALL obs_int_h2d( 1, 1,      & 
-                     &              zweig, zsurfm(:,:,iobs), zext )
-            ELSE 
-               CALL ctl_stop( ' ld_nightav is set to true: a nonzero' //     &
-                     &           ' number of night data should' // &
-                     &           ' only occur at the end of a given day' )
-            ENDIF
-
+         IF ( ldnightav .AND. idayend == 0 ) THEN
+            ! Night-time averaged data
+            CALL obs_int_h2d( 1, 1, zweig, zsurfm(:,:,iobs), zext )
          ELSE
-
-            CALL obs_int_h2d( 1, 1,      &
-               &              zweig, zsurf(:,:,iobs),  zext )
-
-         ENDIF
-         
-         IF ( surfdataqc%nextr == 2 ) THEN
+            CALL obs_int_h2d( 1, 1, zweig, zsurf(:,:,iobs),  zext )
+         ENDIF
+
+         IF ( TRIM(surfdataqc%cvars(1)) == 'SLA' .AND. surfdataqc%nextra == 2 ) THEN
             ! ... Remove the MDT from the SSH at the observation point to get the SLA
             surfdataqc%rext(jobs,1) = zext(1)
@@ -722,6 +729,6 @@
          & )
 
-      ! At the end of the day also get interpolated means
-      IF ( idayend == 0 .AND. ld_nightav ) THEN
+      ! At the end of the day also deallocate night-time mean array
+      IF ( idayend == 0 .AND. ldnightav ) THEN
          DEALLOCATE( &
             & zsurfm  &
@@ -734,3 +741,2 @@
 
 END MODULE obs_oper
-
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 5682)
@@ -71,6 +71,6 @@
          & nproc
       !! * Arguments
-      TYPE(obs_surf), INTENT(INOUT) :: surfdata    ! Full set of SLA data
-      TYPE(obs_surf), INTENT(INOUT) :: surfdataqc   ! Subset of SLA data not failing screening
+      TYPE(obs_surf), INTENT(INOUT) :: surfdata    ! Full set of surface data
+      TYPE(obs_surf), INTENT(INOUT) :: surfdataqc   ! Subset of surface data not failing screening
       LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land
       !! * Local declarations
@@ -99,6 +99,7 @@
       INTEGER :: inrc         ! Time index variable
 
-      IF(lwp) WRITE(numout,*)'obs_pre_sla : Preparing the SLA observations...'
-
+      IF(lwp) WRITE(numout,*)'obs_pre_surf : Preparing the surface observations...'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      
       ! Initial date initialization (year, month, day, hour, minute)
       iyea0 =   ndate0 / 10000
@@ -185,23 +186,20 @@
       IF(lwp) THEN
          WRITE(numout,*)
-         WRITE(numout,*) 'obs_pre_surf :'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*)
-         WRITE(numout,*) ' Surface data outside time domain               = ', &
+         WRITE(numout,*) ' '//surfdataqc%cvars(1)//' data outside time domain                  = ', &
             &            iotdobsmpp
-         WRITE(numout,*) ' Remaining surface data that failed grid search    = ', &
+         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data that failed grid search    = ', &
             &            igrdobsmpp
-         WRITE(numout,*) ' Remaining surface data outside space domain       = ', &
+         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data outside space domain       = ', &
             &            iosdsobsmpp
-         WRITE(numout,*) ' Remaining surface data at land points             = ', &
+         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data at land points             = ', &
             &            ilansobsmpp
          IF (ld_nea) THEN
-            WRITE(numout,*) ' Remaining surface data near land points (removed) = ', &
+            WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (removed) = ', &
                &            inlasobsmpp
          ELSE
-            WRITE(numout,*) ' Remaining surface data near land points (kept)    = ', &
+            WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (kept)    = ', &
                &            inlasobsmpp
          ENDIF
-         WRITE(numout,*) ' surface data accepted                             = ', &
+         WRITE(numout,*) ' '//surfdataqc%cvars(1)//' data accepted                             = ', &
             &            surfdataqc%nsurfmpp
 
@@ -209,6 +207,7 @@
          WRITE(numout,*) ' Number of observations per time step :'
          WRITE(numout,*)
-         WRITE(numout,1997)
-         WRITE(numout,1998)
+         WRITE(numout,'(10X,A,10X,A)')'Time step',surfdataqc%cvars(1)
+         WRITE(numout,'(10X,A,5X,A)')'---------','-----------------'
+         CALL FLUSH(numout)
       ENDIF
       
@@ -225,9 +224,8 @@
             inrc = jstp - nit000 + 2
             WRITE(numout,1999) jstp, surfdataqc%nsstpmpp(inrc)
+            CALL FLUSH(numout)
          END DO
       ENDIF
 
-1997  FORMAT(10X,'Time step',5X,'Sea level anomaly')
-1998  FORMAT(10X,'---------',5X,'-----------------')
 1999  FORMAT(10X,I9,5X,I17)
 
@@ -235,6 +233,9 @@
 
 
-   SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_vel3d, ld_nea, ld_dailyav )
-      !!----------------------------------------------------------------------
+   SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var1, ld_var2, &
+      &                     zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2,  &
+      &                     ld_nea, kdailyavtypes )
+
+!!----------------------------------------------------------------------
       !!                    ***  ROUTINE obs_pre_prof  ***
       !!
@@ -246,5 +247,5 @@
       !!        !  2007-06  (K. Mogensen) original : T and S profile data
       !!        !  2008-09  (M. Valdivieso) : TAO velocity data
-      !!        !  2009-01  (K. Mogensen) : New feedback strictuer
+      !!        !  2009-01  (K. Mogensen) : New feedback stricture
       !!        !  2015-02  (M. Martin) : Combined profile routine.
       !!
@@ -254,15 +255,24 @@
       USE par_oce             ! Ocean parameters
       USE dom_oce, ONLY : &   ! Geographical information
-         & glamt, glamu, glamv,    &
-         & gphit, gphiu, gphiv,    &
          & gdept_1d,             &
-         & tmask, umask, vmask,  &
          & nproc
+
       !! * Arguments
       TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Full set of profile data
       TYPE(obs_prof), INTENT(INOUT) :: prodatqc   ! Subset of profile data not failing screening
-      LOGICAL, INTENT(IN) :: ld_vel3d      ! Switch for zonal and meridional velocity components
-      LOGICAL, INTENT(IN) :: ld_nea        ! Switch for rejecting observation near land
-      LOGICAL, INTENT(IN) :: ld_dailyav    ! Switch for daily average data
+      LOGICAL, INTENT(IN) :: ld_var1              ! Observed variables switches
+      LOGICAL, INTENT(IN) :: ld_var2
+      LOGICAL, INTENT(IN) :: ld_nea               ! Switch for rejecting observation near land
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes                          ! Types for daily averages
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj,jpk) :: &
+         & zmask1, &
+         & zmask2
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: &
+         & pglam1, &
+         & pglam2, &
+         & pgphi1, &
+         & pgphi2
+
       !! * Local declarations
       INTEGER :: iyea0        ! Initial date
@@ -272,29 +282,29 @@
       INTEGER :: imin0
       INTEGER :: icycle       ! Current assimilation cycle
-                              ! Counters for observations that
+                              ! Counters for observations that are
       INTEGER :: iotdobs      !  - outside time domain
-      INTEGER :: iosduobs     !  - outside space domain (zonal velocity component)
-      INTEGER :: iosdvobs     !  - outside space domain (meridional velocity component)
-      INTEGER :: ilanuobs     !  - within a model land cell (zonal velocity component)
-      INTEGER :: ilanvobs     !  - within a model land cell (meridional velocity component)
-      INTEGER :: inlauobs     !  - close to land (zonal velocity component)
-      INTEGER :: inlavobs     !  - close to land (meridional velocity component)
+      INTEGER :: iosdv1obs    !  - outside space domain (variable 1)
+      INTEGER :: iosdv2obs    !  - outside space domain (variable 2)
+      INTEGER :: ilanv1obs    !  - within a model land cell (variable 1)
+      INTEGER :: ilanv2obs    !  - within a model land cell (variable 2)
+      INTEGER :: inlav1obs    !  - close to land (variable 1)
+      INTEGER :: inlav2obs    !  - close to land (variable 2)
       INTEGER :: igrdobs      !  - fail the grid search
       INTEGER :: iuvchku      !  - reject u if v rejected and vice versa
       INTEGER :: iuvchkv      !
-                              ! Global counters for observations that
+                              ! Global counters for observations that are
       INTEGER :: iotdobsmpp   !  - outside time domain
-      INTEGER :: iosduobsmpp  !  - outside space domain (zonal velocity component)
-      INTEGER :: iosdvobsmpp  !  - outside space domain (meridional velocity component)
-      INTEGER :: ilanuobsmpp  !  - within a model land cell (zonal velocity component)
-      INTEGER :: ilanvobsmpp  !  - within a model land cell (meridional velocity component)
-      INTEGER :: inlauobsmpp  !  - close to land (zonal velocity component)
-      INTEGER :: inlavobsmpp  !  - close to land (meridional velocity component)
+      INTEGER :: iosdv1obsmpp !  - outside space domain (variable 1)
+      INTEGER :: iosdv2obsmpp !  - outside space domain (variable 2)
+      INTEGER :: ilanv1obsmpp !  - within a model land cell (variable 1)
+      INTEGER :: ilanv2obsmpp !  - within a model land cell (variable 2)
+      INTEGER :: inlav1obsmpp !  - close to land (variable 1)
+      INTEGER :: inlav2obsmpp !  - close to land (variable 2)
       INTEGER :: igrdobsmpp   !  - fail the grid search
-      INTEGER :: iuvchkumpp   !  - reject u if v rejected and vice versa
+      INTEGER :: iuvchkumpp   !  - reject var1 if var2 rejected and vice versa
       INTEGER :: iuvchkvmpp   !
       TYPE(obs_prof_valid) ::  llvalid      ! Profile selection 
       TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: &
-         & llvvalid           ! U,V selection 
+         & llvvalid           ! var1,var2 selection 
       INTEGER :: jvar         ! Variable loop variable
       INTEGER :: jobs         ! Obs. loop variable
@@ -302,5 +312,6 @@
       INTEGER :: inrc         ! Time index variable
 
-      IF(lwp) WRITE(numout,*)'obs_pre_prof: Preparing the profile data'
+      IF(lwp) WRITE(numout,*)'obs_pre_prof: Preparing the profile data...'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
 
       ! Initial date initialization (year, month, day, hour, minute)
@@ -317,10 +328,10 @@
       iotdobs  = 0
       igrdobs  = 0
-      iosduobs = 0
-      iosdvobs = 0
-      ilanuobs = 0
-      ilanvobs = 0
-      inlauobs = 0
-      inlavobs = 0
+      iosdv1obs = 0
+      iosdv2obs = 0
+      ilanv1obs = 0
+      ilanv2obs = 0
+      inlav1obs = 0
+      inlav2obs = 0
       iuvchku  = 0
       iuvchkv = 0
@@ -330,11 +341,20 @@
       ! -----------------------------------------------------------------------
 
-      CALL obs_coo_tim_prof( icycle, &
-         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
-         &              profdata%nprof,   profdata%nyea, profdata%nmon, &
-         &              profdata%nday,    profdata%nhou, profdata%nmin, &
-         &              profdata%ntyp,    profdata%nqc,  profdata%mstp, &
-         &              iotdobs, ld_dailyav = ld_dailyav        )
-	 
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         CALL obs_coo_tim_prof( icycle, &
+            &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+            &              profdata%nprof,   profdata%nyea, profdata%nmon, &
+            &              profdata%nday,    profdata%nhou, profdata%nmin, &
+            &              profdata%ntyp,    profdata%nqc,  profdata%mstp, &
+            &              iotdobs, kdailyavtypes = kdailyavtypes )
+      ELSE
+         CALL obs_coo_tim_prof( icycle, &
+            &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+            &              profdata%nprof,   profdata%nyea, profdata%nmon, &
+            &              profdata%nday,    profdata%nhou, profdata%nmin, &
+            &              profdata%ntyp,    profdata%nqc,  profdata%mstp, &
+            &              iotdobs )
+      ENDIF
+
       CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
       
@@ -343,8 +363,6 @@
       ! -----------------------------------------------------------------------
 
-      CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,1), profdata%mj(:,1), &
-         &              profdata%nqc,     igrdobs                         )
-      CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,2), profdata%mj(:,2), &
-         &              profdata%nqc,     igrdobs                         )
+      CALL obs_coo_grd( profdata%nprof,   profdata%mi, profdata%mj, &
+         &              profdata%nqc,     igrdobs                )
 
       CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
@@ -361,26 +379,24 @@
       ! -----------------------------------------------------------------------
 
-      ! Zonal Velocity Component
-
+      ! Variable 1
       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   &
          &                 profdata%npvsta(:,1),  profdata%npvend(:,1), &
          &                 jpi,                   jpj,                  &
          &                 jpk,                                         &
-         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%mi,           profdata%mj,          &
          &                 profdata%var(1)%mvk,                         &
          &                 profdata%rlam,         profdata%rphi,        &
          &                 profdata%var(1)%vdep,                        &
-         &                 glamu,                 gphiu,                &
-         &                 gdept_1d,              umask,                &
+         &                 pglam1,                pgphi1,               &
+         &                 gdept_1d,              zmask1,               &
          &                 profdata%nqc,          profdata%var(1)%nvqc, &
-         &                 iosduobs,              ilanuobs,             &
-         &                 inlauobs,              ld_nea                )
-
-      CALL obs_mpp_sum_integer( iosduobs, iosduobsmpp )
-      CALL obs_mpp_sum_integer( ilanuobs, ilanuobsmpp )
-      CALL obs_mpp_sum_integer( inlauobs, inlauobsmpp )
-
-      ! Meridional Velocity Component
-
+         &                 iosdv1obs,              ilanv1obs,           &
+         &                 inlav1obs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdv1obs, iosdv1obsmpp )
+      CALL obs_mpp_sum_integer( ilanv1obs, ilanv1obsmpp )
+      CALL obs_mpp_sum_integer( inlav1obs, inlav1obsmpp )
+
+      ! Variable 2
       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   &
          &                 profdata%npvsta(:,2),  profdata%npvend(:,2), &
@@ -391,13 +407,13 @@
          &                 profdata%rlam,         profdata%rphi,        &
          &                 profdata%var(2)%vdep,                        &
-         &                 glamv,                 gphiv,                &
-         &                 gdept_1d,              vmask,                &
+         &                 pglam2,                pgphi2,               &
+         &                 gdept_1d,              zmask2,               &
          &                 profdata%nqc,          profdata%var(2)%nvqc, &
-         &                 iosdvobs,              ilanvobs,             &
-         &                 inlavobs,              ld_nea                )
-
-      CALL obs_mpp_sum_integer( iosdvobs, iosdvobsmpp )
-      CALL obs_mpp_sum_integer( ilanvobs, ilanvobsmpp )
-      CALL obs_mpp_sum_integer( inlavobs, inlavobsmpp )
+         &                 iosdv2obs,              ilanv2obs,           &
+         &                 inlav2obs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdv2obs, iosdv2obsmpp )
+      CALL obs_mpp_sum_integer( ilanv2obs, ilanv2obsmpp )
+      CALL obs_mpp_sum_integer( inlav2obs, inlav2obsmpp )
 
       ! -----------------------------------------------------------------------
@@ -405,7 +421,9 @@
       ! -----------------------------------------------------------------------
 
-      CALL obs_uv_rej( profdata, iuvchku, iuvchkv )
-      CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp )
-      CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp )
+      IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN
+         CALL obs_uv_rej( profdata, iuvchku, iuvchkv )
+         CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp )
+         CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp )
+      ENDIF
 
       ! -----------------------------------------------------------------------
@@ -446,41 +464,43 @@
       
       IF(lwp) THEN
+      
          WRITE(numout,*)
-         WRITE(numout,*) 'obs_pre_vel :'
-         WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*)
-         WRITE(numout,*) ' Profiles outside time domain                = ', &
+         WRITE(numout,*) ' Profiles outside time domain                     = ', &
             &            iotdobsmpp
-         WRITE(numout,*) ' Remaining profiles that failed grid search  = ', &
+         WRITE(numout,*) ' Remaining profiles that failed grid search       = ', &
             &            igrdobsmpp
-         WRITE(numout,*) ' Remaining U data outside space domain       = ', &
-            &            iosduobsmpp
-         WRITE(numout,*) ' Remaining U data at land points             = ', &
-            &            ilanuobsmpp
+         WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data outside space domain       = ', &
+            &            iosdv1obsmpp
+         WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data at land points             = ', &
+            &            ilanv1obsmpp
          IF (ld_nea) THEN
-            WRITE(numout,*) ' Remaining U data near land points (removed) = ',&
-               &            inlauobsmpp
+            WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (removed) = ',&
+               &            inlav1obsmpp
          ELSE
-            WRITE(numout,*) ' Remaining U data near land points (kept)    = ',&
-               &            inlauobsmpp
-         ENDIF
-         WRITE(numout,*) ' U observation rejected since V rejected     = ', &
-            &            iuvchku     
-         WRITE(numout,*) ' U data accepted                             = ', &
+            WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (kept)    = ',&
+               &            inlav1obsmpp
+         ENDIF
+         IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN
+            WRITE(numout,*) ' U observation rejected since V rejected     = ', &
+               &            iuvchku
+         ENDIF
+         WRITE(numout,*) ' '//prodatqc%cvars(1)//' data accepted                             = ', &
             &            prodatqc%nvprotmpp(1)
-         WRITE(numout,*) ' Remaining V data outside space domain       = ', &
-            &            iosdvobsmpp
-         WRITE(numout,*) ' Remaining V data at land points             = ', &
-            &            ilanvobsmpp
+         WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data outside space domain       = ', &
+            &            iosdv2obsmpp
+         WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data at land points             = ', &
+            &            ilanv2obsmpp
          IF (ld_nea) THEN
-            WRITE(numout,*) ' Remaining V data near land points (removed) = ',&
-               &            inlavobsmpp
+            WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (removed) = ',&
+               &            inlav2obsmpp
          ELSE
-            WRITE(numout,*) ' Remaining V data near land points (kept)    = ',&
-               &            inlavobsmpp
-         ENDIF
-         WRITE(numout,*) ' V observation rejected since U rejected     = ', &
-            &            iuvchkv     
-         WRITE(numout,*) ' V data accepted                             = ', &
+            WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (kept)    = ',&
+               &            inlav2obsmpp
+         ENDIF
+         IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN
+            WRITE(numout,*) ' V observation rejected since U rejected     = ', &
+               &            iuvchkv
+         ENDIF
+         WRITE(numout,*) ' '//prodatqc%cvars(2)//' data accepted                             = ', &
             &            prodatqc%nvprotmpp(2)
 
@@ -488,5 +508,7 @@
          WRITE(numout,*) ' Number of observations per time step :'
          WRITE(numout,*)
-         WRITE(numout,997)
+         WRITE(numout,'(10X,A,5X,A,5X,A,A)')'Time step','Profiles', &
+            &                               '     '//prodatqc%cvars(1)//'     ', &
+            &                               '     '//prodatqc%cvars(2)//'     '
          WRITE(numout,998)
       ENDIF
@@ -522,5 +544,4 @@
       ENDIF
 
-997   FORMAT(10X,'Time step',5X,'Profiles',5X,'Zonal Comp.',5X,'Meridional Comp.')
 998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'----------------')
 999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8)
@@ -728,6 +749,5 @@
       &                    kobsno,                                        &
       &                    kobsyea, kobsmon, kobsday, kobshou, kobsmin,   &
-      &                    ktyp,    kobsqc,  kobsstp, kotdobs, kdailyavtypes, &
-      &                    ld_dailyav )
+      &                    ktyp,    kobsqc,  kobsstp, kotdobs, kdailyavtypes )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE obs_coo_tim ***
@@ -773,5 +793,4 @@
       INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
          & kdailyavtypes    ! Types for daily averages
-      LOGICAL, OPTIONAL :: ld_dailyav    ! All types are daily averages
       !! * Local declarations
       INTEGER :: jobs
@@ -807,24 +826,4 @@
       ENDIF
 
-      !------------------------------------------------------------------------
-      ! If ld_dailyav is set then all data assumed to be daily averaged
-      !------------------------------------------------------------------------
-      
-      IF ( PRESENT( ld_dailyav) ) THEN
-         IF (ld_dailyav) THEN
-            DO jobs = 1, kobsno
-               
-               IF ( kobsqc(jobs) <= 10 ) THEN
-                  
-                  IF ( kobsstp(jobs) == (nit000 - 1) ) THEN
-                     kobsqc(jobs) = kobsqc(jobs) + 14
-                     kotdobs      = kotdobs + 1
-                     CYCLE
-                  ENDIF
-                  
-               ENDIF
-            END DO
-         ENDIF
-      ENDIF
 
    END SUBROUTINE obs_coo_tim_prof
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90	(revision 5682)
@@ -104,4 +104,7 @@
       ! Bookkeeping arrays with sizes equal to number of variables
 
+      CHARACTER(len=6), POINTER, DIMENSION(:) :: &
+         & cvars          !: Variable names
+
       INTEGER, POINTER, DIMENSION(:) :: &
          & nvprot,   &    !: Local total number of profile T data
@@ -237,4 +240,5 @@
 
       ALLOCATE( &
+         & prof%cvars(kvar),    &
          & prof%nvprot(kvar),   &
          & prof%nvprotmpp(kvar) &
@@ -242,4 +246,5 @@
          
       DO jvar = 1, kvar
+         prof%cvars    (jvar) = "NotSet"
          prof%nvprot   (jvar) = ko3dt(jvar)
          prof%nvprotmpp(jvar) = 0
@@ -452,5 +457,6 @@
 
       DEALLOCATE( &
-         & prof%nvprot,  &
+         & prof%cvars,    &
+         & prof%nvprot,   &
          & prof%nvprotmpp &
          )
@@ -770,4 +776,5 @@
       newprof%npj      = prof%npj
       newprof%npk      = prof%npk
+      newprof%cvars(:) = prof%cvars(:)
  
       ! Deallocate temporary data
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 5682)
@@ -50,5 +50,5 @@
 CONTAINS
 
-   SUBROUTINE obs_rea_altbias( kslano, sladata, k2dint, bias_file )
+   SUBROUTINE obs_rea_altbias( sladata, k2dint, bias_file )
       !!---------------------------------------------------------------------
       !!
@@ -70,6 +70,5 @@
       !
       !! * Arguments
-      INTEGER, INTENT(IN) :: kslano      ! Number of SLA Products
-      TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: &
+      TYPE(obs_surf), INTENT(INOUT) :: &
          & sladata       ! SLA data
       INTEGER, INTENT(IN) :: k2dint
@@ -80,5 +79,4 @@
       CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias'
 
-      INTEGER :: jslano       ! Data set loop variable
       INTEGER :: jobs         ! Obs loop variable
       INTEGER :: jpialtbias   ! Number of grid point in latitude for the bias
@@ -144,68 +142,63 @@
       ! Intepolate the bias already on the model grid at the observation point
   
-      DO jslano = 1, kslano
-
-         ALLOCATE( &
-            & igrdi(2,2,sladata(jslano)%nsurf), &
-            & igrdj(2,2,sladata(jslano)%nsurf), &
-            & zglam(2,2,sladata(jslano)%nsurf), &
-            & zgphi(2,2,sladata(jslano)%nsurf), &
-            & zmask(2,2,sladata(jslano)%nsurf), &
-            & zbias(2,2,sladata(jslano)%nsurf)  &
-            & )
-         
-         DO jobs = 1, sladata(jslano)%nsurf
-
-            igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1
-            igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1
-            igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1
-            igrdj(1,2,jobs) = sladata(jslano)%mj(jobs)
-            igrdi(2,1,jobs) = sladata(jslano)%mi(jobs)
-            igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1
-            igrdi(2,2,jobs) = sladata(jslano)%mi(jobs)
-            igrdj(2,2,jobs) = sladata(jslano)%mj(jobs)
-
-         END DO
-
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
-            &                  igrdi, igrdj, glamt, zglam )
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
-            &                  igrdi, igrdj, gphit, zgphi )
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
-            &                  igrdi, igrdj, tmask(:,:,1), zmask )
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
-            &                  igrdi, igrdj, z_altbias, zbias )
-
-         DO jobs = 1, sladata(jslano)%nsurf
-
-            zlam = sladata(jslano)%rlam(jobs)
-            zphi = sladata(jslano)%rphi(jobs)
-            iico = sladata(jslano)%mi(jobs)
-            ijco = sladata(jslano)%mj(jobs)
+      ALLOCATE( &
+         & igrdi(2,2,sladata%nsurf), &
+         & igrdj(2,2,sladata%nsurf), &
+         & zglam(2,2,sladata%nsurf), &
+         & zgphi(2,2,sladata%nsurf), &
+         & zmask(2,2,sladata%nsurf), &
+         & zbias(2,2,sladata%nsurf)  &
+         & )
+         
+      DO jobs = 1, sladata%nsurf
+
+         igrdi(1,1,jobs) = sladata%mi(jobs)-1
+         igrdj(1,1,jobs) = sladata%mj(jobs)-1
+         igrdi(1,2,jobs) = sladata%mi(jobs)-1
+         igrdj(1,2,jobs) = sladata%mj(jobs)
+         igrdi(2,1,jobs) = sladata%mi(jobs)
+         igrdj(2,1,jobs) = sladata%mj(jobs)-1
+         igrdi(2,2,jobs) = sladata%mi(jobs)
+         igrdj(2,2,jobs) = sladata%mj(jobs)
+
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, &
+         &                  igrdi, igrdj, tmask(:,:,1), zmask )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, &
+         &                  igrdi, igrdj, z_altbias, zbias )
+
+      DO jobs = 1, sladata%nsurf
+
+         zlam = sladata%rlam(jobs)
+         zphi = sladata%rphi(jobs)
+         iico = sladata%mi(jobs)
+         ijco = sladata%mj(jobs)
             
-            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
-               &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
-               &                   zmask(:,:,jobs), zweig, zobsmask )
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
+            &                   zmask(:,:,jobs), zweig, zobsmask )
             
-            CALL obs_int_h2d( 1, 1,      &
-               &              zweig, zbias(:,:,jobs),  zext )
-
-            ! adjust mdt with bias field
-            sladata(jslano)%rext(jobs,2) = &
-               sladata(jslano)%rext(jobs,2) - zext(1)
+         CALL obs_int_h2d( 1, 1,      &
+            &              zweig, zbias(:,:,jobs),  zext )
+
+         ! adjust mdt with bias field
+         sladata%rext(jobs,2) = sladata%rext(jobs,2) - zext(1)
             
-         END DO
-
-         DEALLOCATE( &
-            & igrdi, &
-            & igrdj, &
-            & zglam, &
-            & zgphi, &
-            & zmask, &
-            & zbias  &
-            & )
-         
       END DO
 
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zbias  &
+         & )
+         
       CALL wrk_dealloc(jpi,jpj,z_altbias) 
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 5682)
@@ -25,6 +25,6 @@
    USE netcdf                   ! NetCDF library
    USE obs_oper                 ! Observation operators
-   USE obs_prof_io              ! Profile files I/O (non-FB files)
    USE lib_mpp                  ! For ctl_warn/stop
+   USE obs_fbm                  ! Feedback routines
 
    IMPLICIT NONE
@@ -42,8 +42,8 @@
 
 CONTAINS
- 
-   SUBROUTINE obs_rea_prof( profdata, knumfiles, cfilenames, &
+
+   SUBROUTINE obs_rea_prof( profdata, knumfiles, cdfilenames, &
       &                     kvars, kextr, kstp, ddobsini, ddobsend, &
-      &                     ldt3d, lds3d, ldignmis, ldsatt, ldavtimset, &
+      &                     ldvar1, ldvar2, ldignmis, ldsatt, &
       &                     ldmod, kdailyavtypes )
       !!---------------------------------------------------------------------
@@ -62,28 +62,30 @@
       !! History :  
       !!      ! :  2009-09 (K. Mogensen) : New merged version of old routines
+      !!      ! :  2015-08 (M. Martin) : Merged profile and velocity routines
       !!----------------------------------------------------------------------
-      !! * Modules used
-   
+
       !! * Arguments
-      TYPE(obs_prof), INTENT(OUT) ::  profdata     ! Profile data to be read
-      INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in
+      TYPE(obs_prof), INTENT(OUT) :: &
+         & profdata                     ! Profile data to be read
+      INTEGER, INTENT(IN) :: knumfiles  ! Number of files to read
       CHARACTER(LEN=128), INTENT(IN) ::  &
-         & cfilenames(knumfiles)  ! File names to read in
+         & cdfilenames(knumfiles)        ! File names to read in
       INTEGER, INTENT(IN) :: kvars      ! Number of variables in profdata
-      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in profdata
-      INTEGER, INTENT(IN) :: kstp        ! Ocean time-step index
-      LOGICAL, INTENT(IN) :: ldt3d       ! Observed variables switches
-      LOGICAL, INTENT(IN) :: lds3d
-      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files
-      LOGICAL, INTENT(IN) :: ldsatt      ! Compute salinity at all temperature points
-      LOGICAL, INTENT(IN) :: ldavtimset  ! Correct time for daily averaged data
-      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data
-      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS
-      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS
+      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var
+      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldvar1     ! Observed variables switches
+      LOGICAL, INTENT(IN) :: ldvar2
+      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldsatt     ! Compute salinity at all temperature points
+      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
+      REAL(dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS
       INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
-         & kdailyavtypes
+         & kdailyavtypes                ! Types of daily average observations
 
       !! * Local declarations
       CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_prof'
+      CHARACTER(len=8) :: clrefdate
+      CHARACTER(len=6), DIMENSION(:), ALLOCATABLE :: clvars
       INTEGER :: jvar
       INTEGER :: ji
@@ -101,14 +103,24 @@
       INTEGER :: imin
       INTEGER :: isec
+      INTEGER :: iprof
+      INTEGER :: iproftot
+      INTEGER :: ivar1t0
+      INTEGER :: ivar2t0
+      INTEGER :: ivar1t
+      INTEGER :: ivar2t
+      INTEGER :: ip3dt
+      INTEGER :: ios
+      INTEGER :: ioserrcount
+      INTEGER :: ivar1tmpp
+      INTEGER :: ivar2tmpp
+      INTEGER :: ip3dtmpp
+      INTEGER :: itype
       INTEGER, DIMENSION(knumfiles) :: &
          & irefdate
       INTEGER, DIMENSION(ntyp1770+1) :: &
-         & itypt,    &
-         & ityptmpp, &
-         & ityps,    &
-         & itypsmpp 
-      INTEGER :: it3dtmpp
-      INTEGER :: is3dtmpp
-      INTEGER :: ip3dtmpp
+         & itypvar1,    &
+         & itypvar1mpp, &
+         & itypvar2,    &
+         & itypvar2mpp 
       INTEGER, DIMENSION(:), ALLOCATABLE :: &
          & iobsi,    &
@@ -118,40 +130,32 @@
          & ifileidx, &
          & iprofidx
-      INTEGER :: itype
       INTEGER, DIMENSION(imaxavtypes) :: &
          & idailyavtypes
+      INTEGER, DIMENSION(kvars) :: &
+         & iv3dt
       REAL(wp), DIMENSION(:), ALLOCATABLE :: &
          & zphi, &
          & zlam
-      real(wp), DIMENSION(:), ALLOCATABLE :: &
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
          & zdat
+      REAL(wp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
       LOGICAL :: llvalprof
+      LOGICAL :: lldavtimset
       TYPE(obfbdata), POINTER, DIMENSION(:) :: &
          & inpfiles
-      real(wp), DIMENSION(knumfiles) :: &
-         & djulini, &
-         & djulend
-      INTEGER :: iprof
-      INTEGER :: iproftot
-      INTEGER :: it3dt0
-      INTEGER :: is3dt0
-      INTEGER :: it3dt
-      INTEGER :: is3dt
-      INTEGER :: ip3dt
-      INTEGER :: ios
-      INTEGER :: ioserrcount
-      INTEGER, DIMENSION(kvars) :: &
-         & iv3dt
-      CHARACTER(len=8) :: cl_refdate
-   
+
       ! Local initialization
       iprof = 0
-      it3dt0 = 0
-      is3dt0 = 0
+      ivar1t0 = 0
+      ivar2t0 = 0
       ip3dt = 0
 
       ! Daily average types
+      lldavtimset = .FALSE.
       IF ( PRESENT(kdailyavtypes) ) THEN
          idailyavtypes(:) = kdailyavtypes(:)
+         IF ( ANY (idailyavtypes(:) /= -1) ) lldavtimset = .TRUE.
       ELSE
          idailyavtypes(:) = -1
@@ -159,21 +163,13 @@
 
       !-----------------------------------------------------------------------
-      ! Check data the model part is just with feedback data files
-      !-----------------------------------------------------------------------
-      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
-         CALL ctl_stop( 'Model can only be read from feedback data' )
-         RETURN
-      ENDIF
-
-      !-----------------------------------------------------------------------
       ! Count the number of files needed and allocate the obfbdata type
       !-----------------------------------------------------------------------
-      
+
       inobf = knumfiles
-      
+
       ALLOCATE( inpfiles(inobf) )
 
       prof_files : DO jj = 1, inobf
-          
+
          !---------------------------------------------------------------------
          ! Prints
@@ -182,5 +178,5 @@
             WRITE(numout,*)
             WRITE(numout,*) ' obs_rea_pro_dri : Reading from file = ', &
-               & TRIM( TRIM( cfilenames(jj) ) )
+               & TRIM( TRIM( cdfilenames(jj) ) )
             WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
             WRITE(numout,*)
@@ -190,25 +186,25 @@
          !  Initialization: Open file and get dimensions only
          !---------------------------------------------------------------------
-         
-         iflag = nf90_open( TRIM( cfilenames(jj) ), nf90_nowrite, &
+
+         iflag = nf90_open( TRIM( cdfilenames(jj) ), nf90_nowrite, &
             &                      i_file_id )
-         
+
          IF ( iflag /= nf90_noerr ) THEN
 
             IF ( ldignmis ) THEN
                inpfiles(jj)%nobs = 0
-               CALL ctl_warn( 'File ' // TRIM( cfilenames(jj) ) // &
+               CALL ctl_warn( 'File ' // TRIM( cdfilenames(jj) ) // &
                   &           ' not found' )
             ELSE 
-               CALL ctl_stop( 'File ' // TRIM( cfilenames(jj) ) // &
+               CALL ctl_stop( 'File ' // TRIM( cdfilenames(jj) ) // &
                   &           ' not found' )
             ENDIF
 
          ELSE 
-            
+
             !------------------------------------------------------------------
-            !  Close the file since it is opened in read_proffile
+            !  Close the file since it is opened in read_obfbdata
             !------------------------------------------------------------------
-            
+
             iflag = nf90_close( i_file_id )
 
@@ -217,21 +213,30 @@
             !------------------------------------------------------------------
             CALL init_obfbdata( inpfiles(jj) )
-            IF(lwp) THEN
-               WRITE(numout,*)
-               WRITE(numout,*)'Reading from feedback file :', &
-                  &           TRIM( cfilenames(jj) )
-            ENDIF
-            CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+            CALL read_obfbdata( TRIM( cdfilenames(jj) ), inpfiles(jj), &
                &                ldgrid = .TRUE. )
-               
+
             IF ( inpfiles(jj)%nvar < 2 ) THEN
-               CALL ctl_stop( 'Feedback format error' )
-               RETURN
-            ENDIF
+               CALL ctl_stop( 'Feedback format error: ', &
+                  &           ' less than 2 vars in profile file' )
+            ENDIF
+
             IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
                CALL ctl_stop( 'Model not in input data' )
-               RETURN
-            ENDIF
-            
+            ENDIF
+
+            IF ( jj == 1 ) THEN
+               ALLOCATE( clvars( inpfiles(jj)%nvar ) )
+               DO ji = 1, inpfiles(jj)%nvar
+                 clvars(ji) = inpfiles(jj)%cname(ji)
+               END DO
+            ELSE
+               DO ji = 1, inpfiles(jj)%nvar
+                  IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN
+                     CALL ctl_stop( 'Feedback file variables not consistent', &
+                        &           ' with previous files for this type' )
+                  ENDIF
+               END DO
+            ENDIF
+
             !------------------------------------------------------------------
             !  Change longitude (-180,180)
@@ -251,7 +256,7 @@
             !  Calculate the date  (change eventually)
             !------------------------------------------------------------------
-            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
-            READ(cl_refdate,'(I8)') irefdate(jj)
-            
+            clrefdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(clrefdate,'(I8)') irefdate(jj)
+
             CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
             CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
@@ -262,22 +267,34 @@
 
             ioserrcount=0
-            IF ( ldavtimset ) THEN
+            IF ( lldavtimset ) THEN
+
+               IF ( ANY ( idailyavtypes(:) /= -1 ) .AND. lwp) THEN
+                  WRITE(numout,*)' Resetting time of daily averaged', &
+                     &           ' observations to the end of the day'
+               ENDIF
+
                DO ji = 1, inpfiles(jj)%nobs
-                  ! 
-                  !  for daily averaged data for example
-                  !  MRB data (itype==820) force the time
-                  !  to be the  end of the day
-                  !
                   READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 900 ) itype
 900               IF ( ios /= 0 ) THEN
-                     itype = 0         ! Set type to zero if there is a problem in the string conversion
+                     ! Set type to zero if there is a problem in the string conversion
+                     itype = 0
                   ENDIF
-                  IF ( ANY (idailyavtypes == itype ) ) THEN
-                     inpfiles(jj)%ptim(ji) = &
-                     & INT(inpfiles(jj)%ptim(ji)) + 1
+
+                  IF ( ANY ( idailyavtypes(:) == itype ) ) THEN
+                  !  for daily averaged data force the time
+                  !  to be the last time-step of the day, but still within the day.
+                     IF ( inpfiles(jj)%ptim(ji) >= 0. ) THEN
+                        inpfiles(jj)%ptim(ji) = &
+                           & INT(inpfiles(jj)%ptim(ji)) + 0.9999
+                     ELSE
+                        inpfiles(jj)%ptim(ji) = &
+                           & INT(inpfiles(jj)%ptim(ji)) - 0.0001
+                     ENDIF
                   ENDIF
+
                END DO
-            ENDIF
-            
+
+            ENDIF
+
             IF ( inpfiles(jj)%nobs > 0 ) THEN
                inpfiles(jj)%iproc = -1
@@ -342,5 +359,5 @@
                   ENDIF
                   llvalprof = .FALSE.
-                  IF ( ldt3d ) THEN
+                  IF ( ldvar1 ) THEN
                      loop_t_count : DO ij = 1,inpfiles(jj)%nlev
                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
@@ -348,9 +365,9 @@
                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                           it3dt0 = it3dt0 + 1
+                           ivar1t0 = ivar1t0 + 1
                         ENDIF
                      END DO loop_t_count
                   ENDIF
-                  IF ( lds3d ) THEN
+                  IF ( ldvar2 ) THEN
                      loop_s_count : DO ij = 1,inpfiles(jj)%nlev
                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
@@ -358,5 +375,5 @@
                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                           is3dt0 = is3dt0 + 1
+                           ivar2t0 = ivar2t0 + 1
                         ENDIF
                      END DO loop_s_count
@@ -367,8 +384,8 @@
                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
-                        &     ldt3d ) .OR. &
+                        &     ldvar1 ) .OR. &
                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
-                        &     lds3d ) ) THEN
+                        &     ldvar2 ) ) THEN
                         ip3dt = ip3dt + 1
                         llvalprof = .TRUE.
@@ -384,5 +401,5 @@
 
       END DO prof_files
-      
+
       !-----------------------------------------------------------------------
       ! Get the time ordered indices of the input data
@@ -425,5 +442,5 @@
          &               zdat,     &
          &               iindx   )
-      
+
       iv3dt(:) = -1
       IF (ldsatt) THEN
@@ -431,29 +448,29 @@
          iv3dt(2) = ip3dt
       ELSE
-         iv3dt(1) = it3dt0
-         iv3dt(2) = is3dt0
+         iv3dt(1) = ivar1t0
+         iv3dt(2) = ivar2t0
       ENDIF
       CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, &
          &                 kstp, jpi, jpj, jpk )
-      
+
       ! * Read obs/positions, QC, all variable and assign to profdata
 
       profdata%nprof     = 0
       profdata%nvprot(:) = 0
-
+      profdata%cvars(:)  = clvars(:)
       iprof = 0
 
       ip3dt = 0
-      it3dt = 0
-      is3dt = 0
-      itypt   (:) = 0
-      ityptmpp(:) = 0
-      
-      ityps   (:) = 0
-      itypsmpp(:) = 0
-      
-      ioserrcount = 0      
+      ivar1t = 0
+      ivar2t = 0
+      itypvar1   (:) = 0
+      itypvar1mpp(:) = 0
+
+      itypvar2   (:) = 0
+      itypvar2mpp(:) = 0
+
+      ioserrcount = 0
       DO jk = 1, iproftot
-         
+
          jj = ifileidx(iindx(jk))
          ji = iprofidx(iindx(jk))
@@ -465,5 +482,5 @@
          IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
             & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
-            
+
             IF ( nproc == 0 ) THEN
                IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
@@ -471,5 +488,5 @@
                IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
             ENDIF
-            
+
             llvalprof = .FALSE.
 
@@ -480,30 +497,30 @@
 
             loop_prof : DO ij = 1, inpfiles(jj)%nlev
-               
+
                IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
                   & CYCLE
-               
+
                IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                  
+
                   llvalprof = .TRUE. 
                   EXIT loop_prof
-                  
+
                ENDIF
-               
+
                IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                  
+
                   llvalprof = .TRUE. 
                   EXIT loop_prof
-                  
+
                ENDIF
-               
+
             END DO loop_prof
-            
+
             ! Set profile information
-            
+
             IF ( llvalprof ) THEN
-               
+
                iprof = iprof + 1
 
@@ -524,5 +541,5 @@
                profdata%nhou(iprof) = ihou
                profdata%nmin(iprof) = imin
-               
+
                ! Profile space coordinates
                profdata%rlam(iprof) = inpfiles(jj)%plam(ji)
@@ -532,8 +549,8 @@
                profdata%mi  (iprof,:) = inpfiles(jj)%iobsi(ji,1)
                profdata%mj  (iprof,:) = inpfiles(jj)%iobsj(ji,1)
-               
+
                ! Profile WMO number
                profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji)
-               
+
                ! Instrument type
                READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype
@@ -543,7 +560,7 @@
                   itype = 0
                ENDIF
-               
+
                profdata%ntyp(iprof) = itype
-               
+
                ! QC stuff
 
@@ -564,6 +581,6 @@
                profdata%nqc(iprof)  = 0 !TODO
 
-               loop_p : DO ij = 1, inpfiles(jj)%nlev            
-                  
+               loop_p : DO ij = 1, inpfiles(jj)%nlev
+
                   IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
                      & CYCLE
@@ -573,135 +590,135 @@
                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
-                        &     ldt3d ) .OR. &
+                        &     ldvar1 ) .OR. &
                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
-                        &     lds3d ) ) THEN
+                        &     ldvar2 ) ) THEN
                         ip3dt = ip3dt + 1
                      ELSE
                         CYCLE
                      ENDIF
-                     
+
                   ENDIF
 
                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
                      &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
-                     &       ldt3d ) .OR. ldsatt ) THEN
-                     
+                     &       ldvar1 ) .OR. ldsatt ) THEN
+
                      IF (ldsatt) THEN
 
-                        it3dt = ip3dt
+                        ivar1t = ip3dt
 
                      ELSE
 
-                        it3dt = it3dt + 1
-                        
+                        ivar1t = ivar1t + 1
+
                      ENDIF
 
-                     ! Depth of T observation
-                     profdata%var(1)%vdep(it3dt) = &
+                     ! Depth of var1 observation
+                     profdata%var(1)%vdep(ivar1t) = &
                         &                inpfiles(jj)%pdep(ij,ji)
-                     
-                     ! Depth of T observation QC
-                     profdata%var(1)%idqc(it3dt) = &
+
+                     ! Depth of var1 observation QC
+                     profdata%var(1)%idqc(ivar1t) = &
                         &                inpfiles(jj)%idqc(ij,ji)
-                     
-                     ! Depth of T observation QC flags
-                     profdata%var(1)%idqcf(:,it3dt) = &
+
+                     ! Depth of var1 observation QC flags
+                     profdata%var(1)%idqcf(:,ivar1t) = &
                         &                inpfiles(jj)%idqcf(:,ij,ji)
-                     
+
                      ! Profile index
-                     profdata%var(1)%nvpidx(it3dt) = iprof
-                     
+                     profdata%var(1)%nvpidx(ivar1t) = iprof
+
                      ! Vertical index in original profile
-                     profdata%var(1)%nvlidx(it3dt) = ij
-
-                     ! Profile potential T value
+                     profdata%var(1)%nvlidx(ivar1t) = ij
+
+                     ! Profile potential var1 value
                      IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
                         & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                        profdata%var(1)%vobs(it3dt) = &
+                        profdata%var(1)%vobs(ivar1t) = &
                            &                inpfiles(jj)%pob(ij,ji,1)
                         IF ( ldmod ) THEN
-                           profdata%var(1)%vmod(it3dt) = &
+                           profdata%var(1)%vmod(ivar1t) = &
                               &                inpfiles(jj)%padd(ij,ji,1,1)
                         ENDIF
-                        ! Count number of profile T data as function of type
-                        itypt( profdata%ntyp(iprof) + 1 ) = &
-                           & itypt( profdata%ntyp(iprof) + 1 ) + 1
+                        ! Count number of profile var1 data as function of type
+                        itypvar1( profdata%ntyp(iprof) + 1 ) = &
+                           & itypvar1( profdata%ntyp(iprof) + 1 ) + 1
                      ELSE
-                        profdata%var(1)%vobs(it3dt) = fbrmdi
+                        profdata%var(1)%vobs(ivar1t) = fbrmdi
                      ENDIF
 
-                     ! Profile T qc
-                     profdata%var(1)%nvqc(it3dt) = &
+                     ! Profile var1 qc
+                     profdata%var(1)%nvqc(ivar1t) = &
                         & inpfiles(jj)%ivlqc(ij,ji,1)
 
-                     ! Profile T qc flags
-                     profdata%var(1)%nvqcf(:,it3dt) = &
+                     ! Profile var1 qc flags
+                     profdata%var(1)%nvqcf(:,ivar1t) = &
                         & inpfiles(jj)%ivlqcf(:,ij,ji,1)
 
                      ! Profile insitu T value
-                     profdata%var(1)%vext(it3dt,1) = &
+                     profdata%var(1)%vext(ivar1t,1) = &
                         &                inpfiles(jj)%pext(ij,ji,1)
-                     
+
                   ENDIF
-                  
+
                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
                      &   ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
-                     &   lds3d ) .OR. ldsatt ) THEN
-                     
+                     &   ldvar2 ) .OR. ldsatt ) THEN
+
                      IF (ldsatt) THEN
 
-                        is3dt = ip3dt
+                        ivar2t = ip3dt
 
                      ELSE
 
-                        is3dt = is3dt + 1
-                        
+                        ivar2t = ivar2t + 1
+
                      ENDIF
 
-                     ! Depth of S observation
-                     profdata%var(2)%vdep(is3dt) = &
+                     ! Depth of var2 observation
+                     profdata%var(2)%vdep(ivar2t) = &
                         &                inpfiles(jj)%pdep(ij,ji)
-                     
-                     ! Depth of S observation QC
-                     profdata%var(2)%idqc(is3dt) = &
+
+                     ! Depth of var2 observation QC
+                     profdata%var(2)%idqc(ivar2t) = &
                         &                inpfiles(jj)%idqc(ij,ji)
-                     
-                     ! Depth of S observation QC flags
-                     profdata%var(2)%idqcf(:,is3dt) = &
+
+                     ! Depth of var2 observation QC flags
+                     profdata%var(2)%idqcf(:,ivar2t) = &
                         &                inpfiles(jj)%idqcf(:,ij,ji)
-                     
+
                      ! Profile index
-                     profdata%var(2)%nvpidx(is3dt) = iprof
-                     
+                     profdata%var(2)%nvpidx(ivar2t) = iprof
+
                      ! Vertical index in original profile
-                     profdata%var(2)%nvlidx(is3dt) = ij
-
-                     ! Profile S value
+                     profdata%var(2)%nvlidx(ivar2t) = ij
+
+                     ! Profile var2 value
                      IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
                         & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
-                        profdata%var(2)%vobs(is3dt) = &
+                        profdata%var(2)%vobs(ivar2t) = &
                            &                inpfiles(jj)%pob(ij,ji,2)
                         IF ( ldmod ) THEN
-                           profdata%var(2)%vmod(is3dt) = &
+                           profdata%var(2)%vmod(ivar2t) = &
                               &                inpfiles(jj)%padd(ij,ji,1,2)
                         ENDIF
-                        ! Count number of profile S data as function of type
-                        ityps( profdata%ntyp(iprof) + 1 ) = &
-                           & ityps( profdata%ntyp(iprof) + 1 ) + 1
+                        ! Count number of profile var2 data as function of type
+                        itypvar2( profdata%ntyp(iprof) + 1 ) = &
+                           & itypvar2( profdata%ntyp(iprof) + 1 ) + 1
                      ELSE
-                        profdata%var(2)%vobs(is3dt) = fbrmdi
+                        profdata%var(2)%vobs(ivar2t) = fbrmdi
                      ENDIF
-                     
-                     ! Profile S qc
-                     profdata%var(2)%nvqc(is3dt) = &
+
+                     ! Profile var2 qc
+                     profdata%var(2)%nvqc(ivar2t) = &
                         & inpfiles(jj)%ivlqc(ij,ji,2)
 
-                     ! Profile S qc flags
-                     profdata%var(2)%nvqcf(:,is3dt) = &
+                     ! Profile var2 qc flags
+                     profdata%var(2)%nvqcf(:,ivar2t) = &
                         & inpfiles(jj)%ivlqcf(:,ij,ji,2)
 
                   ENDIF
-            
+
                END DO loop_p
 
@@ -715,12 +732,12 @@
       ! Sum up over processors
       !-----------------------------------------------------------------------
-      
-      CALL obs_mpp_sum_integer ( it3dt0, it3dtmpp )
-      CALL obs_mpp_sum_integer ( is3dt0, is3dtmpp )
-      CALL obs_mpp_sum_integer ( ip3dt, ip3dtmpp )
-      
-      CALL obs_mpp_sum_integers( itypt, ityptmpp, ntyp1770 + 1 )
-      CALL obs_mpp_sum_integers( ityps, itypsmpp, ntyp1770 + 1 )
-      
+
+      CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp )
+      CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp )
+      CALL obs_mpp_sum_integer ( ip3dt,   ip3dtmpp  )
+
+      CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 )
+      CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 )
+
       !-----------------------------------------------------------------------
       ! Output number of observations.
@@ -728,14 +745,14 @@
       IF(lwp) THEN
          WRITE(numout,*) 
-         WRITE(numout,'(1X,A)') 'Profile data'
+         WRITE(numout,'(A)') ' Profile data'
          WRITE(numout,'(1X,A)') '------------'
          WRITE(numout,*) 
-         WRITE(numout,'(1X,A)') 'Profile T data'
-         WRITE(numout,'(1X,A)') '--------------'
+         WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(1) )
+         WRITE(numout,'(1X,A)') '------------------------'
          DO ji = 0, ntyp1770
-            IF ( ityptmpp(ji+1) > 0 ) THEN
+            IF ( itypvar1mpp(ji+1) > 0 ) THEN
                WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), &
                   & cwmonam1770(ji)(1:52),' = ', &
-                  & ityptmpp(ji+1)
+                  & itypvar1mpp(ji+1)
             ENDIF
          END DO
@@ -743,16 +760,16 @@
             & '---------------------------------------------------------------'
          WRITE(numout,'(1X,A55,I8)') &
-            & 'Total profile T data                                 = ',&
-            & it3dtmpp
+            & 'Total profile data for variable '//TRIM( profdata%cvars(1) )// &
+            & '             = ', ivar1tmpp
          WRITE(numout,'(1X,A)') &
             & '---------------------------------------------------------------'
          WRITE(numout,*) 
-         WRITE(numout,'(1X,A)') 'Profile S data'
-         WRITE(numout,'(1X,A)') '--------------'
+         WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) )
+         WRITE(numout,'(1X,A)') '------------------------'
          DO ji = 0, ntyp1770
-            IF ( itypsmpp(ji+1) > 0 ) THEN
+            IF ( itypvar2mpp(ji+1) > 0 ) THEN
                WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), &
                   & cwmonam1770(ji)(1:52),' = ', &
-                  & itypsmpp(ji+1)
+                  & itypvar2mpp(ji+1)
             ENDIF
          END DO
@@ -760,11 +777,11 @@
             & '---------------------------------------------------------------'
          WRITE(numout,'(1X,A55,I8)') &
-            & 'Total profile S data                                 = ',&
-            & is3dtmpp
+            & 'Total profile data for variable '//TRIM( profdata%cvars(2) )// &
+            & '             = ', ivar2tmpp
          WRITE(numout,'(1X,A)') &
             & '---------------------------------------------------------------'
          WRITE(numout,*) 
       ENDIF
-      
+
       IF (ldsatt) THEN
          profdata%nvprot(1)    = ip3dt
@@ -773,8 +790,8 @@
          profdata%nvprotmpp(2) = ip3dtmpp
       ELSE
-         profdata%nvprot(1)    = it3dt
-         profdata%nvprot(2)    = is3dt
-         profdata%nvprotmpp(1) = it3dtmpp
-         profdata%nvprotmpp(2) = is3dtmpp
+         profdata%nvprot(1)    = ivar1t
+         profdata%nvprot(2)    = ivar2t
+         profdata%nvprotmpp(1) = ivar1tmpp
+         profdata%nvprotmpp(2) = ivar2tmpp
       ENDIF
       profdata%nprof        = iprof
@@ -783,15 +800,15 @@
       ! Model level search
       !-----------------------------------------------------------------------
-      IF ( ldt3d ) THEN
+      IF ( ldvar1 ) THEN
          CALL obs_level_search( jpk, gdept_1d, &
             & profdata%nvprot(1), profdata%var(1)%vdep, &
             & profdata%var(1)%mvk )
       ENDIF
-      IF ( lds3d ) THEN
+      IF ( ldvar2 ) THEN
          CALL obs_level_search( jpk, gdept_1d, &
             & profdata%nvprot(2), profdata%var(2)%vdep, &
             & profdata%var(2)%mvk )
       ENDIF
-      
+
       !-----------------------------------------------------------------------
       ! Set model equivalent to 99999
@@ -805,5 +822,5 @@
       ! Deallocate temporary data
       !-----------------------------------------------------------------------
-      DEALLOCATE( ifileidx, iprofidx, zdat )
+      DEALLOCATE( ifileidx, iprofidx, zdat, clvars )
 
       !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90	(revision 5682)
@@ -9,5 +9,5 @@
    !!----------------------------------------------------------------------
 
-   !! * Modules used   
+   !! * Modules used
    USE par_kind                 ! Precision variables
    USE in_out_manager           ! I/O manager
@@ -20,4 +20,5 @@
    USE obs_surf_def             ! Surface observation definitions
    USE obs_types                ! Observation type definitions
+   USE obs_fbm                  ! Feedback routines
    USE netcdf                   ! NetCDF library
 
@@ -28,5 +29,5 @@
 
    PUBLIC obs_rea_surf      ! Read the surface observations from the point data
-   
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -37,7 +38,7 @@
 CONTAINS
 
-   SUBROUTINE obs_rea_surf( surfdata, knumfiles, cfilenames, &
+   SUBROUTINE obs_rea_surf( surfdata, knumfiles, cdfilenames, &
       &                     kvars, kextr, kstp, ddobsini, ddobsend, &
-      &                     ldignmis, ldmod )
+      &                     ldignmis, ldmod, ldnightav )
       !!---------------------------------------------------------------------
       !!
@@ -59,17 +60,22 @@
 
       !! * Arguments
-      TYPE(obs_surf), INTENT(INOUT) :: surfdata   ! Surface data to be read
-      INTEGER, INTENT(IN) :: knumfiles    ! Number of corio format files to read in
-      CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & surfdata                     ! Surface data to be read
+      INTEGER, INTENT(IN) :: knumfiles  ! Number of corio format files to read
+      CHARACTER(LEN=128), INTENT(IN) :: &
+         & cdfilenames(knumfiles)       ! File names to read in
       INTEGER, INTENT(IN) :: kvars      ! Number of variables in surfdata
-      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in surfdata
+      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var
       INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
       LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
       LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
-      REAL(KIND=dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS
-      REAL(KIND=dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS
-         
+      LOGICAL, INTENT(IN) :: ldnightav  ! Observations represent a night-time average
+      REAL(dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS
+
       !! * Local declarations
       CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_surf'
+      CHARACTER(len=8) :: clrefdate
+      CHARACTER(len=6), DIMENSION(:), ALLOCATABLE :: clvars
       INTEGER :: ji
       INTEGER :: jj
@@ -85,8 +91,13 @@
       INTEGER :: imin
       INTEGER :: isec
+      INTEGER :: itype
+      INTEGER :: iobsmpp
+      INTEGER :: iobs
+      INTEGER :: iobstot
+      INTEGER :: ios
+      INTEGER :: ioserrcount
+      INTEGER, PARAMETER :: jpsurfmaxtype = 1024
       INTEGER, DIMENSION(knumfiles) :: irefdate
-      INTEGER :: iobsmpp
-      INTEGER, PARAMETER :: isurfmaxtype = 1024
-      INTEGER, DIMENSION(0:isurfmaxtype) :: &
+      INTEGER, DIMENSION(jpsurfmaxtype+1) :: &
          & ityp, &
          & itypmpp
@@ -98,45 +109,29 @@
          & ifileidx, &
          & isurfidx
-      INTEGER :: itype
       REAL(wp), DIMENSION(:), ALLOCATABLE :: &
          & zphi, &
          & zlam
-      real(wp), DIMENSION(:), ALLOCATABLE :: &
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
          & zdat
+      REAL(wp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
       LOGICAL :: llvalprof
       TYPE(obfbdata), POINTER, DIMENSION(:) :: &
          & inpfiles
-      real(wp), DIMENSION(knumfiles) :: &
-         & djulini, &
-         & djulend
-      INTEGER :: iobs
-      INTEGER :: iobstot
-      INTEGER :: ios
-      INTEGER :: ioserrcount
-      CHARACTER(len=8) :: cl_refdate
-   
+
       ! Local initialization
       iobs = 0
- 
-      !-----------------------------------------------------------------------
-      ! Check data the model part is just with feedback data files
-      !-----------------------------------------------------------------------
-      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
-         CALL ctl_stop( 'Model can only be read from feedback data' )
-         RETURN
-      ENDIF
 
       !-----------------------------------------------------------------------
       ! Count the number of files needed and allocate the obfbdata type
       !-----------------------------------------------------------------------
-      
+
       inobf = knumfiles
-      
+
       ALLOCATE( inpfiles(inobf) )
 
       surf_files : DO jj = 1, inobf
 
-         CALL init_obfbdata( inpfiles(jj) )
-          
          !---------------------------------------------------------------------
          ! Prints
@@ -145,5 +140,5 @@
             WRITE(numout,*)
             WRITE(numout,*) ' obs_rea_surf : Reading from file = ', &
-               & TRIM( TRIM( cfilenames(jj) ) )
+               & TRIM( TRIM( cdfilenames(jj) ) )
             WRITE(numout,*) ' ~~~~~~~~~~~'
             WRITE(numout,*)
@@ -153,25 +148,25 @@
          !  Initialization: Open file and get dimensions only
          !---------------------------------------------------------------------
-         
-         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+
+         iflag = nf90_open( TRIM( TRIM( cdfilenames(jj) ) ), nf90_nowrite, &
             &                      i_file_id )
-         
+
          IF ( iflag /= nf90_noerr ) THEN
 
             IF ( ldignmis ) THEN
                inpfiles(jj)%nobs = 0
-               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cdfilenames(jj) ) ) // &
                   &           ' not found' )
             ELSE 
-               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cdfilenames(jj) ) ) // &
                   &           ' not found' )
             ENDIF
 
          ELSE 
-            
-            !------------------------------------------------------------------
-            !  Close the file since it is opened in read_proffile
-            !------------------------------------------------------------------
-            
+
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_obfbdata
+            !------------------------------------------------------------------
+
             iflag = nf90_close( i_file_id )
 
@@ -179,11 +174,8 @@
             !  Read the profile file into inpfiles
             !------------------------------------------------------------------
-            IF(lwp) THEN
-               WRITE(numout,*)
-               WRITE(numout,*)'Reading from feedback file :', &
-                  &           TRIM( cfilenames(jj) )
-            ENDIF
-            CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+            CALL init_obfbdata( inpfiles(jj) )
+            CALL read_obfbdata( TRIM( cdfilenames(jj) ), inpfiles(jj), &
                &                ldgrid = .TRUE. )
+
             IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
                CALL ctl_stop( 'Model not in input data' )
@@ -191,9 +183,23 @@
             ENDIF
 
+            IF ( jj == 1 ) THEN
+               ALLOCATE( clvars( inpfiles(jj)%nvar ) )
+               DO ji = 1, inpfiles(jj)%nvar
+                 clvars(ji) = inpfiles(jj)%cname(ji)
+               END DO
+            ELSE
+               DO ji = 1, inpfiles(jj)%nvar
+                  IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN
+                     CALL ctl_stop( 'Feedback file variables not consistent', &
+                        &           ' with previous files for this type' )
+                  ENDIF
+               END DO
+            ENDIF
+
             !------------------------------------------------------------------
             !  Change longitude (-180,180)
             !------------------------------------------------------------------
 
-            DO ji = 1, inpfiles(jj)%nobs 
+            DO ji = 1, inpfiles(jj)%nobs
 
                IF ( inpfiles(jj)%plam(ji) < -180. ) &
@@ -208,7 +214,7 @@
             !  Calculate the date  (change eventually)
             !------------------------------------------------------------------
-            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
-            READ(cl_refdate,'(I8)') irefdate(jj)
-            
+            clrefdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(clrefdate,'(I8)') irefdate(jj)
+
             CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
             CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
@@ -217,4 +223,25 @@
             CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
                &           krefdate = irefdate(jj) )
+
+            IF ( ldnightav ) THEN
+
+               IF ( lwp ) THEN
+                  WRITE(numout,*)'Resetting time of night-time averaged observations', &
+                     &             ' to the end of the day'
+               ENDIF
+
+               DO ji = 1, inpfiles(jj)%nobs
+                  !  for night-time averaged data force the time
+                  !  to be the last time-step of the day, but still within the day.
+                  IF ( inpfiles(jj)%ptim(ji) >= 0. ) THEN
+                     inpfiles(jj)%ptim(ji) = &
+                        & INT(inpfiles(jj)%ptim(ji)) + 0.9999
+                  ELSE
+                     inpfiles(jj)%ptim(ji) = &
+                        & INT(inpfiles(jj)%ptim(ji)) - 0.0001
+                  ENDIF
+               END DO
+            ENDIF
+
             IF ( inpfiles(jj)%nobs > 0 ) THEN
                inpfiles(jj)%iproc = -1
@@ -312,23 +339,25 @@
          &               zdat,     &
          &               iindx   )
-      
+
       CALL obs_surf_alloc( surfdata, iobs, kvars, kextr, kstp, jpi, jpj )
-      
-      ! * Read obs/positions, QC, all variable and assign to surfdata
- 
+
+      ! Read obs/positions, QC, all variable and assign to surfdata
+
       iobs = 0
+
+      surfdata%cvars(:)  = clvars(:)
 
       ityp   (:) = 0
       itypmpp(:) = 0
-      
+
       ioserrcount = 0
-      
+
       DO jk = 1, iobstot
-         
+
          jj = ifileidx(iindx(jk))
          ji = isurfidx(iindx(jk))
          IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
             & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
-            
+
             IF ( nproc == 0 ) THEN
                IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
@@ -336,7 +365,7 @@
                IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
             ENDIF
-            
+
             ! Set observation information
-            
+
             IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
                & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
@@ -360,5 +389,5 @@
                surfdata%nhou(iobs) = ihou
                surfdata%nmin(iobs) = imin
-               
+
                ! Surface space coordinates
                surfdata%rlam(iobs) = inpfiles(jj)%plam(ji)
@@ -368,17 +397,20 @@
                surfdata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
                surfdata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
-               
+
                ! Instrument type
                READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype
 901            IF ( ios /= 0 ) THEN
-                  IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' ) 
+                  IF (ioserrcount == 0) THEN
+                     CALL ctl_warn ( 'Problem converting an instrument type ', &
+                        &            'to integer. Setting type to zero' )
+                  ENDIF
                   ioserrcount = ioserrcount + 1
                   itype = 0
                ENDIF
                surfdata%ntyp(iobs) = itype
-               IF ( itype < isurfmaxtype + 1 ) THEN
+               IF ( itype < jpsurfmaxtype + 1 ) THEN
                   ityp(itype+1) = ityp(itype+1) + 1
                ELSE
-                  IF(lwp)WRITE(numout,*)'WARNING:Increase isurfmaxtype in ',&
+                  IF(lwp)WRITE(numout,*)'WARNING:Increase jpsurfmaxtype in ',&
                      &                  cpname
                ENDIF
@@ -398,6 +430,11 @@
                IF ( ldmod ) THEN
                   surfdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
-               ELSE
+                  IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) THEN
+                     surfdata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1)
+                     surfdata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1)
+                  ENDIF
+                ELSE
                   surfdata%rmod(iobs,1) = fbrmdi
+                  IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) surfdata%rext(iobs,:) = fbrmdi
                ENDIF
             ENDIF
@@ -409,7 +446,8 @@
       ! Sum up over processors
       !-----------------------------------------------------------------------
-      
+
       CALL obs_mpp_sum_integer( iobs, iobsmpp )
-      
+      CALL obs_mpp_sum_integers( ityp, itypmpp, jpsurfmaxtype + 1 )
+
       !-----------------------------------------------------------------------
       ! Output number of observations.
@@ -418,5 +456,5 @@
 
          WRITE(numout,*)
-         WRITE(numout,'(1X,A)')'Surface data types'
+         WRITE(numout,'(1X,A)')TRIM( surfdata%cvars(1) )//' data'
          WRITE(numout,'(1X,A)')'--------------'
          DO jj = 1,8
@@ -425,6 +463,11 @@
             ENDIF
          END DO
-         WRITE(numout,'(1X,A50)')'--------------------------------------------------'
-         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,'(1X,A,I8)') &
+            & 'Total data for variable '//TRIM( surfdata%cvars(1) )// &
+            & '           = ', iobsmpp
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
          WRITE(numout,*)
 
@@ -434,5 +477,5 @@
       ! Deallocate temporary data
       !-----------------------------------------------------------------------
-      DEALLOCATE( ifileidx, isurfidx, zdat )
+      DEALLOCATE( ifileidx, isurfidx, zdat, clvars )
 
       !-----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 5682)
@@ -31,10 +31,10 @@
    PRIVATE
    
-   PUBLIC   obs_rea_mdt     ! called by ?
-   PUBLIC   obs_offset_mdt  ! called by ?
-
-   INTEGER , PUBLIC ::   nmsshc    = 1         ! MDT correction scheme
-   REAL(wp), PUBLIC ::   mdtcorr   = 1.61_wp   ! User specified MDT correction
-   REAL(wp), PUBLIC ::   mdtcutoff = 65.0_wp   ! MDT cutoff for computed correction
+   PUBLIC   obs_rea_mdt     ! called by dia_obs_init
+   PUBLIC   obs_offset_mdt  ! called by obs_rea_mdt
+
+   INTEGER , PUBLIC :: nn_msshc    = 1         ! MDT correction scheme
+   REAL(wp), PUBLIC :: rn_mdtcorr   = 1.61_wp  ! User specified MDT correction
+   REAL(wp), PUBLIC :: rn_mdtcutoff = 65.0_wp  ! MDT cutoff for computed correction
 
    !!----------------------------------------------------------------------
@@ -45,5 +45,5 @@
 CONTAINS
 
-   SUBROUTINE obs_rea_mdt( kslano, sladata, k2dint )
+   SUBROUTINE obs_rea_mdt( sladata, k2dint )
       !!---------------------------------------------------------------------
       !!
@@ -58,12 +58,10 @@
       USE iom
       !
-      INTEGER                          , INTENT(IN)    ::   kslano    ! Number of SLA Products
-      TYPE(obs_surf), DIMENSION(kslano), INTENT(inout) ::   sladata   ! SLA data
-      INTEGER                          , INTENT(in)    ::   k2dint    ! ?
+      TYPE(obs_surf), INTENT(inout) ::   sladata   ! SLA data
+      INTEGER       , INTENT(in)    ::   k2dint    ! ?
       !
       CHARACTER(LEN=12), PARAMETER ::   cpname  = 'obs_rea_mdt'
       CHARACTER(LEN=20), PARAMETER ::   mdtname = 'slaReferenceLevel.nc'
 
-      INTEGER ::   jslano              ! Data set loop variable
       INTEGER ::   jobs                ! Obs loop variable
       INTEGER ::   jpimdt, jpjmdt      ! Number of grid point in lat/lon for the MDT
@@ -88,4 +86,5 @@
       IF(lwp)WRITE(numout,*) ' obs_rea_mdt : Read MDT for referencing altimeter anomalies'
       IF(lwp)WRITE(numout,*) ' ------------- '
+      CALL FLUSH(numout)
 
       CALL iom_open( mdtname, nummdt )       ! Open the file
@@ -109,66 +108,65 @@
 
       ! Remove the offset between the MDT used with the sla and the model MDT
-      IF( nmsshc == 1 .OR. nmsshc == 2 )   CALL obs_offset_mdt( z_mdt, zfill )
+      IF( nn_msshc == 1 .OR. nn_msshc == 2 )   CALL obs_offset_mdt( z_mdt, zfill )
 
       ! Intepolate the MDT already on the model grid at the observation point
   
-      DO jslano = 1, kslano
-         ALLOCATE( &
-            & igrdi(2,2,sladata(jslano)%nsurf), &
-            & igrdj(2,2,sladata(jslano)%nsurf), &
-            & zglam(2,2,sladata(jslano)%nsurf), &
-            & zgphi(2,2,sladata(jslano)%nsurf), &
-            & zmask(2,2,sladata(jslano)%nsurf), &
-            & zmdtl(2,2,sladata(jslano)%nsurf)  &
-            & )
+      ALLOCATE( &
+         & igrdi(2,2,sladata%nsurf), &
+         & igrdj(2,2,sladata%nsurf), &
+         & zglam(2,2,sladata%nsurf), &
+         & zgphi(2,2,sladata%nsurf), &
+         & zmask(2,2,sladata%nsurf), &
+         & zmdtl(2,2,sladata%nsurf)  &
+         & )
          
-         DO jobs = 1, sladata(jslano)%nsurf
-
-            igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1
-            igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1
-            igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1
-            igrdj(1,2,jobs) = sladata(jslano)%mj(jobs)
-            igrdi(2,1,jobs) = sladata(jslano)%mi(jobs)
-            igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1
-            igrdi(2,2,jobs) = sladata(jslano)%mi(jobs)
-            igrdj(2,2,jobs) = sladata(jslano)%mj(jobs)
-
-         END DO
-
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, glamt  , zglam )
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, gphit  , zgphi )
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, mdtmask, zmask )
-         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, z_mdt  , zmdtl )
-
-         DO jobs = 1, sladata(jslano)%nsurf
+      DO jobs = 1, sladata%nsurf
+
+         igrdi(1,1,jobs) = sladata%mi(jobs)-1
+         igrdj(1,1,jobs) = sladata%mj(jobs)-1
+         igrdi(1,2,jobs) = sladata%mi(jobs)-1
+         igrdj(1,2,jobs) = sladata%mj(jobs)
+         igrdi(2,1,jobs) = sladata%mi(jobs)
+         igrdj(2,1,jobs) = sladata%mj(jobs)-1
+         igrdi(2,2,jobs) = sladata%mi(jobs)
+         igrdj(2,2,jobs) = sladata%mj(jobs)
+
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, glamt  , zglam )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, gphit  , zgphi )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, mdtmask, zmask )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, z_mdt  , zmdtl )
+
+      DO jobs = 1, sladata%nsurf
             
-            zlam = sladata(jslano)%rlam(jobs)
-            zphi = sladata(jslano)%rphi(jobs)
-
-            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
-               &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
-               &                   zmask(:,:,jobs), zweig, zobsmask )
+         zlam = sladata%rlam(jobs)
+         zphi = sladata%rphi(jobs)
+
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
+            &                   zmask(:,:,jobs), zweig, zobsmask )
             
-            CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs),  zext )
+         CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs),  zext )
  
-            sladata(jslano)%rext(jobs,2) = zext(1)
+         sladata%rext(jobs,2) = zext(1)
 
 ! mark any masked data with a QC flag
-            IF( zobsmask(1) == 0 )   sladata(jslano)%nqc(jobs) = 11
+         IF( zobsmask(1) == 0 )   sladata%nqc(jobs) = 11
 
          END DO
          
-         DEALLOCATE( &
-            & igrdi, &
-            & igrdj, &
-            & zglam, &
-            & zgphi, &
-            & zmask, &
-            & zmdtl  &
-            & )
-
-      END DO
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zmdtl  &
+         & )
 
       CALL wrk_dealloc(jpi,jpj,z_mdt,mdtmask) 
+      IF(lwp)WRITE(numout,*) ' ------------- '
+      CALL FLUSH(numout)
       !
    END SUBROUTINE obs_rea_mdt
@@ -205,6 +203,6 @@
         DO jj = 1, jpj
            zpromsk(ji,jj) = tmask_i(ji,jj)
-           IF (    ( gphit(ji,jj) .GT.  mdtcutoff ) &
-              &.OR.( gphit(ji,jj) .LT. -mdtcutoff ) &
+           IF (    ( gphit(ji,jj) .GT.  rn_mdtcutoff ) &
+              &.OR.( gphit(ji,jj) .LT. -rn_mdtcutoff ) &
               &.OR.( mdt(ji,jj) .EQ. zfill ) ) &
               &        zpromsk(ji,jj) = 0.0
@@ -212,5 +210,5 @@
       END DO 
 
-      ! Compute MSSH mean over [0,360] x [-mdtcutoff,mdtcutoff]
+      ! Compute MSSH mean over [0,360] x [-rn_mdtcutoff,rn_mdtcutoff]
 
       zarea = 0.0
@@ -240,22 +238,22 @@
       !  Correct spatial mean of the MSSH
 
-      IF( nmsshc == 1 )   mdt(:,:) = mdt(:,:) - zcorr  
+      IF( nn_msshc == 1 )   mdt(:,:) = mdt(:,:) - zcorr  
 
       ! User defined value : 1.6 m for the Rio MDT compared to ORCA2 MDT
 
-      IF( nmsshc == 2 )   mdt(:,:) = mdt(:,:) - mdtcorr
+      IF( nn_msshc == 2 )   mdt(:,:) = mdt(:,:) - rn_mdtcorr
 
       IF(lwp) THEN
          WRITE(numout,*)
-         WRITE(numout,*) ' obs_readmdt : mdtcutoff     = ', mdtcutoff
+         WRITE(numout,*) ' obs_readmdt : rn_mdtcutoff     = ', rn_mdtcutoff
          WRITE(numout,*) ' -----------   zcorr_mdt     = ', zcorr_mdt
          WRITE(numout,*) '               zcorr_bcketa  = ', zcorr_bcketa
          WRITE(numout,*) '               zcorr         = ', zcorr
-         WRITE(numout,*) '               nmsshc        = ', nmsshc
+         WRITE(numout,*) '               nn_msshc        = ', nn_msshc
       ENDIF
 
-      IF ( nmsshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied'
-      IF ( nmsshc == 1 ) WRITE(numout,*) '           MSSH correction is applied'
-      IF ( nmsshc == 2 ) WRITE(numout,*) '           User defined MSSH correction' 
+      IF ( nn_msshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied'
+      IF ( nn_msshc == 1 ) WRITE(numout,*) '           MSSH correction is applied'
+      IF ( nn_msshc == 2 ) WRITE(numout,*) '           User defined MSSH correction' 
 
       CALL wrk_dealloc( jpi,jpj, zpromsk )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90	(revision 5682)
@@ -67,4 +67,7 @@
          & ntyp           !: Type of surface observation product
 
+      CHARACTER(len=6), POINTER, DIMENSION(:) :: &
+         & cvars          !: Variable names
+
       CHARACTER(LEN=8), POINTER, DIMENSION(:) :: &
          & cwmo           !: WMO indentifier
@@ -130,4 +133,5 @@
       !!* Local variables
       INTEGER :: ji
+      INTEGER :: jvar
 
       ! Set bookkeeping variables
@@ -140,4 +144,14 @@
       surf%npi      = kpi
       surf%npj      = kpj
+
+      ! Allocate arrays of size number of variables
+
+      ALLOCATE( &
+         & surf%cvars(kvar)    &
+         & )
+
+      DO jvar = 1, kvar
+         surf%cvars(jvar) = "NotSet"
+      END DO
       
       ! Allocate arrays of number of surface data size
@@ -271,4 +285,10 @@
          & )
 
+      ! Dellocate arrays of size number of variables
+
+      DEALLOCATE( &
+         & surf%cvars     &
+         & )
+
    END SUBROUTINE obs_surf_dealloc
 
@@ -392,5 +412,6 @@
       ! Set book keeping variables which do not depend on number of obs.
 
-      newsurf%nstp  = surf%nstp
+      newsurf%nstp     = surf%nstp
+      newsurf%cvars(:) = surf%cvars(:)
  
       ! Deallocate temporary data
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90	(revision 5682)
@@ -117,5 +117,5 @@
 
          cwmonam1770(ji) = 'Not defined'
-         ctypshort(ji) = 'XBT'
+         ctypshort(ji) = '---'
 
 !         IF ( ji < 1000 ) THEN
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 5682)
@@ -55,5 +55,5 @@
 CONTAINS
 
-   SUBROUTINE obs_wri_prof( cobstype, profdata, padd, pext )
+   SUBROUTINE obs_wri_prof( profdata, k2dint, padd, pext )
       !!-----------------------------------------------------------------------
       !!
@@ -76,15 +76,14 @@
       !!-----------------------------------------------------------------------
 
-      !! * Modules used
-
       !! * Arguments
-      CHARACTER(LEN=*), INTENT(IN) :: cobstype        ! Prefix for output files
       TYPE(obs_prof), INTENT(INOUT) :: profdata      ! Full set of profile data
+      INTEGER, INTENT(IN)        :: k2dint           ! Horizontal interpolation method
       TYPE(obswriinfo), OPTIONAL :: padd             ! Additional info for each variable
       TYPE(obswriinfo), OPTIONAL :: pext             ! Extra info
-      
+
       !! * Local declarations
       TYPE(obfbdata) :: fbdata
-      CHARACTER(LEN=40) :: cfname
+      CHARACTER(LEN=40) :: clfname
+      CHARACTER(LEN=6) :: clfiletype
       INTEGER :: ilevel
       INTEGER :: jvar
@@ -94,20 +93,23 @@
       INTEGER :: ja
       INTEGER :: je
+      INTEGER :: iadd
+      INTEGER :: iext
       REAL(wp) :: zpres
-      INTEGER :: nadd
-      INTEGER :: next
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zu, &
+         & zv
 
       IF ( PRESENT( padd ) ) THEN
-         nadd = padd%inum
+         iadd = padd%inum
       ELSE
-         nadd = 0
+         iadd = 0
       ENDIF
 
       IF ( PRESENT( pext ) ) THEN
-         next = pext%inum
+         iext = pext%inum
       ELSE
-         next = 0
-      ENDIF
-      
+         iext = 0
+      ENDIF
+
       CALL init_obfbdata( fbdata )
 
@@ -118,11 +120,12 @@
       END DO
 
-      SELECT CASE ( TRIM(cobstype) )
-      CASE('prof')
-
+      SELECT CASE ( TRIM(profdata%cvars(1)) )
+      CASE('POTM')
+
+         clfiletype='profb'
          CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, &
-            &                 1 + nadd, 1 + next, .TRUE. )
-         fbdata%cname(1)      = 'POTM'
-         fbdata%cname(2)      = 'PSAL'
+            &                 1 + iadd, 1 + iext, .TRUE. )
+         fbdata%cname(1)      = profdata%cvars(1)
+         fbdata%cname(2)      = profdata%cvars(2)
          fbdata%coblong(1)    = 'Potential temperature'
          fbdata%coblong(2)    = 'Practical salinity'
@@ -137,10 +140,10 @@
          fbdata%caddunit(1,2) = 'PSU'
          fbdata%cgrid(:)      = 'T'
-         DO je = 1, next
+         DO je = 1, iext
             fbdata%cextname(1+je) = pext%cdname(je)
             fbdata%cextlong(1+je) = pext%cdlong(je,1)
             fbdata%cextunit(1+je) = pext%cdunit(je,1)
          END DO
-         DO ja = 1, nadd
+         DO ja = 1, iadd
             fbdata%caddname(1+ja) = padd%cdname(ja)
             DO jvar = 1, 2
@@ -149,15 +152,16 @@
             END DO
          END DO
-      
-      CASE('vel')
-      
+
+      CASE('UVEL')
+
+         clfiletype='velfb'
          CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 2, 0, .TRUE. )
-         fbdata%cname(1)      = 'UVEL'
-         fbdata%cname(2)      = 'VVEL'
+         fbdata%cname(1)      = profdata%cvars(1)
+         fbdata%cname(2)      = profdata%cvars(2)
          fbdata%coblong(1)    = 'Zonal velocity'
          fbdata%coblong(2)    = 'Meridional velocity'
          fbdata%cobunit(1)    = 'm/s'
          fbdata%cobunit(2)    = 'm/s'
-         DO je = 1, next
+         DO je = 1, iext
             fbdata%cextname(je) = pext%cdname(je)
             fbdata%cextlong(je) = pext%cdlong(je,1)
@@ -175,5 +179,5 @@
          fbdata%cgrid(1)      = 'U' 
          fbdata%cgrid(2)      = 'V'
-         DO ja = 1, nadd
+         DO ja = 1, iadd
             fbdata%caddname(2+ja) = padd%cdname(ja)
             fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1)
@@ -187,8 +191,8 @@
 
       END SELECT
-         
+
       fbdata%caddname(1)   = 'Hx'
-         
-      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cobstype), nproc
+
+      WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc
 
       IF(lwp) THEN
@@ -196,5 +200,5 @@
          WRITE(numout,*)'obs_wri_prof :'
          WRITE(numout,*)'~~~~~~~~~~~~~'
-         WRITE(numout,*)'Writing profile feedback file : ',TRIM(cfname)
+         WRITE(numout,*)'Writing '//TRIM(clfiletype)//' feedback file : ',TRIM(clfname)
       ENDIF
 
@@ -242,7 +246,7 @@
             DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar)
                ik = profdata%var(jvar)%nvlidx(jk)
-               IF ( TRIM(cobstype) == 'prof' ) THEN
+               IF ( TRIM(profdata%cvars(1)) == 'POTM' ) THEN
                   fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk)
-               ELSE IF ( TRIM(cobstype) == 'vel' ) THEN
+               ELSE IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN
                   IF ( jvar == 1 ) THEN
                      fbdata%padd(ik,jo,1,jvar) = zu(jk)
@@ -265,9 +269,9 @@
                ENDIF
                fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk)
-               DO ja = 1, nadd
+               DO ja = 1, iadd
                   fbdata%padd(ik,jo,1+ja,jvar) = &
                      & profdata%var(jvar)%vext(jk,padd%ipoint(ja))
                END DO
-               DO je = 1, next
+               DO je = 1, iext
                   fbdata%pext(ik,jo,1+je) = &
                      & profdata%var(jvar)%vext(jk,pext%ipoint(je))
@@ -280,5 +284,5 @@
       END DO
 
-      IF ( TRIM(cobstype) == 'prof' ) THEN
+      IF ( TRIM(profdata%cvars(1)) == 'POTM' ) THEN
          ! Convert insitu temperature to potential temperature using the model
          ! salinity if no potential temperature
@@ -301,7 +305,7 @@
          END DO
       ENDIF
-      
+
       ! Write the obfbdata structure
-      CALL write_obfbdata( cfname, fbdata )
+      CALL write_obfbdata( clfname, fbdata )
 
       ! Output some basic statistics
@@ -309,8 +313,8 @@
 
       CALL dealloc_obfbdata( fbdata )
-     
+
    END SUBROUTINE obs_wri_prof
 
-   SUBROUTINE obs_wri_surf( cobstype, surfdata, padd, pext )
+   SUBROUTINE obs_wri_surf( surfdata, padd, pext )
       !!-----------------------------------------------------------------------
       !!
@@ -332,5 +336,4 @@
 
       !! * Arguments
-      CHARACTER(LEN=*), INTENT(IN) :: cobstype          ! Prefix for output files
       TYPE(obs_surf), INTENT(INOUT) :: surfdata         ! Full set of surface data
       TYPE(obswriinfo), OPTIONAL :: padd               ! Additional info for each variable
@@ -339,22 +342,23 @@
       !! * Local declarations
       TYPE(obfbdata) :: fbdata
-      CHARACTER(LEN=40) :: cfname         ! netCDF filename
+      CHARACTER(LEN=40) :: clfname         ! netCDF filename
+      CHARACTER(LEN=6)  :: clfiletype
       CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf'
       INTEGER :: jo
       INTEGER :: ja
       INTEGER :: je
-      INTEGER :: nadd
-      INTEGER :: next
+      INTEGER :: iadd
+      INTEGER :: iext
 
       IF ( PRESENT( padd ) ) THEN
-         nadd = padd%inum
+         iadd = padd%inum
       ELSE
-         nadd = 0
+         iadd = 0
       ENDIF
 
       IF ( PRESENT( pext ) ) THEN
-         next = pext%inum
+         iext = pext%inum
       ELSE
-         next = 0
+         iext = 0
       ENDIF
 
@@ -362,10 +366,11 @@
 
       CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, &
-         &                 2 + nadd, 1 + next, .TRUE. )
-
-      SELECT CASE ( TRIM(cobstype) )
-      CASE('sla')
-
-         fbdata%cname(1)      = 'SLA'
+         &                 2 + iadd, 1 + iext, .TRUE. )
+
+      SELECT CASE ( TRIM(surfdata%cvars(1)) )
+      CASE('SLA')
+
+         clfiletype = 'slafb'
+         fbdata%cname(1)      = surfdata%cvars(1)
          fbdata%coblong(1)    = 'Sea level anomaly'
          fbdata%cobunit(1)    = 'Metres'
@@ -373,5 +378,5 @@
          fbdata%cextlong(1)   = 'Mean dynamic topography'
          fbdata%cextunit(1)   = 'Metres'
-         DO je = 1, next
+         DO je = 1, iext
             fbdata%cextname(je) = pext%cdname(je)
             fbdata%cextlong(je) = pext%cdlong(je,1)
@@ -384,5 +389,5 @@
          fbdata%caddunit(2,1) = 'Metres'
          fbdata%cgrid(1)      = 'T'
-         DO ja = 1, nadd
+         DO ja = 1, iadd
             fbdata%caddname(2+ja) = padd%cdname(ja)
             fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1)
@@ -390,10 +395,11 @@
          END DO
 
-      CASE('sst')
-
-         fbdata%cname(1)      = 'SST'
+      CASE('SST')
+
+         clfiletype = 'sstfb'
+         fbdata%cname(1)      = surfdata%cvars(1)
          fbdata%coblong(1)    = 'Sea surface temperature'
          fbdata%cobunit(1)    = 'Degree centigrade'
-         DO je = 1, next
+         DO je = 1, iext
             fbdata%cextname(je) = pext%cdname(je)
             fbdata%cextlong(je) = pext%cdlong(je,1)
@@ -403,5 +409,5 @@
          fbdata%caddunit(1,1) = 'Degree centigrade'
          fbdata%cgrid(1)      = 'T'
-         DO ja = 1, nadd
+         DO ja = 1, iadd
             fbdata%caddname(1+ja) = padd%cdname(ja)
             fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
@@ -409,18 +415,19 @@
          END DO
 
-      CASE('sss')
-
-         fbdata%cname(1)      = 'SSS'
-         fbdata%coblong(1)    = 'Sea surface salinity'
-         fbdata%cobunit(1)    = 'PSU'
-         DO je = 1, next
+      CASE('SEAICE')
+
+         clfiletype = 'sicfb'
+         fbdata%cname(1)      = surfdata%cvars(1)
+         fbdata%coblong(1)    = 'Sea ice'
+         fbdata%cobunit(1)    = 'Fraction'
+         DO je = 1, iext
             fbdata%cextname(je) = pext%cdname(je)
             fbdata%cextlong(je) = pext%cdlong(je,1)
             fbdata%cextunit(je) = pext%cdunit(je,1)
          END DO
-         fbdata%caddlong(1,1) = 'Model interpolated SSS'
-         fbdata%caddunit(1,1) = 'PSU'
+         fbdata%caddlong(1,1) = 'Model interpolated ICE'
+         fbdata%caddunit(1,1) = 'Fraction'
          fbdata%cgrid(1)      = 'T'
-         DO ja = 1, nadd
+         DO ja = 1, iadd
             fbdata%caddname(1+ja) = padd%cdname(ja)
             fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
@@ -428,28 +435,9 @@
          END DO
 
-      CASE('seaice')
-
-         fbdata%cname(1)      = 'SEAICE'
-         fbdata%coblong(1)    = 'Sea ice'
-         fbdata%cobunit(1)    = 'Fraction'
-         DO je = 1, next
-            fbdata%cextname(je) = pext%cdname(je)
-            fbdata%cextlong(je) = pext%cdlong(je,1)
-            fbdata%cextunit(je) = pext%cdunit(je,1)
-         END DO
-         fbdata%caddlong(1,1) = 'Model interpolated ICE'
-         fbdata%caddunit(1,1) = 'Fraction'
-         fbdata%cgrid(1)      = 'T'
-         DO ja = 1, nadd
-            fbdata%caddname(1+ja) = padd%cdname(ja)
-            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
-            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
-         END DO
-
       END SELECT
 
       fbdata%caddname(1)   = 'Hx'
 
-      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cobstype), nproc
+      WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc
 
       IF(lwp) THEN
@@ -457,5 +445,5 @@
          WRITE(numout,*)'obs_wri_surf :'
          WRITE(numout,*)'~~~~~~~~~~~~~'
-         WRITE(numout,*)'Writing surface feedback file : ',TRIM(cfname)
+         WRITE(numout,*)'Writing '//TRIM(surfdata%cvars(1))//' feedback file : ',TRIM(clfname)
       ENDIF
 
@@ -498,5 +486,5 @@
             &           krefdate = 19500101 )
          fbdata%padd(1,jo,1,1) = surfdata%rmod(jo,1)
-         IF ( TRIM(cobstype) == 'sla' ) fbdata%padd(1,jo,2,1) = surfdata%rext(jo,1)
+         IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%padd(1,jo,2,1) = surfdata%rext(jo,1)
          fbdata%pob(1,jo,1)    = surfdata%robs(jo,1) 
          fbdata%pdep(1,jo)     = 0.0
@@ -514,10 +502,10 @@
          ENDIF
          fbdata%iobsk(1,jo,1)  = 0
-         IF ( TRIM(cobstype) == 'sla' ) fbdata%pext(1,jo,1) = surfdata%rext(jo,2)
-         DO ja = 1, nadd
+         IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%pext(1,jo,1) = surfdata%rext(jo,2)
+         DO ja = 1, iadd
             fbdata%padd(1,jo,2+ja,1) = &
                & surfdata%rext(jo,padd%ipoint(ja))
          END DO
-         DO je = 1, next
+         DO je = 1, iext
             fbdata%pext(1,jo,1+je) = &
                & surfdata%rext(jo,pext%ipoint(je))
@@ -526,5 +514,5 @@
 
       ! Write the obfbdata structure
-      CALL write_obfbdata( cfname, fbdata )
+      CALL write_obfbdata( clfname, fbdata )
 
       ! Output some basic statistics
@@ -556,7 +544,6 @@
       INTEGER :: jo
       INTEGER :: jk
-
-      INTEGER :: numgoodobs
-      INTEGER :: numgoodobsmpp
+      INTEGER :: inumgoodobs
+      INTEGER :: inumgoodobsmpp
       REAL(wp) :: zsumx
       REAL(wp) :: zsumx2
@@ -566,5 +553,5 @@
          WRITE(numout,*) ''
          WRITE(numout,*) 'obs_wri_stats :'
-         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
       ENDIF
 
@@ -572,5 +559,5 @@
          zsumx=0.0_wp
          zsumx2=0.0_wp
-         numgoodobs=0
+         inumgoodobs=0
          DO jo = 1, fbdata%nobs
             DO jk = 1, fbdata%nlev
@@ -578,24 +565,24 @@
                   & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. &
                   & ( fbdata%padd(jk,jo,1,jvar) < 9999.0 ) ) THEN
-	    
-	          zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar)
+
+                  zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar)
                   zsumx=zsumx+zomb
                   zsumx2=zsumx2+zomb**2
-                  numgoodobs=numgoodobs+1
-	       ENDIF
+                  inumgoodobs=inumgoodobs+1
+               ENDIF
             ENDDO
          ENDDO
 
-         CALL obs_mpp_sum_integer( numgoodobs, numgoodobsmpp )
+         CALL obs_mpp_sum_integer( inumgoodobs, inumgoodobsmpp )
          CALL mpp_sum(zsumx)
          CALL mpp_sum(zsumx2)
 
          IF (lwp) THEN
-	    WRITE(numout,*) 'Type: ',fbdata%cname(jvar),'  Total number of good observations: ',numgoodobsmpp 
-	    WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/numgoodobsmpp
-            WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/numgoodobsmpp )
-	    WRITE(numout,*) ''
+            WRITE(numout,*) 'Type: ',fbdata%cname(jvar),'  Total number of good observations: ',inumgoodobsmpp 
+            WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/inumgoodobsmpp
+            WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/inumgoodobsmpp )
+            WRITE(numout,*) ''
          ENDIF
- 
+
       ENDDO
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 5682)
@@ -15,5 +15,6 @@
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3
+   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3-MCT
+   !!   'key_oa3mct_v3'                 to be added for OASIS3-MCT version 3
    !!----------------------------------------------------------------------
    !!   cpl_init     : initialization of coupled mode communication
@@ -61,5 +62,8 @@
 #endif
 
-   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=40        ! Maximum number of coupling fields
+   INTEGER                    ::   nrcv         ! total number of fields received 
+   INTEGER                    ::   nsnd         ! total number of fields sent 
+   INTEGER                    ::   ncplmodel    ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
+   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=50   ! Maximum number of coupling fields
    INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields
    INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields
@@ -86,5 +90,5 @@
 CONTAINS
 
-   SUBROUTINE cpl_init( kl_comm )
+   SUBROUTINE cpl_init( cd_modname, kl_comm )
       !!-------------------------------------------------------------------
       !!             ***  ROUTINE cpl_init  ***
@@ -95,5 +99,6 @@
       !! ** Method  :   OASIS3 MPI communication 
       !!--------------------------------------------------------------------
-      INTEGER, INTENT(out) ::   kl_comm   ! local communicator of the model
+      CHARACTER(len = *), INTENT(in) ::   cd_modname   ! model name as set in namcouple file
+      INTEGER          , INTENT(out) ::   kl_comm      ! local communicator of the model
       !!--------------------------------------------------------------------
 
@@ -104,5 +109,5 @@
       ! 1st Initialize the OASIS system for the application
       !------------------------------------------------------------------
-      CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror )
+      CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror )
       IF ( nerror /= OASIS_Ok ) &
          CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
@@ -144,7 +149,19 @@
       IF(lwp) WRITE(numout,*)
 
+      ncplmodel = kcplmodel
       IF( kcplmodel > nmaxcpl ) THEN
-         CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN
       ENDIF
+
+      nrcv = krcv
+      IF( nrcv > nmaxfld ) THEN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld')   ;   RETURN
+      ENDIF
+
+      nsnd = ksnd
+      IF( nsnd > nmaxfld ) THEN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld')   ;   RETURN
+      ENDIF
+
       !
       ! ... Define the shape for the area that excludes the halo
@@ -400,5 +417,5 @@
 
 
-   INTEGER FUNCTION cpl_freq( kid )  
+   INTEGER FUNCTION cpl_freq( cdfieldname )  
       !!---------------------------------------------------------------------
       !!              ***  ROUTINE cpl_freq  ***
@@ -406,11 +423,48 @@
       !! ** Purpose : - send back the coupling frequency for a particular field
       !!----------------------------------------------------------------------
-      INTEGER,INTENT(in) ::   kid   ! variable index
-      !!
+      CHARACTER(len = *), INTENT(in) ::   cdfieldname    ! field name as set in namcouple file
+      !!
+      INTEGER               :: id
       INTEGER               :: info
       INTEGER, DIMENSION(1) :: itmp
+      INTEGER               :: ji,jm     ! local loop index
+      INTEGER               :: mop
       !!----------------------------------------------------------------------
-      CALL oasis_get_freqs(kid, 1, itmp, info)
-      cpl_freq = itmp(1)
+      cpl_freq = 0   ! defaut definition
+      id = -1        ! defaut definition
+      !
+      DO ji = 1, nsnd
+         IF (ssnd(ji)%laction ) THEN
+            DO jm = 1, ncplmodel
+               IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
+                  IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN
+                     id = ssnd(ji)%nid(1,jm)
+                     mop = OASIS_Out
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDDO
+      DO ji = 1, nrcv
+         IF (srcv(ji)%laction ) THEN
+            DO jm = 1, ncplmodel
+               IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
+                  IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN
+                     id = srcv(ji)%nid(1,jm)
+                     mop = OASIS_In
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDDO
+      !
+      IF( id /= -1 ) THEN
+#if defined key_oa3mct_v3
+         CALL oasis_get_freqs(id, mop, 1, itmp, info)
+#else
+         CALL oasis_get_freqs(id,      1, itmp, info)
+#endif
+         cpl_freq = itmp(1)
+      ENDIF
       !
    END FUNCTION cpl_freq
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90	(revision 5682)
@@ -41,5 +41,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
-   !! $Id: module_example 1146 2008-06-25 11:42:56Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 5682)
@@ -69,6 +69,7 @@
    END TYPE FLD
 
-   TYPE, PUBLIC ::   MAP_POINTER      !: Array of integer pointers to 1D arrays
-      INTEGER, POINTER   ::  ptr(:)
+   TYPE, PUBLIC ::   MAP_POINTER      !: Map from input data file to local domain
+      INTEGER, POINTER, DIMENSION(:)  ::  ptr           ! Array of integer pointers to 1D arrays
+      LOGICAL                         ::  ll_unstruc    ! Unstructured (T) or structured (F) boundary data file
    END TYPE MAP_POINTER
 
@@ -153,5 +154,7 @@
       IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1
 
-      it_offset = 0
+      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
+      ELSE                                      ;   it_offset = 0
+      ENDIF
       IF( PRESENT(kt_offset) )   it_offset = kt_offset
 
@@ -451,5 +454,7 @@
       ENDIF
       !
-      it_offset = 0
+      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
+      ELSE                                      ;   it_offset = 0
+      ENDIF
       IF( PRESENT(kt_offset) )   it_offset = kt_offset
       IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) )
@@ -601,6 +606,6 @@
       !
       IF( ASSOCIATED(map%ptr) ) THEN
-         IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map%ptr )
-         ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map%ptr )
+         IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map )
+         ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map )
          ENDIF
       ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
@@ -672,5 +677,5 @@
       REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta   ! output field on model grid (2 dimensional)
       INTEGER                   , INTENT(in ) ::   nrec    ! record number to read (ie time slice)
-      INTEGER,  DIMENSION(:)    , INTENT(in ) ::   map     ! global-to-local mapping indices
+      TYPE(MAP_POINTER)         , INTENT(in ) ::   map     ! global-to-local mapping indices
       !!
       INTEGER                                 ::   ipi      ! length of boundary data on local process
@@ -693,7 +698,7 @@
 #if defined key_bdy
       ipj = iom_file(num)%dimsz(2,idvar)
-      IF (ipj == 1) THEN ! we assume that this is a structured open boundary file
+      IF ( map%ll_unstruc) THEN ! unstructured open boundary data file
          dta_read => dta_global
-      ELSE
+      ELSE                      ! structured open boundary data file
          dta_read => dta_global2
       ENDIF
@@ -708,14 +713,14 @@
       END SELECT
       !
-      IF (ipj==1) THEN
+      IF ( map%ll_unstruc ) THEN ! unstructured open boundary data file
          DO ib = 1, ipi
             DO ik = 1, ipk
-               dta(ib,1,ik) =  dta_read(map(ib),1,ik)
+               dta(ib,1,ik) =  dta_read(map%ptr(ib),1,ik)
             END DO
          END DO
-      ELSE ! we assume that this is a structured open boundary file
+      ELSE                       ! structured open boundary data file
          DO ib = 1, ipi
-            jj=1+floor(REAL(map(ib)-1)/REAL(ilendta))
-            ji=map(ib)-(jj-1)*ilendta
+            jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta))
+            ji=map%ptr(ib)-(jj-1)*ilendta
             DO ik = 1, ipk
                dta(ib,1,ik) =  dta_read(ji,jj,ik)
@@ -1020,5 +1025,5 @@
       INTEGER                           ::   ipk           ! temporary vertical dimension
       CHARACTER (len=5)                 ::   aname
-      INTEGER , DIMENSION(3)            ::   ddims
+      INTEGER , DIMENSION(:), ALLOCATABLE ::   ddims
       INTEGER , POINTER, DIMENSION(:,:) ::   data_src
       REAL(wp), POINTER, DIMENSION(:,:) ::   data_tmp
@@ -1043,4 +1048,9 @@
 
       !! get dimensions
+      IF ( SIZE(sd%fnow, 3) > 1 ) THEN
+         ALLOCATE( ddims(4) )
+      ELSE
+         ALLOCATE( ddims(3) )
+      ENDIF
       id = iom_varid( inum, sd%clvar, ddims )
 
@@ -1139,4 +1149,6 @@
          CALL ctl_stop( '    fld_weight : unable to read the file ' )
       ENDIF
+
+      DEALLOCATE (ddims )
 
       CALL wrk_dealloc( jpi,jpj, data_src )   ! integer
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 5682)
@@ -16,5 +16,5 @@
    USE sbc_oce          ! surface boundary condition: ocean
 # if defined key_lim3
-   USE par_ice          ! LIM-3 parameters
+   USE ice              ! LIM-3 parameters
 # endif
 # if defined key_lim2
@@ -58,5 +58,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice        !: non solar heat flux over ice                  [W/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice        !: solar heat flux over ice                      [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_mean   !: daily mean solar heat flux over ice           [W/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice        !: latent flux over ice                          [W/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice       !: latent sensibility over ice                 [W/m2/K]
@@ -69,8 +68,22 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0         !: Solar surface transmission parameter, thick ice  [-]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0         !: Solar surface transmission parameter, thin ice   [-]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice            [kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice          [kg/m2/s]
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt
+
+#if defined  key_lim3
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   evap_ice       !: sublimation                              [kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   devap_ice      !: sublimation sensitivity                [kg/m2/s/K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qns_oce        !: non solar heat flux over ocean              [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qsr_oce        !: non solar heat flux over ocean              [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_oce       !: heat flux of precip and evap over ocean     [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_ice       !: heat flux of precip and evap over ice       [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qprec_ice      !: heat flux of precip over ice                [J/m3]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s]
+#endif
+#if defined key_lim3 || defined key_lim2
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndm_ice       !: wind speed module at T-point                 [m/s]
+#endif
 
 #if defined key_cice
@@ -100,6 +113,5 @@
 #endif
 
-#if defined key_lim3 || defined key_cice
-   ! not used with LIM2
+#if defined key_cice
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K]
 #endif
@@ -125,13 +137,14 @@
       ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     &
          &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     &
-         &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) ,     &
-         &      alb_ice (jpi,jpj,jpl) ,                             &
-         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     ,     &
+         &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) ,   &
+         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     , wndm_ice(jpi,jpj)     ,   &
          &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     &
-#if defined key_lim3
-         &      tatm_ice(jpi,jpj)     ,                             &
-#endif
 #if defined key_lim2
          &      a_i(jpi,jpj,jpl)      ,                             &
+#endif
+#if defined key_lim3
+         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,  &
+         &      qemp_ice(jpi,jpj)     , qemp_oce(jpi,jpj)      ,                       &
+         &      qns_oce (jpi,jpj)     , qsr_oce (jpi,jpj)      , emp_oce (jpi,jpj)  ,  &
 #endif
          &      emp_ice(jpi,jpj)      ,  STAT= ierr(1) )
@@ -145,5 +158,5 @@
                 a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , &
                 STAT= ierr(1) )
-      IF( lk_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , &
+      IF( ln_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , &
          &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , &
          &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , &
@@ -152,10 +165,6 @@
 #endif
          !
-#if defined key_lim2
-      IF( ltrcdm2dc_ice )   ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) )
-#endif
-         !
 #if defined key_cice || defined key_lim2
-      IF( lk_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) )
+      IF( ln_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) )
 #endif
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 5682)
@@ -36,8 +36,10 @@
    LOGICAL , PUBLIC ::   ln_blk_mfs     !: MFS  bulk formulation
 #if defined key_oasis3
-   LOGICAL , PUBLIC ::   lk_cpl = .TRUE.  !: coupled formulation
+   LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used
 #else
-   LOGICAL , PUBLIC ::   lk_cpl = .FALSE. !: coupled formulation
-#endif
+   LOGICAL , PUBLIC ::   lk_oasis = .FALSE. !: OASIS unused
+#endif
+   LOGICAL , PUBLIC ::   ln_cpl         !: ocean-atmosphere coupled formulation
+   LOGICAL , PUBLIC ::   ln_mixcpl      !: ocean-atmosphere forced-coupled mixed formulation
    LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr)
    LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths
@@ -50,5 +52,6 @@
    !                                             !: =1 levitating ice with mass and salt exchange but no presure effect
    !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure)
-   INTEGER , PUBLIC :: nn_limflx        !: LIM3 Multi-category heat flux formulation
+   INTEGER , PUBLIC ::   nn_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below) 
+   INTEGER , PUBLIC ::   nn_limflx      !: LIM3 Multi-category heat flux formulation
    !                                             !: =-1  Use of per-category fluxes
    !                                             !: = 0  Average per-category fluxes
@@ -69,18 +72,29 @@
    !!           switch definition (improve readability)
    !!----------------------------------------------------------------------
-   INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical formulation
-   INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical      formulation
-   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux            formulation
-   INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk       formulation
-   INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk       formulation
-   INTEGER , PUBLIC, PARAMETER ::   jp_cpl     = 5        !: Coupled         formulation
-   INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk       formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical               formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical                    formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk                     formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk                     formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk                     formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 7        !: for OPA when doing coupling via SAS module
    INTEGER , PUBLIC, PARAMETER ::   jp_esopa   = -1       !: esopa test, ALL formulations
    
    !!----------------------------------------------------------------------
+   !!           component definition
+   !!----------------------------------------------------------------------
+   INTEGER , PUBLIC, PARAMETER ::   jp_iam_nemo = 0      !: Initial single executable configuration 
+                                                         !  (no internal OASIS coupling)
+   INTEGER , PUBLIC, PARAMETER ::   jp_iam_opa  = 1      !: Multi executable configuration - OPA component
+                                                         !  (internal OASIS coupling)
+   INTEGER , PUBLIC, PARAMETER ::   jp_iam_sas  = 2      !: Multi executable configuration - SAS component
+                                                         !  (internal OASIS coupling)
+   !!----------------------------------------------------------------------
    !!              Ocean Surface Boundary Condition fields
    !!----------------------------------------------------------------------
+   INTEGER , PUBLIC ::  ncpl_qsr_freq            !: qsr coupling frequency per days from atmosphere
+   !
    LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress)
-   LOGICAL , PUBLIC ::   ltrcdm2dc               !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux
    !!                                   !!   now    ! before   !!
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2]
@@ -90,5 +104,4 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_mean          !: daily mean sea heat flux: solar              [W/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2]
@@ -98,5 +111,6 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmflx            !: freshwater budget: freezing/melting          [Kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff   [Kg/m2/s]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff        [Kg/m2/s]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwfisf , fwfisf_b !: ice shelf melting   [Kg/m2/s]  
    !!
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts
@@ -110,4 +124,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm]
 #endif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl)
 
    !!----------------------------------------------------------------------
@@ -121,4 +136,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_m     !: mean (nn_fsbc time-step) sea surface layer thickness       [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-]
 
    !! * Substitutions
@@ -147,6 +163,6 @@
          &      sfx    (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) )
          !
-      ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     &
-         &      rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) )
+      ALLOCATE( fwfisf  (jpi,jpj), rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     &
+         &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) )
          !
       ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     &
@@ -154,12 +170,10 @@
          &      atm_co2(jpi,jpj) ,                                        &
 #endif
-         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) ,                       &
-         &      ssv_m  (jpi,jpj) , sss_m  (jpi,jpj), ssh_m(jpi,jpj) , STAT=ierr(4) )
+         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      &
+         &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) )
          !
 #if defined key_vvl
       ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) )
 #endif
-         !
-      IF( ltrcdm2dc ) ALLOCATE( qsr_mean(jpi,jpj) , STAT=ierr(5) )
          !
       sbc_oce_alloc = MAXVAL( ierr )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 5682)
@@ -43,5 +43,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
-   !! $Id: $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 5682)
@@ -34,9 +34,12 @@
    USE albedo
    USE prtctl          ! Print control
-#if defined key_lim3
+#if defined key_lim3 
    USE ice
    USE sbc_ice         ! Surface boundary condition: ice fields
+   USE limthd_dh       ! for CALL lim_thd_snwblow
 #elif defined key_lim2
    USE ice_2
+   USE sbc_ice         ! Surface boundary condition: ice fields
+   USE par_ice_2       ! Surface boundary condition: ice fields
 #endif
 
@@ -45,5 +48,8 @@
 
    PUBLIC sbc_blk_clio        ! routine called by sbcmod.F90 
-   PUBLIC blk_ice_clio        ! routine called by sbcice_lim.F90 
+#if defined key_lim2 || defined key_lim3
+   PUBLIC blk_ice_clio_tau    ! routine called by sbcice_lim.F90 
+   PUBLIC blk_ice_clio_flx    ! routine called by sbcice_lim.F90 
+#endif
 
    INTEGER , PARAMETER ::   jpfld   = 7           ! maximum number of files to read 
@@ -62,9 +68,6 @@
    LOGICAL ::   lbulk_init = .TRUE.               ! flag, bulk initialization done or not)
 
-#if ! defined key_lim3                          
-   ! in namicerun with LIM3
    REAL(wp) ::   cai = 1.40e-3 ! best estimate of atm drag in order to get correct FS export in ORCA2-LIM
    REAL(wp) ::   cao = 1.00e-3 ! chosen by default  ==> should depends on many things...  !!gmto be updated
-#endif
 
    REAL(wp) ::   rdtbs2      !:   
@@ -381,10 +384,19 @@
          &     + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec   ! add    precip. heat content at Tair in Celcius
       qns(:,:) = qns(:,:) * tmask(:,:,1)
+#if defined key_lim3
+      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)
+      qsr_oce(:,:) = qsr(:,:)
+#endif
       ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio)
 
-      CALL iom_put( "qlw_oce",   zqlw )   ! output downward longwave  heat over the ocean
-      CALL iom_put( "qsb_oce", - zqsb )   ! output downward sensible  heat over the ocean
-      CALL iom_put( "qla_oce", - zqla )   ! output downward latent    heat over the ocean
-      CALL iom_put( "qns_oce",   qns  )   ! output downward non solar heat over the ocean
+      IF ( nn_ice == 0 ) THEN
+         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave  heat over the ocean
+         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible  heat over the ocean
+         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent    heat over the ocean
+         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean
+         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean
+         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean
+         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean
+      ENDIF
 
       IF(ln_ctl) THEN
@@ -402,12 +414,55 @@
    END SUBROUTINE blk_oce_clio
 
-
-   SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os, palb,  &
-      &                      p_taui, p_tauj, p_qns , p_qsr,   &
-      &                      p_qla , p_dqns, p_dqla,          &
-      &                      p_tpr , p_spr ,                  &
-      &                      p_fr1 , p_fr2 , cd_grid, pdim  )
+# if defined key_lim2 || defined key_lim3
+   SUBROUTINE blk_ice_clio_tau
       !!---------------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_ice_clio  ***
+      !!                     ***  ROUTINE blk_ice_clio_tau  ***
+      !!                 
+      !!  ** Purpose :   Computation momentum flux at the ice-atm interface  
+      !!         
+      !!  ** Method  :   Read utau from a forcing file. Rearrange if C-grid
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   zcoef
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_tau')
+
+      SELECT CASE( cp_ice_msh )
+
+      CASE( 'C' )                          ! C-grid ice dynamics
+
+         zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress
+         utau_ice(:,:) = zcoef * utau(:,:)
+         vtau_ice(:,:) = zcoef * vtau(:,:)
+
+      CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner)
+
+         zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress
+         DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point
+            DO ji = 2, jpi   ! I-grid : no vector opt.
+               utau_ice(ji,jj) = zcoef * ( utau(ji-1,jj  ) + utau(ji-1,jj-1) )
+               vtau_ice(ji,jj) = zcoef * ( vtau(ji  ,jj-1) + vtau(ji-1,jj-1) )
+            END DO
+         END DO
+
+         CALL lbc_lnk( utau_ice(:,:), 'I', -1. )   ;   CALL lbc_lnk( vtau_ice(:,:), 'I', -1. )   ! I-point
+
+      END SELECT
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ')
+      ENDIF
+
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio_tau')
+
+   END SUBROUTINE blk_ice_clio_tau
+#endif
+
+# if defined key_lim2 || defined key_lim3
+   SUBROUTINE blk_ice_clio_flx(  ptsu , palb_cs, palb_os, palb )
+      !!---------------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_clio_flx ***
       !!                 
       !!  ** Purpose :   Computation of the heat fluxes at ocean and snow/ice
@@ -431,26 +486,12 @@
       !!                         to take into account solid precip latent heat flux
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   ptsu      ! ice surface temperature                   [Kelvin]
       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [-]
       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [-]
       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   palb     ! ice albedo (actual value)                      [-]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_taui   ! surface ice stress at I-point (i-component) [N/m2]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tauj   ! surface ice stress at I-point (j-component) [N/m2]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qns    ! non solar heat flux over ice (T-point)      [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qsr    !     solar heat flux over ice (T-point)      [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qla    ! latent    heat flux over ice (T-point)      [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqns   ! non solar heat sensistivity  (T-point)      [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqla   ! latent    heat sensistivity  (T-point)      [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tpr    ! total precipitation          (T-point)   [Kg/m2/s]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_spr    ! solid precipitation          (T-point)   [Kg/m2/s]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [-]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [-]
-      CHARACTER(len=1), INTENT(in   )             ::   cd_grid  ! type of sea-ice grid ("C" or "B" grid)
-      INTEGER, INTENT(in   )                      ::   pdim     ! number of ice categories
       !!
       INTEGER  ::   ji, jj, jl    ! dummy loop indices
-      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays)
-      !!
-      REAL(wp) ::   zcoef, zmt1, zmt2, zmt3, ztatm3     ! temporary scalars
+      !!
+      REAL(wp) ::   zmt1, zmt2, zmt3, ztatm3                    ! temporary scalars
       REAL(wp) ::   ztaevbk, zind1, zind2, zind3, ztamr         !    -         -
       REAL(wp) ::   zesi, zqsati, zdesidt                       !    -         -
@@ -458,4 +499,5 @@
       REAL(wp) ::   zcshi, zclei, zrhovaclei, zrhovacshi        !    -         -
       REAL(wp) ::   ztice3, zticemb, zticemb2, zdqlw, zdqsb     !    -         -
+      REAL(wp) ::   z1_lsub                                     !    -         -
       !!
       REAL(wp), DIMENSION(:,:)  , POINTER ::   ztatm   ! Tair in Kelvin
@@ -464,42 +506,18 @@
       REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa   ! air density
       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw, z_qsb
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw
       !!---------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio')
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_flx')
       !
       CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa )
-      CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb )
-
-      ijpl  = pdim                           ! number of ice categories
+      CALL wrk_alloc( jpi,jpj, jpl, z_qlw, z_qsb )
+
       zpatm = 101000.                        ! atmospheric pressure  (assumed constant  here)
-
-#if defined key_lim3      
-      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)   ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init
-#endif
-      !                                                        ! surface ocean fluxes computed with CLIO bulk formulea
-      !------------------------------------!
-      !   momentum fluxes  (utau, vtau )   !
-      !------------------------------------!
-
-      SELECT CASE( cd_grid )
-      CASE( 'C' )                          ! C-grid ice dynamics
-         zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress
-         p_taui(:,:) = zcoef * utau(:,:)
-         p_tauj(:,:) = zcoef * vtau(:,:)
-      CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner)
-         zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress
-         DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point
-            DO ji = 2, jpi   ! I-grid : no vector opt.
-               p_taui(ji,jj) = zcoef * ( utau(ji-1,jj  ) + utau(ji-1,jj-1) )
-               p_tauj(ji,jj) = zcoef * ( vtau(ji  ,jj-1) + vtau(ji-1,jj-1) )
-            END DO
-         END DO
-         CALL lbc_lnk( p_taui(:,:), 'I', -1. )   ;   CALL lbc_lnk( p_tauj(:,:), 'I', -1. )   ! I-point
-      END SELECT
-
-
+      !--------------------------------------------------------------------------------
       !  Determine cloud optical depths as a function of latitude (Chou et al., 1981).
       !  and the correction factor for taking into account  the effect of clouds 
-      !------------------------------------------------------
+      !--------------------------------------------------------------------------------
+
 !CDIR NOVERRCHK
 !CDIR COLLAPSE
@@ -528,5 +546,5 @@
             zmt2  = ( 272.0 - ztatm(ji,jj) ) / 38.0   ;   zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) )
             zmt3  = ( 281.0 - ztatm(ji,jj) ) / 18.0   ;   zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) )
-            p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s
+            sprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s
                &         * (          zind1      &                   ! solid  (snow) precipitation [kg/m2/s]
                &            + ( 1.0 - zind1 ) * (          zind2   * ( 0.5 + zmt2 )   &
@@ -538,16 +556,16 @@
             ! fraction of qsr_ice which is NOT absorbed in the thin surface layer
             ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 )
-            p_fr1(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1) 
-            p_fr2(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1)
-         END DO
-      END DO
-      CALL iom_put( 'snowpre', p_spr )   ! Snow precipitation 
+            fr1_i0(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1) 
+            fr2_i0(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1)
+         END DO
+      END DO
+      CALL iom_put( 'snowpre', sprecip )   ! Snow precipitation 
       
       !-----------------------------------------------------------!
       !  snow/ice Shortwave radiation   (abedo already computed)  !
       !-----------------------------------------------------------!
-      CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr )
-      
-      DO jl = 1, ijpl
+      CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice )
+      
+      DO jl = 1, jpl
          palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) )   &
             &         +   palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) )
@@ -555,5 +573,5 @@
 
       !                                     ! ========================== !
-      DO jl = 1, ijpl                       !  Loop over ice categories  !
+      DO jl = 1, jpl                       !  Loop over ice categories  !
          !                                  ! ========================== !
 !CDIR NOVERRCHK
@@ -569,5 +587,5 @@
                ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 
                !
-               z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( pst(ji,jj,jl) - ztatm(ji,jj) ) ) 
+               z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) ) 
 
                !----------------------------------------
@@ -576,12 +594,12 @@
 
                ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential)
-               zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( pst(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) )
+               zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( ptsu(ji,jj,jl) - rtt )/ ( ptsu(ji,jj,jl) - 7.66 ) )
                ! humidity close to the ice surface (at saturation)
                zqsati   = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi )
                
                !  computation of intermediate values
-               zticemb  = pst(ji,jj,jl) - 7.66
+               zticemb  = ptsu(ji,jj,jl) - 7.66
                zticemb2 = zticemb * zticemb  
-               ztice3   = pst(ji,jj,jl) * pst(ji,jj,jl) * pst(ji,jj,jl)
+               ztice3   = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) * ptsu(ji,jj,jl)
                zdesidt  = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 )  / zticemb2 )
                
@@ -596,8 +614,8 @@
             
                !  sensible heat flux
-               z_qsb(ji,jj,jl) = zrhovacshi * ( pst(ji,jj,jl) - ztatm(ji,jj) )
+               z_qsb(ji,jj,jl) = zrhovacshi * ( ptsu(ji,jj,jl) - ztatm(ji,jj) )
             
                !  latent heat flux 
-               p_qla(ji,jj,jl) = MAX(  0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) )  )
+               qla_ice(ji,jj,jl) = MAX(  0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) )  )
               
                !  sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes)
@@ -606,6 +624,6 @@
                zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) )   
                !
-               p_dqla(ji,jj,jl) = zdqla                           ! latent flux sensitivity
-               p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity
+               dqla_ice(ji,jj,jl) = zdqla                           ! latent flux sensitivity
+               dqns_ice(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity
             END DO
             !
@@ -619,7 +637,7 @@
       !
 !CDIR COLLAPSE
-      p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux
-!CDIR COLLAPSE
-      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s]
+      qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:)      ! Downward Non Solar flux
+!CDIR COLLAPSE
+      tprecip(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s]
       !
       ! ----------------------------------------------------------------------------- !
@@ -628,42 +646,79 @@
 !CDIR COLLAPSE
       qns(:,:) = qns(:,:)                                                           &   ! update the non-solar heat flux with:
-         &     - p_spr(:,:) * lfus                                                  &   ! remove melting solid precip
-         &     + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic &   ! add solid P at least below melting
-         &     - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1)                        * rcp      ! remove solid precip. at Tair
-      !
+         &     - sprecip(:,:) * lfus                                                  &   ! remove melting solid precip
+         &     + sprecip(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic &   ! add solid P at least below melting
+         &     - sprecip(:,:) * sf(jp_tair)%fnow(:,:,1)                        * rcp      ! remove solid precip. at Tair
+
+#if defined key_lim3
+      ! ----------------------------------------------------------------------------- !
+      !    Distribute evapo, precip & associated heat over ice and ocean
+      ! ---------------=====--------------------------------------------------------- !
+      CALL wrk_alloc( jpi,jpj, zevap, zsnw ) 
+
+      ! --- evaporation --- !
+      z1_lsub = 1._wp / Lsub
+      evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation
+      devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub
+      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean
+
+      ! --- evaporation minus precipitation --- !
+      zsnw(:,:) = 0._wp
+      CALL lim_thd_snwblow( pfrld, zsnw )          ! snow redistribution by wind
+      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * ( 1._wp - zsnw )
+      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw
+      emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:)
+
+      ! --- heat flux associated with emp --- !
+      qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap
+         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip
+         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip
+         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only)
+         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+      ! --- total solar and non solar fluxes --- !
+      qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
+      qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
+
+      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
+      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+      CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 
+#endif
+
 !!gm : not necessary as all input data are lbc_lnk...
-      CALL lbc_lnk( p_fr1  (:,:) , 'T', 1. )
-      CALL lbc_lnk( p_fr2  (:,:) , 'T', 1. )
-      DO jl = 1, ijpl
-         CALL lbc_lnk( p_qns (:,:,jl) , 'T', 1. )
-         CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. )
-         CALL lbc_lnk( p_qla (:,:,jl) , 'T', 1. )
-         CALL lbc_lnk( p_dqla(:,:,jl) , 'T', 1. )
+      CALL lbc_lnk( fr1_i0  (:,:) , 'T', 1. )
+      CALL lbc_lnk( fr2_i0  (:,:) , 'T', 1. )
+      DO jl = 1, jpl
+         CALL lbc_lnk( qns_ice (:,:,jl) , 'T', 1. )
+         CALL lbc_lnk( dqns_ice(:,:,jl) , 'T', 1. )
+         CALL lbc_lnk( qla_ice (:,:,jl) , 'T', 1. )
+         CALL lbc_lnk( dqla_ice(:,:,jl) , 'T', 1. )
       END DO
 
 !!gm : mask is not required on forcing
-      DO jl = 1, ijpl
-         p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1)
-         p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1)
-         p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1)
-         p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1)
-      END DO
+      DO jl = 1, jpl
+         qns_ice (:,:,jl) = qns_ice (:,:,jl) * tmask(:,:,1)
+         qla_ice (:,:,jl) = qla_ice (:,:,jl) * tmask(:,:,1)
+         dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * tmask(:,:,1)
+         dqla_ice(:,:,jl) = dqla_ice(:,:,jl) * tmask(:,:,1)
+      END DO
+
+      CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa )
+      CALL wrk_dealloc( jpi,jpj, jpl  , z_qlw, z_qsb )
 
       IF(ln_ctl) THEN
-         CALL prt_ctl(tab3d_1=z_qsb  , clinfo1=' blk_ice_clio: z_qsb  : ', tab3d_2=z_qlw  , clinfo2=' z_qlw  : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=p_qla  , clinfo1=' blk_ice_clio: z_qla  : ', tab3d_2=p_qsr  , clinfo2=' p_qsr  : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_clio: p_dqns : ', tab3d_2=p_qns  , clinfo2=' p_qns  : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst    , clinfo2=' pst    : ', kdim=ijpl)
-         CALL prt_ctl(tab2d_1=p_tpr  , clinfo1=' blk_ice_clio: p_tpr  : ', tab2d_2=p_spr  , clinfo2=' p_spr  : ')
-         CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ')
+         CALL prt_ctl(tab3d_1=z_qsb  , clinfo1=' blk_ice_clio: z_qsb  : ', tab3d_2=z_qlw  , clinfo2=' z_qlw  : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=qla_ice  , clinfo1=' blk_ice_clio: z_qla  : ', tab3d_2=qsr_ice  , clinfo2=' qsr_ice  : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=dqns_ice , clinfo1=' blk_ice_clio: dqns_ice : ', tab3d_2=qns_ice  , clinfo2=' qns_ice  : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=dqla_ice , clinfo1=' blk_ice_clio: dqla_ice : ', tab3d_2=ptsu    , clinfo2=' ptsu    : ', kdim=jpl)
+         CALL prt_ctl(tab2d_1=tprecip  , clinfo1=' blk_ice_clio: tprecip  : ', tab2d_2=sprecip  , clinfo2=' sprecip  : ')
       ENDIF
 
-      CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa )
-      CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio')
-      !
-   END SUBROUTINE blk_ice_clio
-
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio_flx')
+      !
+   END SUBROUTINE blk_ice_clio_flx
+
+#endif
 
    SUBROUTINE blk_clio_qsr_oce( pqsr_oce )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 5682)
@@ -22,6 +22,4 @@
    !!   blk_oce_core    : computes momentum, heat and freshwater fluxes over ocean
    !!   blk_ice_core    : computes momentum, heat and freshwater fluxes over ice
-   !!   blk_bio_meanqsr : compute daily mean short wave radiation over the ocean
-   !!   blk_ice_meanqsr : compute daily mean short wave radiation over the ice
    !!   turb_core_2z    : Computes turbulent transfert coefficients
    !!   cd_neutral_10m  : Estimate of the neutral drag coefficient at 10m
@@ -46,4 +44,11 @@
    USE sbc_ice         ! Surface boundary condition: ice fields
    USE lib_fortran     ! to use key_nosignedzero
+#if defined key_lim3
+   USE ice, ONLY       : u_ice, v_ice, jpl, pfrld, a_i_b
+   USE limthd_dh       ! for CALL lim_thd_snwblow
+#elif defined key_lim2
+   USE ice_2, ONLY     : u_ice, v_ice
+   USE par_ice_2
+#endif
 
    IMPLICIT NONE
@@ -51,6 +56,8 @@
 
    PUBLIC   sbc_blk_core         ! routine called in sbcmod module
-   PUBLIC   blk_ice_core         ! routine called in sbc_ice_lim module
-   PUBLIC   blk_ice_meanqsr      ! routine called in sbc_ice_lim module
+#if defined key_lim2 || defined key_lim3
+   PUBLIC   blk_ice_core_tau     ! routine called in sbc_ice_lim module
+   PUBLIC   blk_ice_core_flx     ! routine called in sbc_ice_lim module
+#endif
    PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module
 
@@ -195,7 +202,4 @@
       !                                            ! compute the surface ocean fluxes using CORE bulk formulea
       IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m )
-
-      ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery
-      IF( ltrcdm2dc )   CALL blk_bio_meanqsr
 
 #if defined key_cice
@@ -302,4 +306,5 @@
       ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1)
       ENDIF
+
       zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
       ! ----------------------------------------------------------------------------- !
@@ -376,5 +381,6 @@
       emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.)
          &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1)
-      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar flux
+      !
+      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar 
          &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip
          &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST
@@ -384,9 +390,22 @@
          &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1)
       !
-      CALL iom_put( "qlw_oce",   zqlw )                 ! output downward longwave heat over the ocean
-      CALL iom_put( "qsb_oce", - zqsb )                 ! output downward sensible heat over the ocean
-      CALL iom_put( "qla_oce", - zqla )                 ! output downward latent   heat over the ocean
-      CALL iom_put( "qhc_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean
-      CALL iom_put( "qns_oce",   qns  )                 ! output downward non solar heat over the ocean
+#if defined key_lim3
+      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by LIM3)
+      qsr_oce(:,:) = qsr(:,:)
+#endif
+      !
+      IF ( nn_ice == 0 ) THEN
+         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave heat over the ocean
+         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible heat over the ocean
+         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent   heat over the ocean
+         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean
+         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean
+         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean
+         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean
+         tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac   ! output total precipitation [kg/m2/s]
+         sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac   ! output solid precipitation [kg/m2/s]
+         CALL iom_put( 'snowpre', sprecip * 86400. )        ! Snow
+         CALL iom_put( 'precip' , tprecip * 86400. )        ! Total precipitation
+      ENDIF
       !
       IF(ln_ctl) THEN
@@ -406,81 +425,37 @@
  
    
-   SUBROUTINE blk_ice_core(  pst   , pui   , pvi   , palb ,   &
-      &                      p_taui, p_tauj, p_qns , p_qsr,   &
-      &                      p_qla , p_dqns, p_dqla,          &
-      &                      p_tpr , p_spr ,                  &
-      &                      p_fr1 , p_fr2 , cd_grid, pdim  ) 
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_ice_core  ***
+#if defined key_lim2 || defined key_lim3
+   SUBROUTINE blk_ice_core_tau
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_core_tau  ***
       !!
       !! ** Purpose :   provide the surface boundary condition over sea-ice
       !!
-      !! ** Method  :   compute momentum, heat and freshwater exchanged
-      !!                between atmosphere and sea-ice using CORE bulk
-      !!                formulea, ice variables and read atmmospheric fields.
+      !! ** Method  :   compute momentum using CORE bulk
+      !!                formulea, ice variables and read atmospheric fields.
       !!                NB: ice drag coefficient is assumed to be a constant
-      !! 
-      !! caution : the net upward water flux has with mm/day unit
-      !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin]
-      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s]
-      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid)
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (all skies)                            [%]
-      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2]
-      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid)
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qns    ! non solar heat flux over ice (T-point)         [W/m2]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr    !     solar heat flux over ice (T-point)         [W/m2]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qla    ! latent    heat flux over ice (T-point)         [W/m2]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_dqns   ! non solar heat sensistivity  (T-point)         [W/m2]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_dqla   ! latent    heat sensistivity  (T-point)         [W/m2]
-      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s]
-      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s]
-      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%]
-      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_fr2    ! 2nd fraction of qsr penetration in ice (T-point)  [%]
-      CHARACTER(len=1)          , INTENT(in   ) ::   cd_grid  ! ice grid ( C or B-grid)
-      INTEGER                   , INTENT(in   ) ::   pdim     ! number of ice categories
-      !!
-      INTEGER  ::   ji, jj, jl    ! dummy loop indices
-      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays)
-      REAL(wp) ::   zst2, zst3
-      REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb
-      REAL(wp) ::   zztmp                                        ! temporary variable
-      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point
-      REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point
-      !!
-      REAL(wp), DIMENSION(:,:)  , POINTER ::   z_wnds_t          ! wind speed ( = | U10m - U_ice | ) at T-point
-      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice
-      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice
-      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw            ! long wave heat sensitivity over ice
-      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice
-      !!---------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core')
-      !
-      CALL wrk_alloc( jpi,jpj, z_wnds_t )
-      CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
-
-      ijpl  = pdim                            ! number of ice categories
-
+      !!---------------------------------------------------------------------
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2
+      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f               ! relative wind module and components at F-point
+      REAL(wp) ::             zwndi_t , zwndj_t               ! relative wind components at T-point
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core_tau')
+      !
       ! local scalars ( place there for vector optimisation purposes)
       zcoef_wnorm  = rhoa * Cice
       zcoef_wnorm2 = rhoa * Cice * 0.5
-      zcoef_dqlw   = 4.0 * 0.95 * Stef
-      zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8)
-      zcoef_dqsb   = rhoa * cpa * Cice
 
 !!gm brutal....
-      z_wnds_t(:,:) = 0.e0
-      p_taui  (:,:) = 0.e0
-      p_tauj  (:,:) = 0.e0
+      utau_ice  (:,:) = 0._wp
+      vtau_ice  (:,:) = 0._wp
+      wndm_ice  (:,:) = 0._wp
 !!gm end
 
-#if defined key_lim3
-      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)   ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init
-#endif
       ! ----------------------------------------------------------------------------- !
       !    Wind components and module relative to the moving ocean ( U10m - U_ice )   !
       ! ----------------------------------------------------------------------------- !
-      SELECT CASE( cd_grid )
+      SELECT CASE( cp_ice_msh )
       CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
          !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked)
@@ -489,48 +464,94 @@
                ! ... scalar wind at I-point (fld being at T-point)
                zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   &
-                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pui(ji,jj)
+                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * u_ice(ji,jj)
                zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   &
-                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pvi(ji,jj)
+                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * v_ice(ji,jj)
                zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )
                ! ... ice stress at I-point
-               p_taui(ji,jj) = zwnorm_f * zwndi_f
-               p_tauj(ji,jj) = zwnorm_f * zwndj_f
+               utau_ice(ji,jj) = zwnorm_f * zwndi_f
+               vtau_ice(ji,jj) = zwnorm_f * zwndj_f
                ! ... scalar wind at T-point (fld being at T-point)
-               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   &
-                  &                                                    + pui(ji,jj  ) + pui(ji+1,jj  )  )
-               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   &
-                  &                                                    + pvi(ji,jj  ) + pvi(ji+1,jj  )  )
-               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  u_ice(ji,jj+1) + u_ice(ji+1,jj+1)   &
+                  &                                                    + u_ice(ji,jj  ) + u_ice(ji+1,jj  )  )
+               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  v_ice(ji,jj+1) + v_ice(ji+1,jj+1)   &
+                  &                                                    + v_ice(ji,jj  ) + v_ice(ji+1,jj  )  )
+               wndm_ice(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
             END DO
          END DO
-         CALL lbc_lnk( p_taui  , 'I', -1. )
-         CALL lbc_lnk( p_tauj  , 'I', -1. )
-         CALL lbc_lnk( z_wnds_t, 'T',  1. )
+         CALL lbc_lnk( utau_ice, 'I', -1. )
+         CALL lbc_lnk( vtau_ice, 'I', -1. )
+         CALL lbc_lnk( wndm_ice, 'T',  1. )
          !
       CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean)
          DO jj = 2, jpj
             DO ji = fs_2, jpi   ! vect. opt.
-               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  )
-               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  )
-               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  )
+               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  )
+               wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
             END DO
          END DO
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vect. opt.
-               p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj  ) + z_wnds_t(ji,jj) )                          &
-                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * pui(ji,jj) )
-               p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1  ) + z_wnds_t(ji,jj) )                          &
-                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * pvi(ji,jj) )
+               utau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )                          &
+                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) )
+               vtau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )                          &
+                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) )
             END DO
          END DO
-         CALL lbc_lnk( p_taui  , 'U', -1. )
-         CALL lbc_lnk( p_tauj  , 'V', -1. )
-         CALL lbc_lnk( z_wnds_t, 'T',  1. )
+         CALL lbc_lnk( utau_ice, 'U', -1. )
+         CALL lbc_lnk( vtau_ice, 'V', -1. )
+         CALL lbc_lnk( wndm_ice, 'T',  1. )
          !
       END SELECT
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=utau_ice  , clinfo1=' blk_ice_core: utau_ice : ', tab2d_2=vtau_ice  , clinfo2=' vtau_ice : ')
+         CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice_core: wndm_ice : ')
+      ENDIF
+
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_tau')
+      
+   END SUBROUTINE blk_ice_core_tau
+
+
+   SUBROUTINE blk_ice_core_flx( ptsu, palb )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_core_flx  ***
+      !!
+      !! ** Purpose :   provide the surface boundary condition over sea-ice
+      !!
+      !! ** Method  :   compute heat and freshwater exchanged
+      !!                between atmosphere and sea-ice using CORE bulk
+      !!                formulea, ice variables and read atmmospheric fields.
+      !! 
+      !! caution : the net upward water flux has with mm/day unit
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu          ! sea ice surface temperature
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb          ! ice albedo (all skies)
+      !!
+      INTEGER  ::   ji, jj, jl    ! dummy loop indices
+      REAL(wp) ::   zst2, zst3
+      REAL(wp) ::   zcoef_dqlw, zcoef_dqla, zcoef_dqsb
+      REAL(wp) ::   zztmp, z1_lsub                               ! temporary variable
+      !!
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw            ! long wave heat sensitivity over ice
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw       ! evaporation and snw distribution after wind blowing (LIM3)
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core_flx')
+      !
+      CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
+
+      ! local scalars ( place there for vector optimisation purposes)
+      zcoef_dqlw   = 4.0 * 0.95 * Stef
+      zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8)
+      zcoef_dqsb   = rhoa * cpa * Cice
 
       zztmp = 1. / ( 1. - albo )
       !                                     ! ========================== !
-      DO jl = 1, ijpl                       !  Loop over ice categories  !
+      DO jl = 1, jpl                        !  Loop over ice categories  !
          !                                  ! ========================== !
          DO jj = 1 , jpj
@@ -539,10 +560,10 @@
                !      I   Radiative FLUXES   !
                ! ----------------------------!
-               zst2 = pst(ji,jj,jl) * pst(ji,jj,jl)
-               zst3 = pst(ji,jj,jl) * zst2
+               zst2 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl)
+               zst3 = ptsu(ji,jj,jl) * zst2
                ! Short Wave (sw)
-               p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)
+               qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)
                ! Long  Wave (lw)
-               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
+               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
                ! lw sensitivity
                z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                               
@@ -554,17 +575,17 @@
                ! ... turbulent heat fluxes
                ! Sensible Heat
-               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )
+               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )
                ! Latent Heat
-               p_qla(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(ji,jj)   &                           
-                  &                         * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) )
-               ! Latent heat sensitivity for ice (Dqla/Dt)
-               IF( p_qla(ji,jj,jl) > 0._wp ) THEN
-                  p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) )
+               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * wndm_ice(ji,jj)   &                           
+                  &                         * (  11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) )
+              ! Latent heat sensitivity for ice (Dqla/Dt)
+               IF( qla_ice(ji,jj,jl) > 0._wp ) THEN
+                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) )
                ELSE
-                  p_dqla(ji,jj,jl) = 0._wp
+                  dqla_ice(ji,jj,jl) = 0._wp
                ENDIF
 
                ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice)
-               z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj)
+               z_dqsb(ji,jj,jl) = zcoef_dqsb * wndm_ice(ji,jj)
 
                ! ----------------------------!
@@ -572,7 +593,7 @@
                ! ----------------------------!
                ! Downward Non Solar flux
-               p_qns (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl)
+               qns_ice (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - qla_ice (ji,jj,jl)
                ! Total non solar heat flux sensitivity for ice
-               p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) )
+               dqns_ice(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + dqla_ice(ji,jj,jl) )
             END DO
             !
@@ -581,4 +602,43 @@
       END DO
       !
+      tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s]
+      sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s]
+      CALL iom_put( 'snowpre', sprecip * 86400. )                  ! Snow precipitation
+      CALL iom_put( 'precip' , tprecip * 86400. )                  ! Total precipitation
+
+#if defined  key_lim3
+      CALL wrk_alloc( jpi,jpj, zevap, zsnw ) 
+
+      ! --- evaporation --- !
+      z1_lsub = 1._wp / Lsub
+      evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation
+      devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub
+      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean
+
+      ! --- evaporation minus precipitation --- !
+      zsnw(:,:) = 0._wp
+      CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing 
+      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw )
+      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw
+      emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:)
+
+      ! --- heat flux associated with emp --- !
+      qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap at sst
+         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair
+         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow)
+         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only)
+         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+      ! --- total solar and non solar fluxes --- !
+      qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
+      qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
+
+      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
+      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+      CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 
+#endif
+
       !--------------------------------------------------------------------
       ! FRACTIONs of net shortwave radiation which is not absorbed in the
@@ -586,85 +646,23 @@
       ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 )
       !
-      p_fr1(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
-      p_fr2(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
-      !
-      p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s]
-      p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s]
-      CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation
-      CALL iom_put( 'precip' , p_tpr * 86400. )                  ! Total precipitation
+      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
+      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
+      !
       !
       IF(ln_ctl) THEN
-         CALL prt_ctl(tab3d_1=p_qla   , clinfo1=' blk_ice_core: p_qla  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb  : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice_core: z_qlw  : ', tab3d_2=p_dqla  , clinfo2=' p_dqla : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=z_dqsb  , clinfo1=' blk_ice_core: z_dqsb : ', tab3d_2=z_dqlw  , clinfo2=' z_dqlw : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=p_dqns  , clinfo1=' blk_ice_core: p_dqns : ', tab3d_2=p_qsr   , clinfo2=' p_qsr  : ', kdim=ijpl)
-         CALL prt_ctl(tab3d_1=pst     , clinfo1=' blk_ice_core: pst    : ', tab3d_2=p_qns   , clinfo2=' p_qns  : ', kdim=ijpl)
-         CALL prt_ctl(tab2d_1=p_tpr   , clinfo1=' blk_ice_core: p_tpr  : ', tab2d_2=p_spr   , clinfo2=' p_spr  : ')
-         CALL prt_ctl(tab2d_1=p_taui  , clinfo1=' blk_ice_core: p_taui : ', tab2d_2=p_tauj  , clinfo2=' p_tauj : ')
-         CALL prt_ctl(tab2d_1=z_wnds_t, clinfo1=' blk_ice_core: z_wnds_t : ')
-      ENDIF
-
-      CALL wrk_dealloc( jpi,jpj,   z_wnds_t )
-      CALL wrk_dealloc( jpi,jpj,   pdim, z_qlw, z_qsb, z_dqlw, z_dqsb )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core')
-      !
-   END SUBROUTINE blk_ice_core
-
-
-   SUBROUTINE blk_bio_meanqsr
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_bio_meanqsr
-      !!                     
-      !! ** Purpose :   provide daily qsr_mean for PISCES when
-      !!                analytic diurnal cycle is applied in physic
-      !!                
-      !! ** Method  :   add part where there is no ice
-      !! 
-      !!---------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('blk_bio_meanqsr')
-      !
-      qsr_mean(:,:) = (1. - albo ) *  sf(jp_qsr)%fnow(:,:,1)
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('blk_bio_meanqsr')
-      !
-   END SUBROUTINE blk_bio_meanqsr
- 
- 
-   SUBROUTINE blk_ice_meanqsr( palb, p_qsr_mean, pdim )
-      !!---------------------------------------------------------------------
-      !!
-      !! ** Purpose :   provide the daily qsr_mean over sea_ice for PISCES when
-      !!                analytic diurnal cycle is applied in physic
-      !!
-      !! ** Method  :   compute qsr
-      !! 
-      !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb       ! ice albedo (clear sky) (alb_ice_cs)               [%]
-      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr_mean !     solar heat flux over ice (T-point)         [W/m2]
-      INTEGER                   , INTENT(in   ) ::   pdim       ! number of ice categories
-      !
-      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays)
-      INTEGER  ::   ji, jj, jl    ! dummy loop indices
-      REAL(wp) ::   zztmp         ! temporary variable
-      !!---------------------------------------------------------------------
-      IF( nn_timing == 1 )  CALL timing_start('blk_ice_meanqsr')
-      !
-      ijpl  = pdim                            ! number of ice categories
-      zztmp = 1. / ( 1. - albo )
-      !                                     ! ========================== !
-      DO jl = 1, ijpl                       !  Loop over ice categories  !
-         !                                  ! ========================== !
-         DO jj = 1 , jpj
-            DO ji = 1, jpi
-                  p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj)
-            END DO
-         END DO
-      END DO
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_meanqsr')
-      !
-   END SUBROUTINE blk_ice_meanqsr  
-
+         CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_core: qla_ice  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb    : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice_core: z_qlw    : ', tab3d_2=dqla_ice, clinfo2=' dqla_ice : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=z_dqsb  , clinfo1=' blk_ice_core: z_dqsb   : ', tab3d_2=z_dqlw  , clinfo2=' z_dqlw   : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=dqns_ice, clinfo1=' blk_ice_core: dqns_ice : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice  : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=ptsu    , clinfo1=' blk_ice_core: ptsu     : ', tab3d_2=qns_ice , clinfo2=' qns_ice  : ', kdim=jpl)
+         CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_core: tprecip  : ', tab2d_2=sprecip , clinfo2=' sprecip  : ')
+      ENDIF
+
+      CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_flx')
+      
+   END SUBROUTINE blk_ice_core_flx
+#endif
 
    SUBROUTINE turb_core_2z( zt, zu, sst, T_zt, q_sat, q_zt, dU,    &
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90	(revision 5682)
@@ -46,5 +46,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id: sbcblk_mfs.F90 1730 2009-11-16 14:34:19Z poddo $
+   !! $Id$
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 5682)
@@ -21,8 +21,8 @@
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice fields
+   USE sbcapr
    USE sbcdcy          ! surface boundary condition: diurnal cycle
    USE phycst          ! physical constants
 #if defined key_lim3
-   USE par_ice         ! ice parameters
    USE ice             ! ice variables
 #endif
@@ -33,5 +33,5 @@
    USE cpl_oasis3      ! OASIS3 coupling
    USE geo2ocean       ! 
-   USE oce   , ONLY : tsn, un, vn
+   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
    USE albedo          !
    USE in_out_manager  ! I/O manager
@@ -41,4 +41,6 @@
    USE timing          ! Timing
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE eosbn2
+   USE sbcrnf   , ONLY : l_rnfcpl
 #if defined key_cpl_carbon_cycle
    USE p4zflx, ONLY : oce_co2
@@ -47,7 +49,11 @@
    USE ice_domain_size, only: ncat
 #endif
+#if defined key_lim3
+   USE limthd_dh       ! for CALL lim_thd_snwblow
+#endif
+
    IMPLICIT NONE
    PRIVATE
-!EM XIOS-OASIS-MCT compliance
+
    PUBLIC   sbc_cpl_init       ! routine called by sbcmod.F90
    PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90
@@ -90,7 +96,16 @@
    INTEGER, PARAMETER ::   jpr_topm   = 32            ! topmeltn
    INTEGER, PARAMETER ::   jpr_botm   = 33            ! botmeltn
-   INTEGER, PARAMETER ::   jprcv      = 33            ! total number of fields received
-
-   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction 
+   INTEGER, PARAMETER ::   jpr_sflx   = 34            ! salt flux
+   INTEGER, PARAMETER ::   jpr_toce   = 35            ! ocean temperature
+   INTEGER, PARAMETER ::   jpr_soce   = 36            ! ocean salinity
+   INTEGER, PARAMETER ::   jpr_ocx1   = 37            ! ocean current on grid 1
+   INTEGER, PARAMETER ::   jpr_ocy1   = 38            !
+   INTEGER, PARAMETER ::   jpr_ssh    = 39            ! sea surface height
+   INTEGER, PARAMETER ::   jpr_fice   = 40            ! ice fraction          
+   INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness 
+   INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level
+   INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received
+
+   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere
    INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature
    INTEGER, PARAMETER ::   jps_tice   =  3            ! ice   temperature
@@ -107,5 +122,18 @@
    INTEGER, PARAMETER ::   jps_ivz1   = 14            !
    INTEGER, PARAMETER ::   jps_co2    = 15
-   INTEGER, PARAMETER ::   jpsnd      = 15            ! total number of fields sended
+   INTEGER, PARAMETER ::   jps_soce   = 16            ! ocean salinity
+   INTEGER, PARAMETER ::   jps_ssh    = 17            ! sea surface height
+   INTEGER, PARAMETER ::   jps_qsroce = 18            ! Qsr above the ocean
+   INTEGER, PARAMETER ::   jps_qnsoce = 19            ! Qns above the ocean
+   INTEGER, PARAMETER ::   jps_oemp   = 20            ! ocean freshwater budget (evap - precip)
+   INTEGER, PARAMETER ::   jps_sflx   = 21            ! salt flux
+   INTEGER, PARAMETER ::   jps_otx1   = 22            ! 2 atmosphere-ocean stress components on grid 1
+   INTEGER, PARAMETER ::   jps_oty1   = 23            ! 
+   INTEGER, PARAMETER ::   jps_rnf    = 24            ! runoffs
+   INTEGER, PARAMETER ::   jps_taum   = 25            ! wind stress module
+   INTEGER, PARAMETER ::   jps_fice2  = 26            ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling)
+   INTEGER, PARAMETER ::   jps_e3t1st = 27            ! first level depth (vvl)
+   INTEGER, PARAMETER ::   jps_fraqsr = 28            ! fraction of solar net radiation absorbed in the first ocean level
+   INTEGER, PARAMETER ::   jpsnd      = 28            ! total number of fields sended
 
    !                                                         !!** namelist namsbc_cpl **
@@ -126,7 +154,4 @@
    LOGICAL     ::   ln_usecplmask          !  use a coupling mask file to merge data received from several models
                                            !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
-
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask
-
    TYPE ::   DYNARR     
       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3   
@@ -140,4 +165,5 @@
 
    !! Substitution
+#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -162,5 +188,5 @@
       ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init)
 #endif
-      ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) )
+      ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) )
       !
       sbc_cpl_alloc = MAXVAL( ierr )
@@ -183,5 +209,5 @@
       !!              * initialise the OASIS coupler
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3)
+      INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3)
       !!
       INTEGER ::   jn   ! dummy loop index
@@ -217,4 +243,6 @@
          WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
          WRITE(numout,*)'~~~~~~~~~~~~'
+      ENDIF
+      IF( lwp .AND. ln_cpl ) THEN                        ! control print
          WRITE(numout,*)'  received fields (mutiple ice categogies)'
          WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')'
@@ -360,4 +388,5 @@
       srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip
       SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
+      CASE( 'none'          )       ! nothing to do
       CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE. 
       CASE( 'conservative'  )
@@ -371,9 +400,13 @@
       !                                                      !     Runoffs & Calving     !   
       !                                                      ! ------------------------- !
-      srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE.
-! This isn't right - really just want ln_rnf_emp changed
-!                                                 IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' )   THEN   ;   ln_rnf = .TRUE.
-!                                                 ELSE                                                 ;   ln_rnf = .FALSE.
-!                                                 ENDIF
+      srcv(jpr_rnf   )%clname = 'O_Runoff'
+      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN
+         srcv(jpr_rnf)%laction = .TRUE.
+         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf
+         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   runoffs received from oasis -> force ln_rnf = ', ln_rnf
+      ENDIF
+      !
       srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE.
 
@@ -385,4 +418,5 @@
       srcv(jpr_qnsmix)%clname = 'O_QnsMix'
       SELECT CASE( TRIM( sn_rcv_qns%cldes ) )
+      CASE( 'none'          )       ! nothing to do
       CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE.
       CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE.
@@ -400,4 +434,5 @@
       srcv(jpr_qsrmix)%clname = 'O_QsrMix'
       SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )
+      CASE( 'none'          )       ! nothing to do
       CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE.
       CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE.
@@ -415,5 +450,5 @@
       !
       ! non solar sensitivity mandatory for LIM ice model
-      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) &
+      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) &
          CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' )
       ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique
@@ -448,6 +483,91 @@
          srcv(jpr_topm:jpr_botm)%laction = .TRUE.
       ENDIF
-
-      ! Allocate all parts of frcv used for received fields
+      !                                                      ! ------------------------------- !
+      !                                                      !   OPA-SAS coupling - rcv by opa !   
+      !                                                      ! ------------------------------- !
+      srcv(jpr_sflx)%clname = 'O_SFLX'
+      srcv(jpr_fice)%clname = 'RIceFrc'
+      !
+      IF( nn_components == jp_iam_opa ) THEN    ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS)
+         srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
+         srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling
+         srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling
+         srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE.
+         srcv(jpr_otx1)%clgrid = 'U'        ! oce components given at U-point
+         srcv(jpr_oty1)%clgrid = 'V'        !           and           V-point
+         ! Vectors: change of sign at north fold ONLY if on the local grid
+         srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1.
+         sn_rcv_tau%clvgrd = 'U,V'
+         sn_rcv_tau%clvor = 'local grid'
+         sn_rcv_tau%clvref = 'spherical'
+         sn_rcv_emp%cldes = 'oce only'
+         !
+         IF(lwp) THEN                        ! control print
+            WRITE(numout,*)
+            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  '
+            WRITE(numout,*)'               OPA component  '
+            WRITE(numout,*)
+            WRITE(numout,*)'  received fields from SAS component '
+            WRITE(numout,*)'                  ice cover '
+            WRITE(numout,*)'                  oce only EMP  '
+            WRITE(numout,*)'                  salt flux  '
+            WRITE(numout,*)'                  mixed oce-ice solar flux  '
+            WRITE(numout,*)'                  mixed oce-ice non solar flux  '
+            WRITE(numout,*)'                  wind stress U,V on local grid and sperical coordinates '
+            WRITE(numout,*)'                  wind stress module'
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+      !                                                      ! -------------------------------- !
+      !                                                      !   OPA-SAS coupling - rcv by sas  !   
+      !                                                      ! -------------------------------- !
+      srcv(jpr_toce  )%clname = 'I_SSTSST'
+      srcv(jpr_soce  )%clname = 'I_SSSal'
+      srcv(jpr_ocx1  )%clname = 'I_OCurx1'
+      srcv(jpr_ocy1  )%clname = 'I_OCury1'
+      srcv(jpr_ssh   )%clname = 'I_SSHght'
+      srcv(jpr_e3t1st)%clname = 'I_E3T1st'   
+      srcv(jpr_fraqsr)%clname = 'I_FraQsr'   
+      !
+      IF( nn_components == jp_iam_sas ) THEN
+         IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
+         IF( .NOT. ln_cpl ) srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling
+         IF( .NOT. ln_cpl ) srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling
+         srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE.
+         srcv( jpr_e3t1st )%laction = lk_vvl
+         srcv(jpr_ocx1)%clgrid = 'U'        ! oce components given at U-point
+         srcv(jpr_ocy1)%clgrid = 'V'        !           and           V-point
+         ! Vectors: change of sign at north fold ONLY if on the local grid
+         srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1.
+         ! Change first letter to couple with atmosphere if already coupled OPA
+         ! this is nedeed as each variable name used in the namcouple must be unique:
+         ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere
+         DO jn = 1, jprcv
+            IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
+         END DO
+         !
+         IF(lwp) THEN                        ! control print
+            WRITE(numout,*)
+            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  '
+            WRITE(numout,*)'               SAS component  '
+            WRITE(numout,*)
+            IF( .NOT. ln_cpl ) THEN
+               WRITE(numout,*)'  received fields from OPA component '
+            ELSE
+               WRITE(numout,*)'  Additional received fields from OPA component : '
+            ENDIF
+            WRITE(numout,*)'               sea surface temperature (Celcius) '
+            WRITE(numout,*)'               sea surface salinity ' 
+            WRITE(numout,*)'               surface currents ' 
+            WRITE(numout,*)'               sea surface height ' 
+            WRITE(numout,*)'               thickness of first ocean T level '        
+            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level'
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+      
+      ! =================================================== !
+      ! Allocate all parts of frcv used for received fields !
+      ! =================================================== !
       DO jn = 1, jprcv
          IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
@@ -455,4 +575,9 @@
       ! Allocate taum part of frcv which is used even when not received as coupling field
       IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
+      ! Allocate w10m part of frcv which is used even when not received as coupling field
+      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
+      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
+      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
+      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
       ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
       IF( k_ice /= 0 ) THEN
@@ -478,13 +603,13 @@
       ssnd(jps_tmix)%clname = 'O_TepMix'
       SELECT CASE( TRIM( sn_snd_temp%cldes ) )
-      CASE( 'none'         )       ! nothing to do
-      CASE( 'oce only'             )   ;   ssnd(   jps_toce             )%laction = .TRUE.
-      CASE( 'weighted oce and ice' )
+      CASE( 'none'                                 )       ! nothing to do
+      CASE( 'oce only'                             )   ;   ssnd( jps_toce )%laction = .TRUE.
+      CASE( 'oce and ice' , 'weighted oce and ice' )
          ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
          IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = jpl
-      CASE( 'mixed oce-ice'        )   ;   ssnd(   jps_tmix             )%laction = .TRUE.
+      CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE.
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
       END SELECT
-     
+           
       !                                                      ! ------------------------- !
       !                                                      !          Albedo           !
@@ -493,7 +618,7 @@
       ssnd(jps_albmix)%clname = 'O_AlbMix'
       SELECT CASE( TRIM( sn_snd_alb%cldes ) )
-      CASE( 'none'          )       ! nothing to do
-      CASE( 'weighted ice'  )   ;   ssnd(jps_albice)%laction = .TRUE.
-      CASE( 'mixed oce-ice' )   ;   ssnd(jps_albmix)%laction = .TRUE.
+      CASE( 'none'                 )     ! nothing to do
+      CASE( 'ice' , 'weighted ice' )   ; ssnd(jps_albice)%laction = .TRUE.
+      CASE( 'mixed oce-ice'        )   ; ssnd(jps_albmix)%laction = .TRUE.
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' )
       END SELECT
@@ -519,5 +644,5 @@
          IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl
       ENDIF
-
+      
       SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
       CASE( 'none'         )       ! nothing to do
@@ -526,8 +651,4 @@
          IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
             ssnd(jps_hice:jps_hsnw)%nct = jpl
-         ELSE
-            IF ( jpl > 1 ) THEN
-CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' )
-            ENDIF
          ENDIF
       CASE ( 'weighted ice and snow' ) 
@@ -568,4 +689,77 @@
       !                                                      ! ------------------------- !
       ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE.
+
+      !                                                      ! ------------------------------- !
+      !                                                      !   OPA-SAS coupling - snd by opa !   
+      !                                                      ! ------------------------------- !
+      ssnd(jps_ssh   )%clname = 'O_SSHght' 
+      ssnd(jps_soce  )%clname = 'O_SSSal' 
+      ssnd(jps_e3t1st)%clname = 'O_E3T1st'   
+      ssnd(jps_fraqsr)%clname = 'O_FraQsr'
+      !
+      IF( nn_components == jp_iam_opa ) THEN
+         ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
+         ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE.
+         ssnd( jps_e3t1st )%laction = lk_vvl
+         ! vector definition: not used but cleaner...
+         ssnd(jps_ocx1)%clgrid  = 'U'        ! oce components given at U-point
+         ssnd(jps_ocy1)%clgrid  = 'V'        !           and           V-point
+         sn_snd_crt%clvgrd = 'U,V'
+         sn_snd_crt%clvor = 'local grid'
+         sn_snd_crt%clvref = 'spherical'
+         !
+         IF(lwp) THEN                        ! control print
+            WRITE(numout,*)
+            WRITE(numout,*)'  sent fields to SAS component '
+            WRITE(numout,*)'               sea surface temperature (T before, Celcius) '
+            WRITE(numout,*)'               sea surface salinity ' 
+            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates' 
+            WRITE(numout,*)'               sea surface height ' 
+            WRITE(numout,*)'               thickness of first ocean T level '        
+            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level'
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+      !                                                      ! ------------------------------- !
+      !                                                      !   OPA-SAS coupling - snd by sas !   
+      !                                                      ! ------------------------------- !
+      ssnd(jps_sflx  )%clname = 'I_SFLX'     
+      ssnd(jps_fice2 )%clname = 'IIceFrc'
+      ssnd(jps_qsroce)%clname = 'I_QsrOce'   
+      ssnd(jps_qnsoce)%clname = 'I_QnsOce'   
+      ssnd(jps_oemp  )%clname = 'IOEvaMPr' 
+      ssnd(jps_otx1  )%clname = 'I_OTaux1'   
+      ssnd(jps_oty1  )%clname = 'I_OTauy1'   
+      ssnd(jps_rnf   )%clname = 'I_Runoff'   
+      ssnd(jps_taum  )%clname = 'I_TauMod'   
+      !
+      IF( nn_components == jp_iam_sas ) THEN
+         IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
+         ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE.
+         !
+         ! Change first letter to couple with atmosphere if already coupled with sea_ice
+         ! this is nedeed as each variable name used in the namcouple must be unique:
+         ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere
+         DO jn = 1, jpsnd
+            IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
+         END DO
+         !
+         IF(lwp) THEN                        ! control print
+            WRITE(numout,*)
+            IF( .NOT. ln_cpl ) THEN
+               WRITE(numout,*)'  sent fields to OPA component '
+            ELSE
+               WRITE(numout,*)'  Additional sent fields to OPA component : '
+            ENDIF
+            WRITE(numout,*)'                  ice cover '
+            WRITE(numout,*)'                  oce only EMP  '
+            WRITE(numout,*)'                  salt flux  '
+            WRITE(numout,*)'                  mixed oce-ice solar flux  '
+            WRITE(numout,*)'                  mixed oce-ice non solar flux  '
+            WRITE(numout,*)'                  wind stress U,V components'
+            WRITE(numout,*)'                  wind stress module'
+         ENDIF
+      ENDIF
+
       !
       ! ================================ !
@@ -573,5 +767,6 @@
       ! ================================ !
 
-      CALL cpl_define(jprcv, jpsnd,nn_cplmodel)            
+      CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
+      
       IF (ln_usecplmask) THEN 
          xcplmask(:,:,:) = 0.
@@ -583,7 +778,10 @@
          xcplmask(:,:,:) = 1.
       ENDIF
-      !
-      IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) )   &
+      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 )
+      !
+      ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )
+      IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 )   &
          &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
+      ncpl_qsr_freq = 86400 / ncpl_qsr_freq
 
       CALL wrk_dealloc( jpi,jpj, zacs, zaos )
@@ -639,9 +837,10 @@
       !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt       ! ocean model time step index
-      INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation 
-      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3)
-      !!
-      LOGICAL ::    llnewtx, llnewtau      ! update wind stress components and module??
+      INTEGER, INTENT(in)           ::   kt          ! ocean model time step index
+      INTEGER, INTENT(in)           ::   k_fsbc      ! frequency of sbc (-> ice model) computation 
+      INTEGER, INTENT(in)           ::   k_ice       ! ice management in the sbc (=0/1/2/3)
+
+      !!
+      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module??
       INTEGER  ::   ji, jj, jn             ! dummy loop indices
       INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000)
@@ -651,14 +850,19 @@
       REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient
       REAL(wp) ::   zzx, zzy               ! temporary variables
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv')
       !
-      CALL wrk_alloc( jpi,jpj, ztx, zty )
-      !                                                 ! Receive all the atmos. fields (including ice information)
-      isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges
-      DO jn = 1, jprcv                                       ! received fields sent by the atmosphere
-         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) )
+      CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
+      !
+      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
+      !
+      !                                                      ! ======================================================= !
+      !                                                      ! Receive all the atmos. fields (including ice information)
+      !                                                      ! ======================================================= !
+      isec = ( kt - nit000 ) * NINT( rdttra(1) )                ! date of exchanges
+      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere
+         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
       END DO
 
@@ -720,5 +924,4 @@
          !
       ENDIF
-      
       !                                                      ! ========================= !
       !                                                      !    wind stress module     !   (taum)
@@ -749,5 +952,5 @@
          ENDIF
       ENDIF
-      
+      !
       !                                                      ! ========================= !
       !                                                      !      10 m wind speed      !   (wndm)
@@ -762,10 +965,8 @@
 !CDIR NOVERRCHK
                DO ji = 1, jpi 
-                  wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
+                  frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
                END DO
             END DO
          ENDIF
-      ELSE
-         IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
       ENDIF
 
@@ -774,7 +975,15 @@
       IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
          !
-         utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
-         vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
-         taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
+         IF( ln_mixcpl ) THEN
+            utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:)
+            vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:)
+            taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:)
+            wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:)
+         ELSE
+            utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
+            vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
+            taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
+            wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
+         ENDIF
          CALL iom_put( "taum_oce", taum )   ! output wind stress module
          !  
@@ -782,61 +991,125 @@
 
 #if defined key_cpl_carbon_cycle
-      !                                                              ! atmosph. CO2 (ppm)
+      !                                                      ! ================== !
+      !                                                      ! atmosph. CO2 (ppm) !
+      !                                                      ! ================== !
       IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
 #endif
 
+      !  Fields received by SAS when OASIS coupling
+      !  (arrays no more filled at sbcssm stage)
+      !                                                      ! ================== !
+      !                                                      !        SSS         !
+      !                                                      ! ================== !
+      IF( srcv(jpr_soce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
+         sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1)
+         CALL iom_put( 'sss_m', sss_m )
+      ENDIF
+      !                                               
+      !                                                      ! ================== !
+      !                                                      !        SST         !
+      !                                                      ! ================== !
+      IF( srcv(jpr_toce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
+         sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1)
+         IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN    ! make sure that sst_m is the potential temperature
+            sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) )
+         ENDIF
+      ENDIF
+      !                                                      ! ================== !
+      !                                                      !        SSH         !
+      !                                                      ! ================== !
+      IF( srcv(jpr_ssh )%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
+         ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1)
+         CALL iom_put( 'ssh_m', ssh_m )
+      ENDIF
+      !                                                      ! ================== !
+      !                                                      !  surface currents  !
+      !                                                      ! ================== !
+      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
+         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
+         ub (:,:,1) = ssu_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau
+         CALL iom_put( 'ssu_m', ssu_m )
+      ENDIF
+      IF( srcv(jpr_ocy1)%laction ) THEN
+         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
+         vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau
+         CALL iom_put( 'ssv_m', ssv_m )
+      ENDIF
+      !                                                      ! ======================== !
+      !                                                      !  first T level thickness !
+      !                                                      ! ======================== !
+      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling
+         e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1)
+         CALL iom_put( 'e3t_m', e3t_m(:,:) )
+      ENDIF
+      !                                                      ! ================================ !
+      !                                                      !  fraction of solar net radiation !
+      !                                                      ! ================================ !
+      IF( srcv(jpr_fraqsr)%laction ) THEN                    ! received by sas in case of opa <-> sas coupling
+         frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)
+         CALL iom_put( 'frq_m', frq_m )
+      ENDIF
+      
       !                                                      ! ========================= !
-      IF( k_ice <= 1 ) THEN                                  !  heat & freshwater fluxes ! (Ocean only case)
+      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case)
          !                                                   ! ========================= !
          !
          !                                                       ! total freshwater fluxes over the ocean (emp)
-         SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation
-         CASE( 'conservative' )
-            emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
-         CASE( 'oce only', 'oce and ice' )
-            emp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
-         CASE default
-            CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
-         END SELECT
+         IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN
+            SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation
+            CASE( 'conservative' )
+               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
+            CASE( 'oce only', 'oce and ice' )
+               zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
+            CASE default
+               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
+            END SELECT
+         ELSE
+            zemp(:,:) = 0._wp
+         ENDIF
          !
          !                                                        ! runoffs and calving (added in emp)
-         IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)
-         IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1)
-         !
-!!gm :  this seems to be internal cooking, not sure to need that in a generic interface 
-!!gm                                       at least should be optional...
-!!         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN     ! add to the total freshwater budget
-!!            ! remove negative runoff
-!!            zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
-!!            zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
-!!            IF( lk_mpp )   CALL mpp_sum( zcumulpos )   ! sum over the global domain
-!!            IF( lk_mpp )   CALL mpp_sum( zcumulneg ) 
-!!            IF( zcumulpos /= 0. ) THEN                 ! distribute negative runoff on positive runoff grid points
-!!               zcumulneg = 1.e0 + zcumulneg / zcumulpos
-!!               frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg
-!!            ENDIF     
-!!            ! add runoff to e-p 
-!!            emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)
-!!         ENDIF
-!!gm  end of internal cooking
+         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
+         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
+         
+         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
+         ELSE                   ;   emp(:,:) =                              zemp(:,:)
+         ENDIF
          !
          !                                                       ! non solar heat flux over the ocean (qns)
-         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
-         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
+         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
+         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
+         ELSE                                       ;   zqns(:,:) = 0._wp
+         END IF
          ! update qns over the free ocean with:
-         qns(:,:) =  qns(:,:) - emp(:,:) * sst_m(:,:) * rcp            ! remove heat content due to mass flux (assumed to be at SST)
-         IF( srcv(jpr_snow  )%laction )   THEN
-              qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean
+         IF( nn_components /= jp_iam_opa ) THEN
+            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST)
+            IF( srcv(jpr_snow  )%laction ) THEN
+               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean
+            ENDIF
+         ENDIF
+         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:)
+         ELSE                   ;   qns(:,:) =                              zqns(:,:)
          ENDIF
 
          !                                                       ! solar flux over the ocean          (qsr)
-         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
-         IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
-         IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle
+         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
+         ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
+         ELSE                                       ;   zqsr(:,:) = 0._wp
+         ENDIF
+         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle
+         IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:)
+         ELSE                   ;   qsr(:,:) =                              zqsr(:,:)
+         ENDIF
          !
-  
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi,jpj, ztx, zty )
+         ! salt flux over the ocean (received by opa in case of opa <-> sas coupling)
+         IF( srcv(jpr_sflx )%laction )   sfx(:,:) = frcv(jpr_sflx  )%z3(:,:,1)
+         ! Ice cover  (received by opa in case of opa <-> sas coupling)
+         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
+         !
+
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
       !
       IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv')
@@ -935,5 +1208,4 @@
             !
          ENDIF
-
          !                                                      ! ======================= !
          !                                                      !     put on ice grid     !
@@ -1057,5 +1329,5 @@
    
 
-   SUBROUTINE sbc_cpl_ice_flx( p_frld  , palbi   , psst    , pist    )
+   SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist )
       !!----------------------------------------------------------------------
       !!             ***  ROUTINE sbc_cpl_ice_flx  ***
@@ -1099,16 +1371,21 @@
       REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1]
       ! optional arguments, used only in 'mixed oce-ice' case
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! all skies ice albedo 
-      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celsius]
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin]
-      !
-      INTEGER ::   jl   ! dummy loop index
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zcptn, ztmp, zicefr
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo 
+      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin]
+      !
+      INTEGER ::   jl         ! dummy loop index
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx')
       !
-      CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr )
-
+      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
+      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )
+
+      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
       zicefr(:,:) = 1.- p_frld(:,:)
       zcptn(:,:) = rcp * sst_m(:,:)
@@ -1118,13 +1395,14 @@
       !                                                      ! ========================= !
       !
-      !                                                           ! total Precipitations - total Evaporation (emp_tot)
-      !                                                           ! solid precipitation  - sublimation       (emp_ice)
-      !                                                           ! solid Precipitation                      (sprecip)
+      !                                                           ! total Precipitation - total Evaporation (emp_tot)
+      !                                                           ! solid precipitation - sublimation       (emp_ice)
+      !                                                           ! solid Precipitation                     (sprecip)
+      !                                                           ! liquid + solid Precipitation            (tprecip)
       SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
       CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
-         sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here
-         tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here
-         emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:)
-         emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
+         zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here
+         ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here
+         zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
+         zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
             CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation 
          IF( iom_use('hflx_rain_cea') )   &
@@ -1137,8 +1415,31 @@
             CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )   ! heat flux from from evap (cell average)
       CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
-         emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
-         emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)
-         sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1)
+         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
+         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)
+         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
+         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
       END SELECT
+
+      IF( iom_use('subl_ai_cea') )   &
+         CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average)
+      !   
+      !                                                           ! runoffs and calving (put in emp_tot)
+      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
+      IF( srcv(jpr_cal)%laction ) THEN 
+         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
+         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) )
+      ENDIF
+
+      IF( ln_mixcpl ) THEN
+         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
+         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
+         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
+         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
+      ELSE
+         emp_tot(:,:) =                                  zemp_tot(:,:)
+         emp_ice(:,:) =                                  zemp_ice(:,:)
+         sprecip(:,:) =                                  zsprecip(:,:)
+         tprecip(:,:) =                                  ztprecip(:,:)
+      ENDIF
 
          CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow
@@ -1147,33 +1448,4 @@
       IF( iom_use('snow_ai_cea') )   &
          CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:)             )   ! Snow        over sea-ice         (cell average)
-      IF( iom_use('subl_ai_cea') )   &
-         CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average)
-      !   
-      !                                                           ! runoffs and calving (put in emp_tot)
-      IF( srcv(jpr_rnf)%laction ) THEN 
-         emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)
-            CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers
-         IF( iom_use('hflx_rnf_cea') )   &
-            CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers
-      ENDIF
-      IF( srcv(jpr_cal)%laction ) THEN 
-         emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
-         CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) )
-      ENDIF
-      !
-!!gm :  this seems to be internal cooking, not sure to need that in a generic interface 
-!!gm                                       at least should be optional...
-!!       ! remove negative runoff                            ! sum over the global domain
-!!       zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
-!!       zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
-!!       IF( lk_mpp )   CALL mpp_sum( zcumulpos )
-!!       IF( lk_mpp )   CALL mpp_sum( zcumulneg ) 
-!!       IF( zcumulpos /= 0. ) THEN                          ! distribute negative runoff on positive runoff grid points
-!!          zcumulneg = 1.e0 + zcumulneg / zcumulpos
-!!          frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg
-!!       ENDIF     
-!!       emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)   ! add runoff to e-p 
-!!
-!!gm  end of internal cooking
 
       !                                                      ! ========================= !
@@ -1181,44 +1453,38 @@
       !                                                      ! ========================= !
       CASE( 'oce only' )                                     ! the required field is directly provided
-         qns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1)
+         zqns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1)
       CASE( 'conservative' )                                      ! the required fields are directly provided
-         qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
+         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
          IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
-            qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
+            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
          ELSE
             ! Set all category values equal for the moment
             DO jl=1,jpl
-               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
+               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
             ENDDO
          ENDIF
       CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes
-         qns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
+         zqns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
          IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
             DO jl=1,jpl
-               qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
-               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
+               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
+               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
             ENDDO
          ELSE
+            qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
             DO jl=1,jpl
-               qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
-               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
+               zqns_tot(:,:   ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
+               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
             ENDDO
          ENDIF
       CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations
 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
-         qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
-         qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    &
+         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
+         zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    &
             &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   &
             &                                                   +          pist(:,:,1)   * zicefr(:,:) ) )
       END SELECT
-      ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus
-      qns_tot(:,:) = qns_tot(:,:)                         &            ! qns_tot update over free ocean with:
-         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting
-         &          - (  emp_tot(:,:)                     &            ! remove the heat content of mass flux (assumed to be at SST)
-         &             - emp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:) 
-      IF( iom_use('hflx_snow_cea') )   &
-         CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average)
 !!gm
-!!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in 
+!!    currently it is taken into account in leads budget but not in the zqns_tot, and thus not in 
 !!    the flux that enter the ocean....
 !!    moreover 1 - it is not diagnose anywhere.... 
@@ -1229,8 +1495,86 @@
       IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting 
          ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting 
-         qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:)
+         zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:)
          IF( iom_use('hflx_cal_cea') )   &
             CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving
       ENDIF
+
+      ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus
+      IF( iom_use('hflx_snow_cea') )    CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average)
+
+#if defined key_lim3
+      CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 
+
+      ! --- evaporation --- !
+      ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation
+      ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice
+      !                 but it is incoherent WITH the ice model  
+      DO jl=1,jpl
+         evap_ice(:,:,jl) = 0._wp  ! should be: frcv(jpr_ievp)%z3(:,:,1)
+      ENDDO
+      zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean
+
+      ! --- evaporation minus precipitation --- !
+      emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:)
+
+      ! --- non solar flux over ocean --- !
+      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax
+      zqns_oce = 0._wp
+      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)
+
+      ! --- heat flux associated with emp --- !
+      zsnw(:,:) = 0._wp
+      CALL lim_thd_snwblow( p_frld, zsnw )  ! snow distribution over ice after wind blowing
+      zqemp_oce(:,:) = -      zevap(:,:)                   * p_frld(:,:)      *   zcptn(:,:)   &      ! evap
+         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &      ! liquid precip
+         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean
+      qemp_ice(:,:)  = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap
+         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice
+
+      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
+      zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus )
+
+      ! --- total non solar flux --- !
+      zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:)
+
+      ! --- in case both coupled/forced are active, we must mix values --- ! 
+      IF( ln_mixcpl ) THEN
+         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
+         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
+         DO jl=1,jpl
+            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:)
+         ENDDO
+         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
+         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:)
+!!clem         evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0)
+      ELSE
+         qns_tot  (:,:  ) = zqns_tot  (:,:  )
+         qns_oce  (:,:  ) = zqns_oce  (:,:  )
+         qns_ice  (:,:,:) = zqns_ice  (:,:,:)
+         qprec_ice(:,:)   = zqprec_ice(:,:)
+         qemp_oce (:,:)   = zqemp_oce (:,:)
+      ENDIF
+
+      CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 
+#else
+
+      ! clem: this formulation is certainly wrong... but better than it was...
+      zqns_tot(:,:) = zqns_tot(:,:)                       &            ! zqns_tot update over free ocean with:
+         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting
+         &          - (  zemp_tot(:,:)                    &            ! remove the heat content of mass flux (assumed to be at SST)
+         &             - zemp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:) 
+
+     IF( ln_mixcpl ) THEN
+         qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
+         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:)
+         DO jl=1,jpl
+            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:)
+         ENDDO
+      ELSE
+         qns_tot(:,:  ) = zqns_tot(:,:  )
+         qns_ice(:,:,:) = zqns_ice(:,:,:)
+      ENDIF
+
+#endif
 
       !                                                      ! ========================= !
@@ -1238,44 +1582,69 @@
       !                                                      ! ========================= !
       CASE( 'oce only' )
-         qsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
+         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
       CASE( 'conservative' )
-         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
+         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
          IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
-            qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
+            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
          ELSE
             ! Set all category values equal for the moment
             DO jl=1,jpl
-               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
+               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
             ENDDO
          ENDIF
-         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
-         qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
+         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
+         zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
       CASE( 'oce and ice' )
-         qsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
+         zqsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
          IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
             DO jl=1,jpl
-               qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
-               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
+               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
+               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
             ENDDO
          ELSE
+            qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
             DO jl=1,jpl
-               qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
-               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
+               zqsr_tot(:,:   ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
+               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
             ENDDO
          ENDIF
       CASE( 'mixed oce-ice' )
-         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
+         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
 !       Create solar heat flux over ice using incoming solar heat flux and albedos
 !       ( see OASIS3 user guide, 5th edition, p39 )
-         qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   &
+         zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   &
             &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       &
             &                     + palbi         (:,:,1) * zicefr(:,:) ) )
       END SELECT
-      IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle
-         qsr_tot(:,:  ) = sbc_dcy( qsr_tot(:,:  ) )
+      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle
+         zqsr_tot(:,:  ) = sbc_dcy( zqsr_tot(:,:  ) )
          DO jl=1,jpl
-            qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) )
+            zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
          ENDDO
+      ENDIF
+
+#if defined key_lim3
+      CALL wrk_alloc( jpi,jpj, zqsr_oce ) 
+      ! --- solar flux over ocean --- !
+      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax
+      zqsr_oce = 0._wp
+      WHERE( p_frld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)
+
+      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:)
+      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF
+
+      CALL wrk_dealloc( jpi,jpj, zqsr_oce ) 
+#endif
+
+      IF( ln_mixcpl ) THEN
+         qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
+         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:)
+         DO jl=1,jpl
+            qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) +  zqsr_ice(:,:,jl)* zmsk(:,:)
+         ENDDO
+      ELSE
+         qsr_tot(:,:  ) = zqsr_tot(:,:  )
+         qsr_ice(:,:,:) = zqsr_ice(:,:,:)
       ENDIF
 
@@ -1285,13 +1654,21 @@
       CASE ('coupled')
          IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
-            dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
+            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
          ELSE
             ! Set all category values equal for the moment
             DO jl=1,jpl
-               dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
+               zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
             ENDDO
          ENDIF
       END SELECT
-
+      
+      IF( ln_mixcpl ) THEN
+         DO jl=1,jpl
+            dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
+         ENDDO
+      ELSE
+         dqns_ice(:,:,:) = zdqns_ice(:,:,:)
+      ENDIF
+      
       !                                                      ! ========================= !
       SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    !
@@ -1309,5 +1686,6 @@
       fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
 
-      CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr )
+      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
+      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )
       !
       IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx')
@@ -1329,4 +1707,5 @@
       INTEGER ::   ji, jj, jl   ! dummy loop indices
       INTEGER ::   isec, info   ! local integer
+      REAL(wp) ::   zumax, zvmax
       REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4   
@@ -1345,24 +1724,46 @@
       !                                                      ! ------------------------- !
       IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
-         SELECT CASE( sn_snd_temp%cldes)
-         CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0
-         CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)   
-            SELECT CASE( sn_snd_temp%clcat )
-            CASE( 'yes' )   
-               ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
-            CASE( 'no' )
-               ztmp3(:,:,:) = 0.0
+         
+         IF ( nn_components == jp_iam_opa ) THEN
+            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part
+         ELSE
+            ! we must send the surface potential temperature 
+            IF( ln_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
+            ELSE                    ;   ztmp1(:,:) = tsn(:,:,1,jp_tem)
+            ENDIF
+            !
+            SELECT CASE( sn_snd_temp%cldes)
+            CASE( 'oce only'             )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
+            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
+               SELECT CASE( sn_snd_temp%clcat )
+               CASE( 'yes' )   
+                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
+               CASE( 'no' )
+                  WHERE( SUM( a_i, dim=3 ) /= 0. )
+                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
+                  ELSEWHERE
+                     ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?)
+                  END WHERE
+               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
+               END SELECT
+            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)   
+               SELECT CASE( sn_snd_temp%clcat )
+               CASE( 'yes' )   
+                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+               CASE( 'no' )
+                  ztmp3(:,:,:) = 0.0
+                  DO jl=1,jpl
+                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
+                  ENDDO
+               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
+               END SELECT
+            CASE( 'mixed oce-ice'        )   
+               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 
                DO jl=1,jpl
-                  ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
+                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
                ENDDO
-            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
+            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
             END SELECT
-         CASE( 'mixed oce-ice'        )   
-            ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 
-            DO jl=1,jpl
-               ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
-            ENDDO
-         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
-         END SELECT
+         ENDIF
          IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
          IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info )
@@ -1373,5 +1774,9 @@
       !                                                      ! ------------------------- !
       IF( ssnd(jps_albice)%laction ) THEN                         ! ice 
-         ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+         SELECT CASE( sn_snd_alb%cldes )
+         CASE( 'ice'          )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
+         CASE( 'weighted ice' )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+         CASE default             ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
+         END SELECT
          CALL cpl_snd( jps_albice, isec, ztmp3, info )
       ENDIF
@@ -1386,5 +1791,5 @@
       !                                                      !  Ice fraction & Thickness ! 
       !                                                      ! ------------------------- !
-      ! Send ice fraction field 
+      ! Send ice fraction field to atmosphere
       IF( ssnd(jps_fice)%laction ) THEN
          SELECT CASE( sn_snd_thick%clcat )
@@ -1393,5 +1798,11 @@
          CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
          END SELECT
-         CALL cpl_snd( jps_fice, isec, ztmp3, info )
+         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info )
+      ENDIF
+      
+      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
+      IF( ssnd(jps_fice2)%laction ) THEN
+         ztmp3(:,:,1) = fr_i(:,:)
+         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info )
       ENDIF
 
@@ -1414,6 +1825,18 @@
             END SELECT
          CASE( 'ice and snow'         )   
-            ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
-            ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
+            SELECT CASE( sn_snd_thick%clcat )
+            CASE( 'yes' )
+               ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
+               ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
+            CASE( 'no' )
+               WHERE( SUM( a_i, dim=3 ) /= 0. )
+                  ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
+                  ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
+               ELSEWHERE
+                 ztmp3(:,:,1) = 0.
+                 ztmp4(:,:,1) = 0.
+               END WHERE
+            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
+            END SELECT
          CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
          END SELECT
@@ -1441,83 +1864,89 @@
          !                                                              i-1  i   i
          !                                                               i      i+1 (for I)
-         SELECT CASE( TRIM( sn_snd_crt%cldes ) )
-         CASE( 'oce only'             )      ! C-grid ==> T
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )
-                  zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) ) 
-               END DO
-            END DO
-         CASE( 'weighted oce and ice' )   
-            SELECT CASE ( cp_ice_msh )
-            CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
+         IF( nn_components == jp_iam_opa ) THEN
+            zotx1(:,:) = un(:,:,1)  
+            zoty1(:,:) = vn(:,:,1)  
+         ELSE        
+            SELECT CASE( TRIM( sn_snd_crt%cldes ) )
+            CASE( 'oce only'             )      ! C-grid ==> T
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)  
-                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)
-                     zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
-                     zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
+                     zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )
+                     zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) ) 
                   END DO
                END DO
-            CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
-               DO jj = 2, jpjm1
-                  DO ji = 2, jpim1   ! NO vector opt.
-                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)  
-                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)  
-                     zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
-                        &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
-                     zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
-                        &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+            CASE( 'weighted oce and ice' )   
+               SELECT CASE ( cp_ice_msh )
+               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)  
+                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)
+                        zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
+                        zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
+                     END DO
                   END DO
-               END DO
-            CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
-               DO jj = 2, jpjm1
-                  DO ji = 2, jpim1   ! NO vector opt.
-                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)  
-                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)  
-                     zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
-                        &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
-                     zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
-                        &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = 2, jpim1   ! NO vector opt.
+                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)  
+                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)  
+                        zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
+                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                        zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
+                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                     END DO
                   END DO
-               END DO
+               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = 2, jpim1   ! NO vector opt.
+                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)  
+                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)  
+                        zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
+                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                        zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
+                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               END SELECT
+               CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. )
+            CASE( 'mixed oce-ice'        )
+               SELECT CASE ( cp_ice_msh )
+               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   &
+                           &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
+                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   &
+                           &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = 2, jpim1   ! NO vector opt.
+                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
+                           &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
+                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
+                           &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
+                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = 2, jpim1   ! NO vector opt.
+                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
+                           &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
+                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
+                           &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
+                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               END SELECT
             END SELECT
-            CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. )
-         CASE( 'mixed oce-ice'        )
-            SELECT CASE ( cp_ice_msh )
-            CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   &
-                        &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
-                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   &
-                        &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
-                  END DO
-               END DO
-            CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
-               DO jj = 2, jpjm1
-                  DO ji = 2, jpim1   ! NO vector opt.
-                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
-                        &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
-                        &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
-                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
-                        &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
-                        &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
-                  END DO
-               END DO
-            CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
-               DO jj = 2, jpjm1
-                  DO ji = 2, jpim1   ! NO vector opt.
-                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
-                        &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
-                        &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
-                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
-                        &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
-                        &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
-                  END DO
-               END DO
-            END SELECT
-         END SELECT
-         CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. )
+            CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. )
+            !
+         ENDIF
          !
          !
@@ -1559,4 +1988,40 @@
       ENDIF
       !
+      !
+      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling
+      !                                                        ! SSH
+      IF( ssnd(jps_ssh )%laction )  THEN
+         !                          ! removed inverse barometer ssh when Patm
+         !                          forcing is used (for sea-ice dynamics)
+         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         ELSE                    ;   ztmp1(:,:) = sshn(:,:)
+         ENDIF
+         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info )
+
+      ENDIF
+      !                                                        ! SSS
+      IF( ssnd(jps_soce  )%laction )  THEN
+         CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
+      ENDIF
+      !                                                        ! first T level thickness 
+      IF( ssnd(jps_e3t1st )%laction )  THEN
+         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1)   , (/jpi,jpj,1/) ), info )
+      ENDIF
+      !                                                        ! Qsr fraction
+      IF( ssnd(jps_fraqsr)%laction )  THEN
+         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
+      ENDIF
+      !
+      !  Fields sent by SAS to OPA when OASIS coupling
+      !                                                        ! Solar heat flux
+      IF( ssnd(jps_qsroce)%laction )  CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_qnsoce)%laction )  CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_oemp  )%laction )  CALL cpl_snd( jps_oemp  , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_sflx  )%laction )  CALL cpl_snd( jps_sflx  , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_otx1  )%laction )  CALL cpl_snd( jps_otx1  , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_oty1  )%laction )  CALL cpl_snd( jps_oty1  , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
+
       CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
       CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 5682)
@@ -8,4 +8,5 @@
    !!            3.0  ! 2006-08  (G. Madec)  Surface module
    !!            3.2  ! 2009-07  (C. Talandier) emp mean s spread over erp area 
+   !!            3.6  ! 2014-11  (P. Mathiot  ) add ice shelf melting
    !!----------------------------------------------------------------------
 
@@ -88,6 +89,9 @@
          !
          IF( kn_fwb == 3 .AND. nn_sssr /= 2 )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' )
-         !
-         area = glob_sum( e1e2t(:,:) )           ! interior global domain surface
+         IF( kn_fwb == 3 .AND. ln_isfcav    )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 with ln_isfcav = .TRUE. not working, we stop ' )
+         !
+         area = glob_sum( e1e2t(:,:) * tmask(:,:,1))           ! interior global domain surface
+         ! isf cavities are excluded because it can feedback to the melting with generation of inhibition of plumes
+         ! and in case of no melt, it can generate HSSW.
          !
 #if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice
@@ -104,8 +108,8 @@
          !
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) -  snwice_fmass(:,:) ) ) / area   ! sum over the global domain
+            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area   ! sum over the global domain
             zcoef = z_fwf * rcp
-            emp(:,:) = emp(:,:) - z_fwf 
-            qns(:,:) = qns(:,:) + zcoef * sst_m(:,:)  ! account for change to the heat budget due to fw correction
+            emp(:,:) = emp(:,:) - z_fwf              * tmask(:,:,1)
+            qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
          ENDIF
          !
@@ -138,6 +142,6 @@
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! correct the freshwater fluxes
             zcoef = fwfold * rcp
-            emp(:,:) = emp(:,:) + fwfold
-            qns(:,:) = qns(:,:) - zcoef * sst_m(:,:)  ! account for change to the heat budget due to fw correction
+            emp(:,:) = emp(:,:) + fwfold             * tmask(:,:,1)
+            qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
          ENDIF
          !
@@ -158,5 +162,5 @@
             zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) )
             !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges) 
-            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - snwice_fmass(:,:) ) ) / area
+            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area
             !            
             IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 5682)
@@ -40,4 +40,5 @@
 # if defined key_cice4
    USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  &
+                strocnxT,strocnyT,                               & 
                 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm,     &
                 fresh_gbm,fhocn_gbm,fswthru_gbm,frzmlt,          &
@@ -48,4 +49,5 @@
 #else
    USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  &
+                strocnxT,strocnyT,                               & 
                 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai,     &
                 fresh_ai,fhocn_ai,fswthru_ai,frzmlt,          &
@@ -94,4 +96,5 @@
 #  include "domzgr_substitute.h90"
 
+   !! $Id$
 CONTAINS
 
@@ -135,5 +138,5 @@
          IF      ( ksbc == jp_flx ) THEN
             CALL cice_sbc_force(kt)
-         ELSE IF ( ksbc == jp_cpl ) THEN
+         ELSE IF ( ksbc == jp_purecpl ) THEN
             CALL sbc_cpl_ice_flx( 1.0-fr_i  )
          ENDIF
@@ -143,5 +146,5 @@
          CALL cice_sbc_out ( kt, ksbc )
 
-         IF ( ksbc == jp_cpl )  CALL cice_sbc_hadgam(kt+1)
+         IF ( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1)
 
       ENDIF                                          ! End sea-ice time step only
@@ -184,5 +187,5 @@
 
 ! Do some CICE consistency checks
-      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN
+      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
          IF ( calc_strair .OR. calc_Tsfc ) THEN
             CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' )
@@ -209,5 +212,5 @@
 
       CALL cice2nemo(aice,fr_i, 'T', 1. )
-      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN
+      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -316,5 +319,5 @@
 ! forced and coupled case 
 
-      IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN
+      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
 
          ztmpn(:,:,:)=0.0
@@ -506,5 +509,5 @@
       CALL nemo2cice(ztmp,ss_tlty,'F', -1. )
 
-      CALL wrk_dealloc( jpi,jpj, ztmp )
+      CALL wrk_dealloc( jpi,jpj, ztmp, zpice )
       CALL wrk_dealloc( jpi,jpj,ncat, ztmpn )
       !
@@ -560,7 +563,17 @@
 ! Combine wind stress and ocean-ice stress
 ! [Note that fr_iu hasn't yet been updated, so still from start of CICE timestep]
+! strocnx and strocny already weighted by ice fraction in CICE so not done here 
 
       utau(:,:)=(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:)
       vtau(:,:)=(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:)     
+ 
+! Also need ice/ocean stress on T points so that taum can be updated 
+! This interpolation is already done in CICE so best to use those values 
+      CALL cice2nemo(strocnxT,ztmp1,'T',-1.) 
+      CALL cice2nemo(strocnyT,ztmp2,'T',-1.) 
+ 
+! Update taum with modulus of ice-ocean stress 
+! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here 
+taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1**2. + ztmp2**2.) 
 
 ! Freshwater fluxes 
@@ -574,5 +587,5 @@
       ELSE IF (ksbc == jp_core) THEN
          emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)        
-      ELSE IF (ksbc == jp_cpl) THEN
+      ELSE IF (ksbc == jp_purecpl) THEN
 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 
 ! This is currently as required with the coupling fields from the UM atmosphere
@@ -610,5 +623,5 @@
       ENDIF
 ! Take into account snow melting except for fully coupled when already in qns_tot
-      IF (ksbc == jp_cpl) THEN
+      IF (ksbc == jp_purecpl) THEN
          qsr(:,:)= qsr_tot(:,:)
          qns(:,:)= qns_tot(:,:)
@@ -645,5 +658,5 @@
 
       CALL cice2nemo(aice,fr_i,'T', 1. )
-      IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN
+      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -1083,4 +1096,5 @@
    !!   Default option           Dummy module         NO CICE sea-ice model
    !!----------------------------------------------------------------------
+   !! $Id$
 CONTAINS
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 5682)
@@ -103,7 +103,8 @@
                                  ! ( d rho / dt ) / ( d rho / ds )      ( s = 34, t = -1.8 )
          
-         fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius]
+         CALL eos_fzp( sss_m(:,:), fr_i(:,:) )       ! sea surface freezing temperature [Celcius]
+         fr_i(:,:) = fr_i(:,:) * tmask(:,:,1)
 
-         IF( lk_cpl )   a_i(:,:,1) = fr_i(:,:)         
+         IF( ln_cpl )   a_i(:,:,1) = fr_i(:,:)         
 
          ! Flux and ice fraction computation
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 5682)
@@ -19,12 +19,9 @@
    !!----------------------------------------------------------------------
    !!   sbc_ice_lim  : sea-ice model time-stepping and update ocean sbc over ice-covered area
-   !!   lim_ctl       : alerts in case of ice model crash
-   !!   lim_prt_state : ice control print at a given grid point
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
-   USE par_ice         ! sea-ice parameters
    USE ice             ! LIM-3: ice variables
-   USE iceini          ! LIM-3: ice initialisation
+   USE thd_ice         ! LIM-3: thermodynamical variables
    USE dom_ice         ! LIM-3: ice domain
 
@@ -40,6 +37,6 @@
    USE limdyn          ! Ice dynamics
    USE limtrp          ! Ice transport
+   USE limhdf          ! Ice horizontal diffusion
    USE limthd          ! Ice thermodynamics
-   USE limitd_th       ! Thermodynamics on ice thickness distribution 
    USE limitd_me       ! Mechanics on ice thickness distribution
    USE limsbc          ! sea surface boundary condition
@@ -47,7 +44,11 @@
    USE limwri          ! Ice outputs
    USE limrst          ! Ice restarts
-   USE limupdate1       ! update of global variables
-   USE limupdate2       ! update of global variables
+   USE limupdate1      ! update of global variables
+   USE limupdate2      ! update of global variables
    USE limvar          ! Ice variables switch
+
+   USE limmsh          ! LIM mesh
+   USE limistate       ! LIM initial state
+   USE limthd_sal      ! LIM ice thermodynamics: salinity
 
    USE c1d             ! 1D vertical configuration
@@ -60,4 +61,5 @@
    USE prtctl          ! Print control
    USE lib_fortran     ! 
+   USE limctl
 
 #if defined key_bdy 
@@ -69,5 +71,5 @@
 
    PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90
-   PUBLIC lim_prt_state
+   PUBLIC sbc_lim_init ! routine called by sbcmod.F90
    
    !! * Substitutions
@@ -106,58 +108,87 @@
       INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE, =5 COUPLED)
       !!
-      INTEGER  ::   jl      ! dummy loop index
-      REAL(wp) ::   zcoef   ! local scalar
+      INTEGER  ::   jl                 ! dummy loop index
       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky
       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice          ! mean ice albedo (for coupled)
+      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice 
       !!----------------------------------------------------------------------
 
       IF( nn_timing == 1 )  CALL timing_start('sbc_ice_lim')
 
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition' 
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping'
-         !
-         CALL ice_init
-         !
-         IF( ln_nicep ) THEN      ! control print at a given point
-            jiindx = 15    ;   jjindx =  44
-            IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx
-         ENDIF
-      ENDIF
-
-      !                                        !----------------------!
-      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  !
-         !                                     !----------------------!
-         !                                           !  Bulk Formulae !
-         !                                           !----------------!
-         !
-         u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)                     ! mean surface ocean current at ice velocity point
-         v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)                    ! (C-grid dynamics :  U- & V-points as the ocean)
-         !
-         t_bo(:,:) = ( eos_fzp( sss_m ) +  rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) )  ! masked sea surface freezing temperature [Kelvin]
-         !                                                                                  ! (set to rt0 over land)
-         !                                           ! Ice albedo
-         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )      
-
-         CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos
-
+      !-----------------------!
+      ! --- Ice time step --- !
+      !-----------------------!
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
+
+         ! mean surface ocean current at ice velocity point (C-grid dynamics :  U- & V-points as the ocean)
+         u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)
+         v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)
+         
+         ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
+         CALL eos_fzp( sss_m(:,:) , t_bo(:,:) )
+         t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
+          
+         ! Mask sea ice surface temperature (set to rt0 over land)
+         DO jl = 1, jpl
+            t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
+         END DO     
+         !
+         !------------------------------------------------!                                           
+         ! --- Dynamical coupling with the atmosphere --- !                                           
+         !------------------------------------------------!
+         ! It provides the following fields:
+         ! utau_ice, vtau_ice : surface ice stress (U- & V-points)   [N/m2]
+         !-----------------------------------------------------------------
          SELECT CASE( kblk )
-         CASE( jp_core , jp_cpl )   ! CORE and COUPLED bulk formulations
-
-            ! albedo depends on cloud fraction because of non-linear spectral effects
-            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
-            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 
-            ! (zalb_ice) is computed within the bulk routine
-            
+         CASE( jp_clio    )   ;   CALL blk_ice_clio_tau                         ! CLIO bulk formulation            
+         CASE( jp_core    )   ;   CALL blk_ice_core_tau                         ! CORE bulk formulation
+         CASE( jp_purecpl )   ;   CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled   formulation
          END SELECT
          
-         !                                           ! Mask sea ice surface temperature
-         DO jl = 1, jpl
-            t_su(:,:,jl) = t_su(:,:,jl) +  rt0 * ( 1. - tmask(:,:,1) )
-         END DO
-     
-         ! Bulk formulae  - provides the following fields:
-         ! utau_ice, vtau_ice : surface ice stress                     (U- & V-points)   [N/m2]
+         IF( ln_mixcpl) THEN   ! Case of a mixed Bulk/Coupled formulation
+            CALL wrk_alloc( jpi,jpj    , zutau_ice, zvtau_ice)
+            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
+            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+            CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice)
+         ENDIF
+
+         !-------------------------------------------------------!
+         ! --- ice dynamics and transport (except in 1D case) ---!
+         !-------------------------------------------------------!
+         numit = numit + nn_fsbc                  ! Ice model time step
+         !                                                   
+         CALL sbc_lim_bef                         ! Store previous ice values
+         CALL sbc_lim_diag0                       ! set diag of mass, heat and salt fluxes to 0
+         CALL lim_rst_opn( kt )                   ! Open Ice restart file
+         !
+         IF( .NOT. lk_c1d ) THEN
+            !
+            CALL lim_dyn( kt )                    ! Ice dynamics    ( rheology/dynamics )   
+            !
+            CALL lim_trp( kt )                    ! Ice transport   ( Advection/diffusion )
+            !
+            IF( nn_monocat /= 2 ) CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting)
+            !
+#if defined key_bdy
+            CALL bdy_ice_lim( kt )                ! bdy ice thermo 
+            IF( ln_icectl )       CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' )
+#endif
+            !
+            CALL lim_update1( kt )                ! Corrections
+            !
+         ENDIF
+         
+         ! previous lead fraction and ice volume for flux calculations
+         CALL sbc_lim_bef                        
+         CALL lim_var_glo2eqv                     ! ht_i and ht_s for ice albedo calculation
+         CALL lim_var_agg(1)                      ! at_i for coupling (via pfrld) 
+         pfrld(:,:)   = 1._wp - at_i(:,:)
+         phicif(:,:)  = vt_i(:,:)
+         
+         !------------------------------------------------------!                                           
+         ! --- Thermodynamical coupling with the atmosphere --- !                                           
+         !------------------------------------------------------!
+         ! It provides the following fields:
          ! qsr_ice , qns_ice  : solar & non solar heat flux over ice   (T-point)         [W/m2]
          ! qla_ice            : latent heat flux over ice              (T-point)         [W/m2]
@@ -165,193 +196,282 @@
          ! tprecip , sprecip  : total & solid precipitation            (T-point)         [Kg/m2/s]
          ! fr1_i0  , fr2_i0   : 1sr & 2nd fraction of qsr penetration in ice             [%]
-         !
+         !----------------------------------------------------------------------------------------
+         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )
+         CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos
+
          SELECT CASE( kblk )
          CASE( jp_clio )                                       ! CLIO bulk formulation
-            CALL blk_ice_clio( t_su , zalb_cs    , zalb_os    , zalb_ice  ,               &
-               &                      utau_ice   , vtau_ice   , qns_ice   , qsr_ice   ,   &
-               &                      qla_ice    , dqns_ice   , dqla_ice  ,               &
-               &                      tprecip    , sprecip    ,                           &
-               &                      fr1_i0     , fr2_i0     , cp_ice_msh, jpl  )
-            !         
-            IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   &
-               &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx )
-
+            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 
+            ! (zalb_ice) is computed within the bulk routine
+            CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice )
+            IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su )
+            IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
          CASE( jp_core )                                       ! CORE bulk formulation
-            CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice   ,               &
-               &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   &
-               &                      qla_ice   , dqns_ice  , dqla_ice   ,               &
-               &                      tprecip   , sprecip   ,                            &
-               &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  )
-               !
-            IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   &
-               &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx )
-            !
-         CASE ( jp_cpl )
-            
-            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
-
-            ! MV -> seb 
-!           CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=t_su    )
-
-!           IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   &
-!              &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx )
-!           ! Latent heat flux is forced to 0 in coupled :
-!           !  it is included in qns (non-solar heat flux)
-!           qla_ice  (:,:,:) = 0._wp
-!           dqla_ice (:,:,:) = 0._wp
-            ! END MV -> seb
-            !
+            ! albedo depends on cloud fraction because of non-linear spectral effects
+            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+            CALL blk_ice_core_flx( t_su, zalb_ice )
+            IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su )
+            IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
+         CASE ( jp_purecpl )
+            ! albedo depends on cloud fraction because of non-linear spectral effects
+            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+                                 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su )
+            ! clem: evap_ice is forced to 0 in coupled mode for now 
+            !       but it needs to be changed (along with modif in limthd_dh) once heat flux from evap will be avail. from atm. models
+            evap_ice  (:,:,:) = 0._wp   ;   devap_ice (:,:,:) = 0._wp
+            IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
          END SELECT
-         
-         !                                           !----------------------!
-         !                                           ! LIM-3  time-stepping !
-         !                                           !----------------------!
-         ! 
-         numit = numit + nn_fsbc                     ! Ice model time step
-         !
-         !                                           ! Store previous ice values
-         a_i_b  (:,:,:)   = a_i  (:,:,:)     ! ice area
-         e_i_b  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy
-         v_i_b  (:,:,:)   = v_i  (:,:,:)     ! ice volume
-         v_s_b  (:,:,:)   = v_s  (:,:,:)     ! snow volume 
-         e_s_b  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy
-         smv_i_b(:,:,:)   = smv_i(:,:,:)     ! salt content
-         oa_i_b (:,:,:)   = oa_i (:,:,:)     ! areal age content
-         u_ice_b(:,:)     = u_ice(:,:)
-         v_ice_b(:,:)     = v_ice(:,:)
-
-         ! salt, heat and mass fluxes
-         sfx    (:,:) = 0._wp   ;
-         sfx_bri(:,:) = 0._wp   ; 
-         sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp
-         sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp
-         sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp
-         sfx_res(:,:) = 0._wp
-
-         wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp
-         wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp
-         wfx_bog(:,:) = 0._wp   ;   wfx_dyn(:,:) = 0._wp
-         wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp
-         wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp
-         wfx_spr(:,:) = 0._wp   ;   
-
-         hfx_in (:,:) = 0._wp   ;   hfx_out(:,:) = 0._wp
-         hfx_thd(:,:) = 0._wp   ;   
-         hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp
-         hfx_bog(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp
-         hfx_bom(:,:) = 0._wp   ;   hfx_sum(:,:) = 0._wp
-         hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp
-         hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp 
-         hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp
-
-                          CALL lim_rst_opn( kt )     ! Open Ice restart file
-         !
-         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - Beginning the time step - ' )   ! control print
-         ! ----------------------------------------------
-         ! ice dynamics and transport (except in 1D case)
-         ! ----------------------------------------------
-         IF( .NOT. lk_c1d ) THEN
-                          CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics )
-                          CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion )
-                          CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting
-         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx,-1, ' - ice dyn & trp - ' )   ! control print
-                          CALL lim_itd_me                 ! Mechanical redistribution ! (ridging/rafting)
-                          CALL lim_var_agg( 1 ) 
-#if defined key_bdy
-                          ! bdy ice thermo 
-                          CALL lim_var_glo2eqv            ! equivalent variables
-                          CALL bdy_ice_lim( kt )
-                          CALL lim_itd_me_zapsmall
-                          CALL lim_var_agg(1)
-         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermo bdy - ' )   ! control print
-#endif
-                          CALL lim_update1
-         ENDIF
-!                         !- Change old values for new values
-                          u_ice_b(:,:)     = u_ice(:,:)
-                          v_ice_b(:,:)     = v_ice(:,:)
-                          a_i_b  (:,:,:)   = a_i  (:,:,:)
-                          v_s_b  (:,:,:)   = v_s  (:,:,:)
-                          v_i_b  (:,:,:)   = v_i  (:,:,:)
-                          e_s_b  (:,:,:,:) = e_s  (:,:,:,:)
-                          e_i_b  (:,:,:,:) = e_i  (:,:,:,:)
-                          oa_i_b (:,:,:)   = oa_i (:,:,:)
-                          smv_i_b(:,:,:)   = smv_i(:,:,:)
- 
-         ! ----------------------------------------------
-         ! ice thermodynamic
-         ! ----------------------------------------------
-                          CALL lim_var_glo2eqv            ! equivalent variables
-                          CALL lim_var_agg(1)             ! aggregate ice categories
-                          ! previous lead fraction and ice volume for flux calculations
-                          pfrld(:,:)   = 1._wp - at_i(:,:)
-                          phicif(:,:)  = vt_i(:,:)
-
-                          ! MV -> seb
-                          SELECT CASE( kblk )
-                             CASE ( jp_cpl )
-                             CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su    )
-                             IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   &
-                          &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx )
-                           ! Latent heat flux is forced to 0 in coupled :
-                           !  it is included in qns (non-solar heat flux)
-                             qla_ice  (:,:,:) = 0._wp
-                             dqla_ice (:,:,:) = 0._wp
-                          END SELECT
-                          ! END MV -> seb
-                          !
-                          CALL lim_var_bv                 ! bulk brine volume (diag)
-                          CALL lim_thd( kt )              ! Ice thermodynamics 
-                          zcoef = rdt_ice /rday           !  Ice natural aging
-                          oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef
-         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' )   ! control print
-                          CALL lim_itd_th( kt )           !  Remap ice categories, lateral accretion  !
-                          CALL lim_var_agg( 1 )           ! requested by limupdate
-                          CALL lim_update2                ! Global variables update
-
-                          CALL lim_var_glo2eqv            ! equivalent variables (outputs)
-                          CALL lim_var_agg(2)             ! aggregate ice thickness categories
-         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 2, ' - Final state - ' )   ! control print
-         !
-                          CALL lim_sbc_flx( kt )     ! Update surface ocean mass, heat and salt fluxes
-         !
-         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 3, ' - Final state lim_sbc - ' )   ! control print
-         !
-         !                                           ! Diagnostics and outputs 
-         IF (ln_limdiaout) CALL lim_diahsb
-
-                          CALL lim_wri( 1  )              ! Ice outputs 
-
+         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )
+
+         !----------------------------!
+         ! --- ice thermodynamics --- !
+         !----------------------------!
+         CALL lim_thd( kt )                         ! Ice thermodynamics      
+         !
+         CALL lim_update2( kt )                     ! Corrections
+         !
+         CALL lim_sbc_flx( kt )                     ! Update surface ocean mass, heat and salt fluxes
+         !
+         IF(ln_limdiaout) CALL lim_diahsb           ! Diagnostics and outputs 
+         !
+         CALL lim_wri( 1 )                          ! Ice outputs 
+         !
          IF( kt == nit000 .AND. ln_rstart )   &
-            &             CALL iom_close( numrir )        ! clem: close input ice restart file
-         !
-         IF( lrst_ice )   CALL lim_rst_write( kt )        ! Ice restart file 
-                          CALL lim_var_glo2eqv            ! ???
-         !
-         IF( ln_nicep )   CALL lim_ctl( kt )              ! alerts in case of model crash
-         !
-         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )
-         !
-      ENDIF                                    ! End sea-ice time step only
-
-      !                                        !--------------------------!
-      !                                        !  at all ocean time step  !
-      !                                        !--------------------------!
-      !                                               
-      !                                              ! Update surface ocean stresses (only in ice-dynamic case)
-      !                                                   ! otherwise the atm.-ocean stresses are used everywhere
+            &             CALL iom_close( numrir )  ! close input ice restart file
+         !
+         IF( lrst_ice )   CALL lim_rst_write( kt )  ! Ice restart file 
+         !
+         IF( ln_icectl )  CALL lim_ctl( kt )        ! alerts in case of model crash
+         !
+      ENDIF   ! End sea-ice time step only
+
+      !-------------------------!
+      ! --- Ocean time step --- !
+      !-------------------------!
+      ! Update surface ocean stresses (only in ice-dynamic case) otherwise the atm.-ocean stresses are used everywhere
       IF( ln_limdyn )     CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents
 !!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!!
-
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('sbc_ice_lim')
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim')
       !
    END SUBROUTINE sbc_ice_lim
    
+
+   SUBROUTINE sbc_lim_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_lim_init  ***
+      !!
+      !! ** purpose :   Allocate all the dynamic arrays of the LIM-3 modules
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition' 
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping'
+      !
+                                       ! Open the reference and configuration namelist files and namelist output file 
+      CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
+      CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+      IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 )
+
+      CALL ice_run                     ! set some ice run parameters
+      !
+      !                                ! Allocate the ice arrays
+      ierr =        ice_alloc        ()      ! ice variables
+      ierr = ierr + dom_ice_alloc    ()      ! domain
+      ierr = ierr + sbc_ice_alloc    ()      ! surface forcing
+      ierr = ierr + thd_ice_alloc    ()      ! thermodynamics
+      ierr = ierr + lim_itd_me_alloc ()      ! ice thickness distribution - mechanics
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'sbc_lim_init : unable to allocate ice arrays')
+      !
+      !                                ! adequation jpk versus ice/snow layers/categories
+      IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk )   &
+         &      CALL ctl_stop( 'STOP',                          &
+         &     'sbc_lim_init: the 3rd dimension of workspace arrays is too small.',   &
+         &     'use more ocean levels or less ice/snow layers/categories.' )
+      !
+      CALL lim_itd_init                ! ice thickness distribution initialization
+      !
+      CALL lim_hdf_init                ! set ice horizontal diffusion computation parameters
+      !
+      CALL lim_thd_init                ! set ice thermodynics parameters
+      !
+      CALL lim_thd_sal_init            ! set ice salinity parameters
+      !
+      CALL lim_msh                     ! ice mesh initialization
+      !
+      CALL lim_itd_me_init             ! ice thickness distribution initialization for mecanical deformation
+      !                                ! Initial sea-ice state
+      IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst
+         numit = 0
+         numit = nit000 - 1
+         CALL lim_istate
+      ELSE                                    ! start from a restart file
+         CALL lim_rst_read
+         numit = nit000 - 1
+      ENDIF
+      CALL lim_var_agg(1)
+      CALL lim_var_glo2eqv
+      !
+      CALL lim_sbc_init                 ! ice surface boundary condition   
+      !
+      fr_i(:,:)     = at_i(:,:)         ! initialisation of sea-ice fraction
+      tn_ice(:,:,:) = t_su(:,:,:)       ! initialisation of surface temp for coupled simu
+      !
+      nstart = numit  + nn_fsbc      
+      nitrun = nitend - nit000 + 1 
+      nlast  = numit  + nitrun 
+      !
+      IF( nstock == 0 )   nstock = nlast + 1
+      !
+   END SUBROUTINE sbc_lim_init
+
+
+   SUBROUTINE ice_run
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_run ***
+      !!                 
+      !! ** Purpose :   Definition some run parameter for ice model
+      !!
+      !! ** Method  :   Read the namicerun namelist and check the parameter 
+      !!              values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicerun
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir,  &
+         &                ln_limdyn, rn_amax, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt  
+      !!-------------------------------------------------------------------
+      !                    
+      REWIND( numnam_ice_ref )              ! Namelist namicerun in reference namelist : Parameters for ice
+      READ  ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicerun in configuration namelist : Parameters for ice
+      READ  ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicerun )
+      !
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice'
+         WRITE(numout,*) ' ~~~~~~'
+         WRITE(numout,*) '   number of ice  categories                               = ', jpl
+         WRITE(numout,*) '   number of ice  layers                                   = ', nlay_i
+         WRITE(numout,*) '   number of snow layers                                   = ', nlay_s
+         WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn
+         WRITE(numout,*) '   maximum ice concentration                               = ', rn_amax 
+         WRITE(numout,*) '   Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb
+         WRITE(numout,*) '   Output   heat/salt budget or not          ln_limdiaout  = ', ln_limdiaout
+         WRITE(numout,*) '   control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_icectl
+         WRITE(numout,*) '   i-index for control prints (ln_icectl=true)             = ', iiceprt
+         WRITE(numout,*) '   j-index for control prints (ln_icectl=true)             = ', jiceprt
+      ENDIF
+      !
+      ! sea-ice timestep and inverse
+      rdt_ice   = nn_fsbc * rdttra(1)  
+      r1_rdtice = 1._wp / rdt_ice 
+
+      ! inverse of nlay_i and nlay_s
+      r1_nlay_i = 1._wp / REAL( nlay_i, wp )
+      r1_nlay_s = 1._wp / REAL( nlay_s, wp )
+      !
+#if defined key_bdy
+      IF( lwp .AND. ln_limdiahsb )  CALL ctl_warn('online conservation check activated but it does not work with BDY')
+#endif
+      !
+   END SUBROUTINE ice_run
+
+
+   SUBROUTINE lim_itd_init
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_init ***
+      !!
+      !! ** Purpose :   Initializes the ice thickness distribution
+      !! ** Method  :   ...
+      !! ** input   :   Namelist namiceitd
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namiceitd/ nn_catbnd, rn_himean
+      !
+      INTEGER  ::   jl                   ! dummy loop index
+      REAL(wp) ::   zc1, zc2, zc3, zx1   ! local scalars
+      REAL(wp) ::   zhmax, znum, zden, zalpha !
+      !!------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namiceitd in reference namelist : Parameters for ice
+      READ  ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namiceitd in configuration namelist : Parameters for ice
+      READ  ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namiceitd )
+      !
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_itd : ice cat distribution'
+         WRITE(numout,*) ' ~~~~~~'
+         WRITE(numout,*) '   shape of ice categories distribution                          nn_catbnd = ', nn_catbnd
+         WRITE(numout,*) '   mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean
+      ENDIF
+
+      !----------------------------------
+      !- Thickness categories boundaries 
+      !----------------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+
+      hi_max(:) = 0._wp
+
+      SELECT CASE ( nn_catbnd  )       
+                                   !----------------------
+         CASE (1)                  ! tanh function (CICE)
+                                   !----------------------
+         zc1 =  3._wp / REAL( jpl, wp )
+         zc2 = 10._wp * zc1
+         zc3 =  3._wp
+
+         DO jl = 1, jpl
+            zx1 = REAL( jl-1, wp ) / REAL( jpl, wp )
+            hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) )
+         END DO
+
+                                   !----------------------
+         CASE (2)                  ! h^(-alpha) function
+                                   !----------------------
+         zalpha = 0.05             ! exponent of the transform function
+
+         zhmax  = 3.*rn_himean
+
+         DO jl = 1, jpl 
+            znum = jpl * ( zhmax+1 )**zalpha
+            zden = ( jpl - jl ) * ( zhmax+1 )**zalpha + jl
+            hi_max(jl) = ( znum / zden )**(1./zalpha) - 1
+         END DO
+
+      END SELECT
+
+      DO jl = 1, jpl
+         hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp
+      END DO
+
+      ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl)
+      hi_max(jpl) = 99._wp
+
+      IF(lwp) WRITE(numout,*) ' Thickness category boundaries '
+      IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl)
+      !
+   END SUBROUTINE lim_itd_init
+
    
-      SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice,   &
-         &                          pdqn_ice, pqla_ice, pdql_ice, k_limflx )
+   SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx )
       !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE sbc_ice_lim  ***
+      !!                  ***  ROUTINE ice_lim_flx  ***
       !!                   
       !! ** Purpose :   update the ice surface boundary condition by averaging and / or
@@ -369,6 +489,6 @@
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqsr_ice   ! net solar flux
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdqn_ice   ! non solar flux sensitivity
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqla_ice   ! latent heat flux
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdql_ice   ! latent heat flux sensitivity
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pevap_ice  ! sublimation
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdevap_ice ! sublimation sensitivity
       !
       INTEGER  ::   jl      ! dummy loop index
@@ -379,7 +499,7 @@
       REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m   ! Mean solar heat flux over all categories
       REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m   ! Mean non solar heat flux over all categories
-      REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_m   ! Mean latent heat flux over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m  ! Mean sublimation over all categories
       REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m   ! Mean d(qns)/dT over all categories
-      REAL(wp), POINTER, DIMENSION(:,:) :: z_dql_m   ! Mean d(qla)/dT over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories
       !!----------------------------------------------------------------------
 
@@ -389,23 +509,23 @@
       SELECT CASE( k_limflx )                              !==  averaged on all ice categories  ==!
       CASE( 0 , 1 )
-         CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m)
-         !
-         z_qns_m(:,:) = fice_ice_ave ( pqns_ice (:,:,:) )
-         z_qsr_m(:,:) = fice_ice_ave ( pqsr_ice (:,:,:) )
-         z_dqn_m(:,:) = fice_ice_ave ( pdqn_ice (:,:,:) )
-         z_qla_m(:,:) = fice_ice_ave ( pqla_ice (:,:,:) )
-         z_dql_m(:,:) = fice_ice_ave ( pdql_ice (:,:,:) )
+         CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m)
+         !
+         z_qns_m  (:,:) = fice_ice_ave ( pqns_ice (:,:,:) )
+         z_qsr_m  (:,:) = fice_ice_ave ( pqsr_ice (:,:,:) )
+         z_dqn_m  (:,:) = fice_ice_ave ( pdqn_ice (:,:,:) )
+         z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) )
+         z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) )
          DO jl = 1, jpl
-            pdqn_ice(:,:,jl) = z_dqn_m(:,:)
-            pdql_ice(:,:,jl) = z_dql_m(:,:)
+            pdqn_ice  (:,:,jl) = z_dqn_m(:,:)
+            pdevap_ice(:,:,jl) = z_devap_m(:,:)
          END DO
          !
          DO jl = 1, jpl
-            pqns_ice(:,:,jl) = z_qns_m(:,:)
-            pqsr_ice(:,:,jl) = z_qsr_m(:,:)
-            pqla_ice(:,:,jl) = z_qla_m(:,:)
+            pqns_ice (:,:,jl) = z_qns_m(:,:)
+            pqsr_ice (:,:,jl) = z_qsr_m(:,:)
+            pevap_ice(:,:,jl) = z_evap_m(:,:)
          END DO
          !
-         CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m)
+         CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m)
       END SELECT
 
@@ -417,7 +537,7 @@
          ztem_m(:,:) = fice_ice_ave ( ptn_ice  (:,:,:) ) 
          DO jl = 1, jpl
-            pqns_ice(:,:,jl) = pqns_ice(:,:,jl) + pdqn_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:))
-            pqla_ice(:,:,jl) = pqla_ice(:,:,jl) + pdql_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:))
-            pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 
+            pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice  (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) )
+            pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) )
+            pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 
          END DO
          !
@@ -428,418 +548,61 @@
       !
    END SUBROUTINE ice_lim_flx
-   
-   
-   SUBROUTINE lim_ctl( kt )
-      !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_ctl *** 
-      !!                 
-      !! ** Purpose :   Alerts in case of model crash
-      !!-------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt      ! ocean time step
-      INTEGER  ::   ji, jj, jk,  jl   ! dummy loop indices
-      INTEGER  ::   inb_altests       ! number of alert tests (max 20)
-      INTEGER  ::   ialert_id         ! number of the current alert
-      REAL(wp) ::   ztmelts           ! ice layer melting point
-      CHARACTER (len=30), DIMENSION(20)      ::   cl_alname   ! name of alert
-      INTEGER           , DIMENSION(20)      ::   inb_alp     ! number of alerts positive
-      !!-------------------------------------------------------------------
-
-      inb_altests = 10
-      inb_alp(:)  =  0
-
-      ! Alert if incompatible volume and concentration
-      ialert_id = 2 ! reference number of this alert
-      cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert
-
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN
-                  !WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration '
-                  !WRITE(numout,*) ' at_i     ', at_i(ji,jj)
-                  !WRITE(numout,*) ' Point - category', ji, jj, jl
-                  !WRITE(numout,*) ' a_i *** a_i_b   ', a_i      (ji,jj,jl), a_i_b  (ji,jj,jl)
-                  !WRITE(numout,*) ' v_i *** v_i_b   ', v_i      (ji,jj,jl), v_i_b  (ji,jj,jl)
-                  !WRITE(numout,*) ' d_a_i_thd/trp   ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl)
-                  !WRITE(numout,*) ' d_v_i_thd/trp   ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl)
-                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      ! Alerte if very thick ice
-      ialert_id = 3 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert
-      jl = jpl 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF(   ht_i(ji,jj,jl)  >  50._wp   ) THEN
-               !CALL lim_prt_state( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' )
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
-
-      ! Alert if very fast ice
-      ialert_id = 4 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very fast ice               ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5  .AND.  &
-               &  at_i(ji,jj) > 0._wp   ) THEN
-               !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' )
-               !WRITE(numout,*) ' ice strength             : ', strength(ji,jj)
-               !WRITE(numout,*) ' oceanic stress utau      : ', utau(ji,jj) 
-               !WRITE(numout,*) ' oceanic stress vtau      : ', vtau(ji,jj)
-               !WRITE(numout,*) ' sea-ice stress utau_ice  : ', utau_ice(ji,jj) 
-               !WRITE(numout,*) ' sea-ice stress vtau_ice  : ', vtau_ice(ji,jj)
-               !WRITE(numout,*) ' oceanic speed u          : ', u_oce(ji,jj)
-               !WRITE(numout,*) ' oceanic speed v          : ', v_oce(ji,jj)
-               !WRITE(numout,*) ' sst                      : ', sst_m(ji,jj)
-               !WRITE(numout,*) ' sss                      : ', sss_m(ji,jj)
-               !WRITE(numout,*) 
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
-
-      ! Alert if there is ice on continents
-      ialert_id = 6 ! reference number of this alert
-      cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF(   tms(ji,jj) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN 
-               !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' )
-               !WRITE(numout,*) ' masks s, u, v        : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj) 
-               !WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
-               !WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
-               !WRITE(numout,*) ' at_i(ji,jj)          : ', at_i(ji,jj)
-               !WRITE(numout,*) ' v_ice(ji,jj)         : ', v_ice(ji,jj)
-               !WRITE(numout,*) ' v_ice(ji,jj-1)       : ', v_ice(ji,jj-1)
-               !WRITE(numout,*) ' u_ice(ji-1,jj)       : ', u_ice(ji-1,jj)
-               !WRITE(numout,*) ' u_ice(ji,jj)         : ', v_ice(ji,jj)
-               !
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
-
-!
-!     ! Alert if very fresh ice
-      ialert_id = 7 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( sm_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN
-!                 CALL lim_prt_state(kt,ji,jj,1, ' ALERTE 7 :   Very fresh ice ' )
-!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
-!                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
-!                 WRITE(numout,*) 
-                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               ENDIF
-            END DO
-         END DO
-      END DO
-!
-
-!     ! Alert if too old ice
-      ialert_id = 9 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very old   ice               ' ! name of the alert
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. &
-                      ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. &
-                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN
-                  !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ')
-                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               ENDIF
-            END DO
-         END DO
-      END DO
- 
-      ! Alert on salt flux
-      ialert_id = 5 ! reference number of this alert
-      cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ABS( sfx (ji,jj) ) .GT. 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth
-               !CALL lim_prt_state( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' )
-               !DO jl = 1, jpl
-                  !WRITE(numout,*) ' Category no: ', jl
-                  !WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' a_i_b      : ', a_i_b  (ji,jj,jl)   
-                  !WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd  : ', d_a_i_thd(ji,jj,jl) 
-                  !WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' v_i_b      : ', v_i_b  (ji,jj,jl)   
-                  !WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl) 
-                  !WRITE(numout,*) ' '
-               !END DO
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-            ENDIF
-         END DO
-      END DO
-
-      ! Alert if qns very big
-      ialert_id = 8 ! reference number of this alert
-      cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN
-               !
-               !WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux'
-               !WRITE(numout,*) ' ji, jj    : ', ji, jj
-               !WRITE(numout,*) ' qns       : ', qns(ji,jj)
-               !WRITE(numout,*) ' sst       : ', sst_m(ji,jj)
-               !WRITE(numout,*) ' sss       : ', sss_m(ji,jj)
-               !
-               !CALL lim_prt_state( kt, ji, jj, 2, '   ')
-               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-               !
-            ENDIF
-         END DO
-      END DO
-      !+++++
- 
-      ! Alert if very warm ice
-      ialert_id = 10 ! reference number of this alert
-      cl_alname(ialert_id) = ' Very warm ice                ' ! name of the alert
-      inb_alp(ialert_id) = 0
-      DO jl = 1, jpl
-         DO jk = 1, nlay_i
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ztmelts    =  -tmut * s_i(ji,jj,jk,jl) + rtt
-                  IF( t_i(ji,jj,jk,jl) >= ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   &
-                     &                             .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN
-                     !WRITE(numout,*) ' ALERTE 10 :   Very warm ice'
-                     !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl
-                     !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl)
-                     !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl)
-                     !WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl)
-                     !WRITE(numout,*) ' ztmelts : ', ztmelts
-                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      END DO
-
-      ! sum of the alerts on all processors
-      IF( lk_mpp ) THEN
-         DO ialert_id = 1, inb_altests
-            CALL mpp_sum(inb_alp(ialert_id))
-         END DO
-      ENDIF
-
-      ! print alerts
-      IF( lwp ) THEN
-         ialert_id = 1                                 ! reference number of this alert
-         cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert
-         WRITE(numout,*) ' time step ',kt
-         WRITE(numout,*) ' All alerts at the end of ice model '
-         DO ialert_id = 1, inb_altests
-            WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! '
-         END DO
-      ENDIF
-     !
-   END SUBROUTINE lim_ctl
- 
-   
-   SUBROUTINE lim_prt_state( kt, ki, kj, kn, cd1 )
-      !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_prt_state *** 
-      !!                 
-      !! ** Purpose :   Writes global ice state on the (i,j) point 
-      !!                in ocean.ouput 
-      !!                3 possibilities exist 
-      !!                n = 1/-1 -> simple ice state (plus Mechanical Check if -1)
-      !!                n = 2    -> exhaustive state
-      !!                n = 3    -> ice/ocean salt fluxes
-      !!
-      !! ** input   :   point coordinates (i,j) 
-      !!                n : number of the option
-      !!-------------------------------------------------------------------
-      INTEGER         , INTENT(in) ::   kt            ! ocean time step
-      INTEGER         , INTENT(in) ::   ki, kj, kn    ! ocean gridpoint indices
-      CHARACTER(len=*), INTENT(in) ::   cd1           !
-      !!
-      INTEGER :: jl, ji, jj
-      !!-------------------------------------------------------------------
-
-      DO ji = mi0(ki), mi1(ki)
-         DO jj = mj0(kj), mj1(kj)
-
-            WRITE(numout,*) ' time step ',kt,' ',cd1             ! print title
-
-            !----------------
-            !  Simple state
-            !----------------
-            
-            IF ( kn == 1 .OR. kn == -1 ) THEN
-               WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj
-               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' Simple state '
-               WRITE(numout,*) ' masks s,u,v   : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj)
-               WRITE(numout,*) ' lat - long    : ', gphit(ji,jj), glamt(ji,jj)
-               WRITE(numout,*) ' Time step     : ', numit
-               WRITE(numout,*) ' - Ice drift   '
-               WRITE(numout,*) '   ~~~~~~~~~~~ '
-               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
-               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
-               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
-               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
-               WRITE(numout,*) ' strength      : ', strength(ji,jj)
-               WRITE(numout,*)
-               WRITE(numout,*) ' - Cell values '
-               WRITE(numout,*) '   ~~~~~~~~~~~ '
-               WRITE(numout,*) ' cell area     : ', area(ji,jj)
-               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
-               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
-               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
-               DO jl = 1, jpl
-                  WRITE(numout,*) ' - Category (', jl,')'
-                  WRITE(numout,*) ' a_i           : ', a_i(ji,jj,jl)
-                  WRITE(numout,*) ' ht_i          : ', ht_i(ji,jj,jl)
-                  WRITE(numout,*) ' ht_s          : ', ht_s(ji,jj,jl)
-                  WRITE(numout,*) ' v_i           : ', v_i(ji,jj,jl)
-                  WRITE(numout,*) ' v_s           : ', v_s(ji,jj,jl)
-                  WRITE(numout,*) ' e_s           : ', e_s(ji,jj,1,jl)/1.0e9
-                  WRITE(numout,*) ' e_i           : ', e_i(ji,jj,1:nlay_i,jl)/1.0e9
-                  WRITE(numout,*) ' t_su          : ', t_su(ji,jj,jl)
-                  WRITE(numout,*) ' t_snow        : ', t_s(ji,jj,1,jl)
-                  WRITE(numout,*) ' t_i           : ', t_i(ji,jj,1:nlay_i,jl)
-                  WRITE(numout,*) ' sm_i          : ', sm_i(ji,jj,jl)
-                  WRITE(numout,*) ' smv_i         : ', smv_i(ji,jj,jl)
-                  WRITE(numout,*)
-               END DO
-            ENDIF
-            IF( kn == -1 ) THEN
-               WRITE(numout,*) ' Mechanical Check ************** '
-               WRITE(numout,*) ' Check what means ice divergence '
-               WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj)
-               WRITE(numout,*) ' Total lead fraction     ', ato_i(ji,jj)
-               WRITE(numout,*) ' Sum of both             ', ato_i(ji,jj) + at_i(ji,jj)
-               WRITE(numout,*) ' Sum of both minus 1     ', ato_i(ji,jj) + at_i(ji,jj) - 1.00
-            ENDIF
-            
-
-            !--------------------
-            !  Exhaustive state
-            !--------------------
-            
-            IF ( kn .EQ. 2 ) THEN
-               WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj
-               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' Exhaustive state '
-               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
-               WRITE(numout,*) ' Time step ', numit
-               WRITE(numout,*) 
-               WRITE(numout,*) ' - Cell values '
-               WRITE(numout,*) '   ~~~~~~~~~~~ '
-               WRITE(numout,*) ' cell area     : ', area(ji,jj)
-               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
-               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
-               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
-               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
-               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
-               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
-               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
-               WRITE(numout,*) ' strength      : ', strength(ji,jj)
-               WRITE(numout,*) ' d_u_ice_dyn   : ', d_u_ice_dyn(ji,jj), ' d_v_ice_dyn   : ', d_v_ice_dyn(ji,jj)
-               WRITE(numout,*) ' u_ice_b       : ', u_ice_b(ji,jj)    , ' v_ice_b       : ', v_ice_b(ji,jj)  
-               WRITE(numout,*)
-               
-               DO jl = 1, jpl
-                  WRITE(numout,*) ' - Category (',jl,')'
-                  WRITE(numout,*) '   ~~~~~~~~         ' 
-                  WRITE(numout,*) ' ht_i       : ', ht_i(ji,jj,jl)             , ' ht_s       : ', ht_s(ji,jj,jl)
-                  WRITE(numout,*) ' t_i        : ', t_i(ji,jj,1:nlay_i,jl)
-                  WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)             , ' t_s        : ', t_s(ji,jj,1,jl)
-                  WRITE(numout,*) ' sm_i       : ', sm_i(ji,jj,jl)             , ' o_i        : ', o_i(ji,jj,jl)
-                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl)   
-                  WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ji,jj,jl)        , ' d_a_i_thd  : ', d_a_i_thd(ji,jj,jl) 
-                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl)   
-                  WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl)        , ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl) 
-                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl)  
-                  WRITE(numout,*) ' d_v_s_trp  : ', d_v_s_trp(ji,jj,jl)        , ' d_v_s_thd  : ', d_v_s_thd(ji,jj,jl)
-                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9      , ' ei1        : ', e_i_b(ji,jj,1,jl)/1.0e9 
-                  WRITE(numout,*) ' de_i1_trp  : ', d_e_i_trp(ji,jj,1,jl)/1.0e9, ' de_i1_thd  : ', d_e_i_thd(ji,jj,1,jl)/1.0e9
-                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9      , ' ei2_b      : ', e_i_b(ji,jj,2,jl)/1.0e9  
-                  WRITE(numout,*) ' de_i2_trp  : ', d_e_i_trp(ji,jj,2,jl)/1.0e9, ' de_i2_thd  : ', d_e_i_thd(ji,jj,2,jl)/1.0e9
-                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl) 
-                  WRITE(numout,*) ' d_e_s_trp  : ', d_e_s_trp(ji,jj,1,jl)      , ' d_e_s_thd  : ', d_e_s_thd(ji,jj,1,jl)
-                  WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)            , ' smv_i_b    : ', smv_i_b(ji,jj,jl)   
-                  WRITE(numout,*) ' d_smv_i_trp: ', d_smv_i_trp(ji,jj,jl)      , ' d_smv_i_thd: ', d_smv_i_thd(ji,jj,jl) 
-                  WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl)
-                  WRITE(numout,*) ' d_oa_i_trp : ', d_oa_i_trp(ji,jj,jl)       , ' d_oa_i_thd : ', d_oa_i_thd(ji,jj,jl)
-               END DO !jl
-               
-               WRITE(numout,*)
-               WRITE(numout,*) ' - Heat / FW fluxes '
-               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' - Heat fluxes in and out the ice ***'
-               WRITE(numout,*) ' qsr_ini       : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) )
-               WRITE(numout,*) ' qns_ini       : ', pfrld(ji,jj) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) )
-               WRITE(numout,*)
-               WRITE(numout,*) 
-               WRITE(numout,*) ' sst        : ', sst_m(ji,jj)  
-               WRITE(numout,*) ' sss        : ', sss_m(ji,jj)  
-               WRITE(numout,*) 
-               WRITE(numout,*) ' - Stresses '
-               WRITE(numout,*) '   ~~~~~~~~ '
-               WRITE(numout,*) ' utau_ice   : ', utau_ice(ji,jj) 
-               WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ji,jj)
-               WRITE(numout,*) ' utau       : ', utau    (ji,jj) 
-               WRITE(numout,*) ' vtau       : ', vtau    (ji,jj)
-               WRITE(numout,*) ' oc. vel. u : ', u_oce   (ji,jj)
-               WRITE(numout,*) ' oc. vel. v : ', v_oce   (ji,jj)
-            ENDIF
-            
-            !---------------------
-            ! Salt / heat fluxes
-            !---------------------
-            
-            IF ( kn .EQ. 3 ) THEN
-               WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj
-               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' - Salt / Heat Fluxes '
-               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
-               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
-               WRITE(numout,*) ' Time step ', numit
-               WRITE(numout,*)
-               WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
-               WRITE(numout,*) ' qsr       : ', qsr(ji,jj)
-               WRITE(numout,*) ' qns       : ', qns(ji,jj)
-               WRITE(numout,*)
-               WRITE(numout,*) ' hfx_mass     : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj)
-               WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj)
-               WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj)
-               WRITE(numout,*) ' dhc          : ', diag_heat_dhc(ji,jj)              
-               WRITE(numout,*)
-               WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj)
-               WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj)
-               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj)
-               WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj) 
-               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice
-               WRITE(numout,*)
-               WRITE(numout,*) ' - Salt fluxes at bottom interface ***'
-               WRITE(numout,*) ' emp       : ', emp    (ji,jj)
-               WRITE(numout,*) ' sfx       : ', sfx    (ji,jj)
-               WRITE(numout,*) ' sfx_res   : ', sfx_res(ji,jj)
-               WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj)
-               WRITE(numout,*) ' sfx_dyn   : ', sfx_dyn(ji,jj)
-               WRITE(numout,*)
-               WRITE(numout,*) ' - Momentum fluxes '
-               WRITE(numout,*) ' utau      : ', utau(ji,jj) 
-               WRITE(numout,*) ' vtau      : ', vtau(ji,jj)
-            ENDIF 
-            WRITE(numout,*) ' '
-            !
-         END DO
-      END DO
-      !
-   END SUBROUTINE lim_prt_state
-   
+
+   SUBROUTINE sbc_lim_bef
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_lim_bef  ***
+      !!
+      !! ** purpose :  store ice variables at "before" time step 
+      !!----------------------------------------------------------------------
+      a_i_b  (:,:,:)   = a_i  (:,:,:)     ! ice area
+      e_i_b  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy
+      v_i_b  (:,:,:)   = v_i  (:,:,:)     ! ice volume
+      v_s_b  (:,:,:)   = v_s  (:,:,:)     ! snow volume 
+      e_s_b  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy
+      smv_i_b(:,:,:)   = smv_i(:,:,:)     ! salt content
+      oa_i_b (:,:,:)   = oa_i (:,:,:)     ! areal age content
+      u_ice_b(:,:)     = u_ice(:,:)
+      v_ice_b(:,:)     = v_ice(:,:)
+      
+   END SUBROUTINE sbc_lim_bef
+
+   SUBROUTINE sbc_lim_diag0
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_lim_diag0  ***
+      !!
+      !! ** purpose :  set ice-ocean and ice-atm. fluxes to zeros at the beggining
+      !!               of the time step
+      !!----------------------------------------------------------------------
+      sfx    (:,:) = 0._wp   ;
+      sfx_bri(:,:) = 0._wp   ; 
+      sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp
+      sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp
+      sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp
+      sfx_res(:,:) = 0._wp
+      
+      wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp
+      wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp
+      wfx_bog(:,:) = 0._wp   ;   wfx_dyn(:,:) = 0._wp
+      wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp
+      wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp
+      wfx_spr(:,:) = 0._wp   ;   
+      
+      hfx_thd(:,:) = 0._wp   ;   
+      hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp
+      hfx_bog(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp
+      hfx_bom(:,:) = 0._wp   ;   hfx_sum(:,:) = 0._wp
+      hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp
+      hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp 
+      hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp
+      hfx_err_dif(:,:) = 0._wp   ;
+
+      afx_tot(:,:) = 0._wp   ;
+      afx_dyn(:,:) = 0._wp   ;   afx_thd(:,:) = 0._wp
+
+      diag_heat(:,:) = 0._wp ;   diag_smvi(:,:) = 0._wp ;
+      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp ;
+      
+   END SUBROUTINE sbc_lim_diag0
+
      
    FUNCTION fice_cell_ave ( ptab )
@@ -852,8 +615,6 @@
       
       fice_cell_ave (:,:) = 0.0_wp
-      
       DO jl = 1, jpl
-         fice_cell_ave (:,:) = fice_cell_ave (:,:) &
-            &                  + a_i (:,:,jl) * ptab (:,:,jl)
+         fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl)
       END DO
       
@@ -869,5 +630,5 @@
 
       fice_ice_ave (:,:) = 0.0_wp
-      WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)
+      WHERE ( at_i (:,:) > 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)
 
    END FUNCTION fice_ice_ave
@@ -882,4 +643,6 @@
       WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk
    END SUBROUTINE sbc_ice_lim
+   SUBROUTINE sbc_lim_init                 ! Dummy routine
+   END SUBROUTINE sbc_lim_init
 #endif
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 5682)
@@ -101,7 +101,6 @@
       REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice  ! mean ice albedo
       REAL(wp), DIMENSION(:,:,:), POINTER :: zsist     ! ice surface temperature (K)
+      REAL(wp), DIMENSION(:,:  ), POINTER :: zutau_ice, zvtau_ice 
       !!----------------------------------------------------------------------
-
-      CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
 
       IF( kt == nit000 ) THEN
@@ -124,4 +123,8 @@
          &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1
 # endif
+
+         CALL wrk_alloc( jpi,jpj  , zutau_ice, zvtau_ice)
+         CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
+
          !  Bulk Formulea !
          !----------------!
@@ -132,7 +135,7 @@
                DO ji = 2, jpi   ! NO vector opt. possible
                   u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) * umask(ji-1,jj  ,1) &
-                     &           + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)
+                     &                    + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)
                   v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) * vmask(ji  ,jj-1,1) &
-                     &           + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)
+                     &                    + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)
                END DO
             END DO
@@ -147,5 +150,6 @@
 
          ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
-         tfu(:,:) = eos_fzp( sss_m ) +  rt0 
+         CALL eos_fzp( sss_m(:,:), tfu(:,:) )
+         tfu(:,:) = tfu(:,:) + rt0
 
          zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) )
@@ -158,5 +162,5 @@
 
          SELECT CASE( ksbc )
-         CASE( jp_core , jp_cpl )   ! CORE and COUPLED bulk formulations
+         CASE( jp_core , jp_purecpl )   ! CORE and COUPLED bulk formulations
 
             ! albedo depends on cloud fraction because of non-linear spectral effects
@@ -182,21 +186,25 @@
          SELECT CASE( ksbc )
          CASE( jp_clio )           ! CLIO bulk formulation
-            CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            &
-               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   &
-               &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
-               &                      tprecip    , sprecip    ,                         &
-               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
+!           CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            &
+!              &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   &
+!              &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
+!              &                      tprecip    , sprecip    ,                         &
+!              &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
+            CALL blk_ice_clio_tau
+            CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice )
 
          CASE( jp_core )           ! CORE bulk formulation
-            CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice   ,            &
-               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   &
-               &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
-               &                      tprecip    , sprecip    ,                         &
-               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
-            IF( ltrcdm2dc_ice )   CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl )
-
-         CASE( jp_cpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
+            CALL blk_ice_core_tau
+            CALL blk_ice_core_flx( zsist, zalb_ice )
+
+         CASE( jp_purecpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
             CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
          END SELECT
+         
+         IF( ln_mixcpl) THEN
+            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
+            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+         ENDIF
 
          CALL iom_put( 'utau_ice', utau_ice )     ! Wind stress over ice along i-axis at I-point
@@ -228,16 +236,13 @@
          END IF
          !                                             ! Ice surface fluxes in coupled mode 
-         IF( ksbc == jp_cpl )   THEN
+         IF( ln_cpl ) THEN   ! pure coupled and mixed forced-coupled configurations
             a_i(:,:,1)=fr_i
             CALL sbc_cpl_ice_flx( frld,                                              &
             !                                optional arguments, used only in 'mixed oce-ice' case
-            &                                             palbi = zalb_ice, psst = sst_m, pist = zsist )
+            &                                             palbi=zalb_ice, psst=sst_m, pist=zsist )
             sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.)
          ENDIF
                            CALL lim_thd_2      ( kt )      ! Ice thermodynamics 
                            CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes 
-#if defined key_top
-        IF( ltrcdm2dc_ice )CALL lim_bio_meanqsr_2
-#endif
 
          IF(  .NOT. lk_mpp )THEN
@@ -253,4 +258,7 @@
          IF( .NOT. Agrif_Root() )   CALL agrif_update_lim2( kt )
 # endif
+         !
+         CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice)
+         CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
          !
       ENDIF                                    ! End sea-ice time step only
@@ -264,6 +272,4 @@
       IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents
       !
-      CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
-      !
    END SUBROUTINE sbc_ice_lim_2
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 5682)
@@ -7,5 +7,5 @@
    !! History :  3.2   !  2011-02  (C.Harris  ) Original code isf cav
    !!            X.X   !  2006-02  (C. Wang   ) Original code bg03
-   !!            3.4   !  2013-03  (P. Mathiot) Merging
+   !!            3.4   !  2013-03  (P. Mathiot) Merging + parametrization
    !!----------------------------------------------------------------------
 
@@ -37,6 +37,5 @@
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   risf_tsc_b, risf_tsc   
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fwfisf_b, fwfisf  !: evaporation damping   [kg/m2/s]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qisf            !: net heat flux from ice shelf
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qisf              !: net heat flux from ice shelf
    REAL(wp), PUBLIC ::   rn_hisf_tbl                 !: thickness of top boundary layer [m]
    LOGICAL , PUBLIC ::   ln_divisf                   !: flag to correct divergence 
@@ -54,12 +53,5 @@
    REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  risfLeff               !:effective length (Leff) BG03 nn_isf==2
    REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point
-#if defined key_agrif
-   ! AGRIF can not handle these arrays as integers. The reason is a mystery but problems avoided by declaring them as reals
-   REAL(wp),    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base
-                                                                                          !: (first wet level and last level include in the tbl)
-#else
    INTEGER,    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base
-#endif
-
 
    REAL(wp), PUBLIC, SAVE ::   rcpi   = 2000.0_wp     ! phycst ?
@@ -81,5 +73,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008)
-   !! $Id: sbcice_if.F90 1730 2009-11-16 14:34:19Z smasson $
+   !! $Id$
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -93,5 +85,6 @@
     REAL(wp)                     ::   rmin
     REAL(wp)                     ::   zhk
-    CHARACTER(len=256)           ::   cfisf, cvarzisf, cvarhisf   ! name for isf file
+    REAL(wp)                     ::   zt_frz, zpress
+    CHARACTER(len=256)           ::   cfisf , cvarzisf, cvarhisf   ! name for isf file
     CHARACTER(LEN=256)           :: cnameis                     ! name of iceshelf file
     CHARACTER (LEN=32)           :: cvarLeff                    ! variable name for efficient Length scale
@@ -271,10 +264,19 @@
          END IF
          ! compute tsc due to isf
-         ! WARNING water add at temp = 0C, correction term is added in trasbc, maybe better here but need a 3D variable).
-         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp !
+         ! WARNING water add at temp = 0C, correction term is added, maybe better here but need a 3D variable).
+!         zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04
+         zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress )
+         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - rdivisf * fwfisf(:,:) * zt_frz * r1_rau0 !
          
          ! salt effect already take into account in vertical advection
          risf_tsc(:,:,jp_sal) = (1.0_wp-rdivisf) * fwfisf(:,:) * stbl(:,:) * r1_rau0
-          
+
+         ! output
+         IF( iom_use('qisf'  ) )   CALL iom_put('qisf'  , qisf)
+         IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )
+
+         ! if apply only on the trend and not as a volume flux (rdivisf = 0), fwfisf have to be set to 0 now
+         fwfisf(:,:) = rdivisf * fwfisf(:,:)         
+ 
          ! lbclnk
          CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.)
@@ -296,7 +298,4 @@
          ENDIF
          ! 
-         ! output
-         CALL iom_put('qisf'  , qisf)
-         IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )
       END IF
   
@@ -309,10 +308,9 @@
       sbc_isf_alloc = 0       ! set to zero if no array to be allocated
       IF( .NOT. ALLOCATED( qisf ) ) THEN
-         ALLOCATE(  risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts)              , &
-               &    qisf(jpi,jpj)     , fwfisf(jpi,jpj)     , fwfisf_b(jpi,jpj)   , &
-               &    rhisf_tbl(jpi,jpj), r1_hisf_tbl(jpi,jpj), rzisf_tbl(jpi,jpj)  , &
-               &    ttbl(jpi,jpj)     , stbl(jpi,jpj)       , utbl(jpi,jpj)       , &
-               &    vtbl(jpi, jpj)    , risfLeff(jpi,jpj)   , rhisf_tbl_0(jpi,jpj), &
-               &    ralpha(jpi,jpj)   , misfkt(jpi,jpj)     , misfkb(jpi,jpj)     , &
+         ALLOCATE(  risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts), qisf(jpi,jpj)   , &
+               &    rhisf_tbl(jpi,jpj)    , r1_hisf_tbl(jpi,jpj), rzisf_tbl(jpi,jpj)  , &
+               &    ttbl(jpi,jpj)         , stbl(jpi,jpj)       , utbl(jpi,jpj)       , &
+               &    vtbl(jpi, jpj)        , risfLeff(jpi,jpj)   , rhisf_tbl_0(jpi,jpj), &
+               &    ralpha(jpi,jpj)       , misfkt(jpi,jpj)     , misfkb(jpi,jpj)     , &
                &    STAT= sbc_isf_alloc )
          !
@@ -372,5 +370,5 @@
              ! Calculate freezing temperature
                 zpress = grav*rau0*fsdept(ji,jj,ik)*1.e-04 
-                zt_frz = eos_fzp(tsb(ji,jj,ik,jp_sal), zpress) 
+                CALL eos_fzp(tsb(ji,jj,ik,jp_sal), zt_frz, zpress) 
                 zt_sum = zt_sum + (tsn(ji,jj,ik,jp_tem)-zt_frz) * fse3t(ji,jj,ik) * tmask(ji,jj,ik)  ! sum temp
              ENDDO
@@ -454,5 +452,5 @@
       zti(:,:)=tinsitu( ttbl, stbl, zpress )
 ! Calculate freezing temperature
-      zfrz(:,:)=eos_fzp( sss_m(:,:), zpress )
+      CALL eos_fzp( sss_m(:,:), zfrz(:,:), zpress )
 
       
@@ -563,6 +561,5 @@
       CALL iom_put('isfgammat', zgammat2d)
       CALL iom_put('isfgammas', zgammas2d)
-         !
-      !CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zqisf, zfwfisf  )
+      !
       CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zgammat2d, zgammas2d )
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 5682)
@@ -13,4 +13,5 @@
    !!            3.4  ! 2011-11  (C. Harris) CICE added as an option
    !!            3.5  ! 2012-11  (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes
+   !!            3.6  ! 2014-11  (P. Mathiot, C. Harris) add ice shelves melting                    
    !!----------------------------------------------------------------------
 
@@ -23,4 +24,5 @@
    USE phycst           ! physical constants
    USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE trc_oce          ! shared ocean-passive tracers variables
    USE sbc_ice          ! Surface boundary condition: ice fields
    USE sbcdcy           ! surface boundary condition: diurnal cycle
@@ -37,4 +39,5 @@
    USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model
    USE sbccpl           ! surface boundary condition: coupled florulation
+   USE cpl_oasis3       ! OASIS routines for coupling
    USE sbcssr           ! surface boundary condition: sea surface restoring
    USE sbcrnf           ! surface boundary condition: runoffs
@@ -50,4 +53,5 @@
    USE timing           ! Timing
    USE sbcwave          ! Wave module
+   USE bdy_par          ! Require lk_bdy
 
    IMPLICIT NONE
@@ -82,8 +86,11 @@
       INTEGER ::   icpt   ! local integer
       !!
-      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core,           &
-         &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   &
-         &             ln_ssr    ,  nn_isf , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx
+      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx, ln_blk_clio, ln_blk_core, ln_mixcpl,   &
+         &             ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc   , ln_rnf   ,   &
+         &             ln_ssr    , nn_isf    , nn_fwb, ln_cdgw    , ln_wave    , ln_sdw   ,   &
+         &             nn_lsm    , nn_limflx , nn_components, ln_cpl
       INTEGER  ::   ios
+      INTEGER  ::   ierr, ierr0, ierr1, ierr2, ierr3, jpm
+      LOGICAL  ::   ll_purecpl
       !!----------------------------------------------------------------------
 
@@ -113,5 +120,5 @@
           nn_ice      =   0
       ENDIF
-     
+
       IF(lwp) THEN               ! Control print
          WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)'
@@ -123,5 +130,8 @@
          WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core
          WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs
-         WRITE(numout,*) '              coupled    formulation (T if key_oasis3)   lk_cpl      = ', lk_cpl
+         WRITE(numout,*) '              ocean-atmosphere coupled formulation       ln_cpl      = ', ln_cpl
+         WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl   = ', ln_mixcpl
+         WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis    = ', lk_oasis
+         WRITE(numout,*) '              components of your executable              nn_components = ', nn_components
          WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx
          WRITE(numout,*) '           Misc. options of sbc : '
@@ -150,35 +160,30 @@
       END SELECT
       !
-#if defined key_top && ! defined key_offline
-      ltrcdm2dc = (ln_dm2dc .AND. ln_blk_core .AND. nn_ice==2)
-      IF( ltrcdm2dc )THEN
-         IF(lwp)THEN
-            WRITE(numout,*)"analytical diurnal cycle, core bulk formulation and LIM2 use: "
-            WRITE(numout,*)"Diurnal cycle on physics but not in passive tracers"
-         ENDIF
-      ENDIF
-#else 
-      ltrcdm2dc =  .FALSE.
-#endif
-
-      !
+      IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis )   &
+         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
+      IF ( nn_components == jp_iam_opa .AND. ln_cpl )   &
+         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' )
+      IF ( nn_components == jp_iam_opa .AND. ln_mixcpl )   &
+         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
+      IF ( ln_cpl .AND. .NOT. lk_oasis )    &
+         &      CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' )
+      IF( ln_mixcpl .AND. .NOT. lk_oasis )    &
+         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' )
+      IF( ln_mixcpl .AND. .NOT. ln_cpl )    &
+         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' )
+      IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo )    &
+         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' )
+
       !                              ! allocate sbc arrays
       IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' )
 
       !                          ! Checks:
-      IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths 
-         ln_rnf_mouth  = .false.                      
-         IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_rnf arrays' )
-         nkrnf         = 0
-         rnf     (:,:) = 0.0_wp
-         rnf_b   (:,:) = 0.0_wp
-         rnfmsk  (:,:) = 0.0_wp
-         rnfmsk_z(:)   = 0.0_wp
-      ENDIF
-      IF( nn_isf .EQ. 0 ) THEN                      ! no specific treatment in vicinity of ice shelf 
+      IF( nn_isf .EQ. 0 ) THEN                      ! variable initialisation if no ice shelf 
          IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
-         fwfisf  (:,:) = 0.0_wp
+         fwfisf  (:,:)   = 0.0_wp ; fwfisf_b  (:,:)   = 0.0_wp
+         risf_tsc(:,:,:) = 0.0_wp ; risf_tsc_b(:,:,:) = 0.0_wp
+         rdivisf       = 0.0_wp
       END IF
-      IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero
+      IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa )   fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero
 
       sfx(:,:) = 0.0_wp                            ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero) 
@@ -190,18 +195,8 @@
 
       !                                            ! restartability   
-      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   &
-          MOD( nstock             , nn_fsbc) /= 0 ) THEN 
-         WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   &
-            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
-         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
-      ENDIF
-      !
-      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   &
-         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' )
-      !
-      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   &
+      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) )   &
          &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' )
-      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) )   &
-         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' )
+      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) )   &
+         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' )
       IF( nn_ice == 4 .AND. lk_agrif )   &
          &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' )
@@ -210,17 +205,14 @@
       IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) )   &
          &   WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3'
-      IF( ( nn_ice == 3 ) .AND. ( lk_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   &
+      IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   &
          &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' )
-      IF( ( nn_ice == 3 ) .AND. ( .NOT. lk_cpl ) .AND. ( nn_limflx == 2 ) )   &
+      IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) )   &
          &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' )
 
       IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag
 
-      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) )   &
+      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa )   &
          &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' )
       
-      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   &
-         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
-
       IF ( ln_wave ) THEN
       !Activated wave module but neither drag nor stokes drift activated
@@ -236,15 +228,18 @@
          & asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ')
       ENDIF 
-      
       !                          ! Choice of the Surface Boudary Condition (set nsbc)
+      ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl
+      !
       icpt = 0
-      IF( ln_ana          ) THEN   ;   nsbc = jp_ana    ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation
-      IF( ln_flx          ) THEN   ;   nsbc = jp_flx    ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation
-      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation
-      IF( ln_blk_core     ) THEN   ;   nsbc = jp_core   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation
-      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs    ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation
-      IF( lk_cpl          ) THEN   ;   nsbc = jp_cpl    ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation
-      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                       ;   ENDIF       ! GYRE analytical formulation
-      IF( lk_esopa        )            nsbc = jp_esopa                                      ! esopa test, ALL formulations
+      IF( ln_ana          ) THEN   ;   nsbc = jp_ana     ; icpt = icpt + 1   ;   ENDIF       ! analytical           formulation
+      IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation
+      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio    ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk            formulation
+      IF( ln_blk_core     ) THEN   ;   nsbc = jp_core    ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk            formulation
+      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs     ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk            formulation
+      IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation
+      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                        ;   ENDIF       ! GYRE analytical      formulation
+      IF( nn_components == jp_iam_opa )   &
+         &                  THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module
+      IF( lk_esopa        )            nsbc = jp_esopa                                       ! esopa test, ALL formulations
       !
       IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN
@@ -257,22 +252,58 @@
       IF(lwp) THEN
          WRITE(numout,*)
-         IF( nsbc == jp_esopa )   WRITE(numout,*) '              ESOPA test All surface boundary conditions'
-         IF( nsbc == jp_gyre  )   WRITE(numout,*) '              GYRE analytical formulation'
-         IF( nsbc == jp_ana   )   WRITE(numout,*) '              analytical formulation'
-         IF( nsbc == jp_flx   )   WRITE(numout,*) '              flux formulation'
-         IF( nsbc == jp_clio  )   WRITE(numout,*) '              CLIO bulk formulation'
-         IF( nsbc == jp_core  )   WRITE(numout,*) '              CORE bulk formulation'
-         IF( nsbc == jp_cpl   )   WRITE(numout,*) '              coupled formulation'
-         IF( nsbc == jp_mfs   )   WRITE(numout,*) '              MFS Bulk formulation'
-      ENDIF
-      !
+         IF( nsbc == jp_esopa   )   WRITE(numout,*) '              ESOPA test All surface boundary conditions'
+         IF( nsbc == jp_gyre    )   WRITE(numout,*) '              GYRE analytical formulation'
+         IF( nsbc == jp_ana     )   WRITE(numout,*) '              analytical formulation'
+         IF( nsbc == jp_flx     )   WRITE(numout,*) '              flux formulation'
+         IF( nsbc == jp_clio    )   WRITE(numout,*) '              CLIO bulk formulation'
+         IF( nsbc == jp_core    )   WRITE(numout,*) '              CORE bulk formulation'
+         IF( nsbc == jp_purecpl )   WRITE(numout,*) '              pure coupled formulation'
+         IF( nsbc == jp_mfs     )   WRITE(numout,*) '              MFS Bulk formulation'
+         IF( nsbc == jp_none    )   WRITE(numout,*) '              OPA coupled to SAS via oasis'
+         IF( ln_mixcpl          )   WRITE(numout,*) '              + forced-coupled mixed formulation'
+         IF( nn_components/= jp_iam_nemo )  &
+            &                       WRITE(numout,*) '              + OASIS coupled SAS'
+      ENDIF
+      !
+      IF( lk_oasis )   CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step
+      !                                                     !                                            (2) the use of nn_fsbc
+
+!     nn_fsbc initialization if OPA-SAS coupling via OASIS
+!     sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly
+      IF ( nn_components /= jp_iam_nemo ) THEN
+
+         IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt)
+         IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt)
+         !
+         IF(lwp)THEN
+            WRITE(numout,*)
+            WRITE(numout,*)"   OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+
+      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   &
+          MOD( nstock             , nn_fsbc) /= 0 ) THEN 
+         WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   &
+            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
+         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
+      ENDIF
+      !
+      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   &
+         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' )
+      !
+      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   &
+         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
+
                                CALL sbc_ssm_init               ! Sea-surface mean fields initialisation
       !
       IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation
       !
+                               CALL sbc_rnf_init               ! Runof initialisation
+      !
+      IF( nn_ice == 3      )   CALL sbc_lim_init               ! LIM3 initialisation
+
       IF( nn_ice == 4      )   CALL cice_sbc_init( nsbc )      ! CICE initialisation
-      !
-      IF( nsbc   == jp_cpl )   CALL sbc_cpl_init (nn_ice)      ! OASIS initialisation. must be done before first time step
-
+      
    END SUBROUTINE sbc_init
 
@@ -314,9 +345,11 @@
       !                                            ! ---------------------------------------- !
       !
-      IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc
+      IF ( .NOT. lk_bdy ) then
+         IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc
+      ENDIF
                                                          ! (caution called before sbc_ssm)
       !
-      CALL sbc_ssm( kt )                                 ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
-      !                                                  ! averaged over nf_sbc time-step
+      IF( nn_components /= jp_iam_sas )   CALL sbc_ssm( kt )   ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
+      !                                                        ! averaged over nf_sbc time-step
 
       IF (ln_wave) CALL sbc_wave( kt )
@@ -329,7 +362,15 @@
       CASE( jp_flx   )   ;   CALL sbc_flx     ( kt )                    ! flux formulation
       CASE( jp_clio  )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean
-      CASE( jp_core  )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean
-      CASE( jp_cpl   )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation
+      CASE( jp_core  )   
+         IF( nn_components == jp_iam_sas ) &
+            &                CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA 
+                             CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean
+                                                                        ! from oce: sea surface variables (sst_m, sss_m,  ssu_m,  ssv_m)
+      CASE( jp_purecpl )  ;  CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation
+                                                                        !
       CASE( jp_mfs   )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean
+      CASE( jp_none  ) 
+         IF( nn_components == jp_iam_opa ) &
+                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS
       CASE( jp_esopa )                                
                              CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations
@@ -341,4 +382,7 @@
       END SELECT
 
+      IF( ln_mixcpl )        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing
+
+
       !                                            !==  Misc. Options  ==!
       
@@ -363,5 +407,6 @@
       !                                                           ! (update freshwater fluxes)
 !RBbug do not understand why see ticket 667
-      !clem-bugsal CALL lbc_lnk( emp, 'T', 1. )
+!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
+      CALL lbc_lnk( emp, 'T', 1. )
       !
       IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
@@ -404,5 +449,5 @@
          ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  )
          CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  )
-         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx )
+         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx  )
       ENDIF
 
@@ -419,5 +464,5 @@
          CALL iom_put( "qns"   , qns        )                   ! solar heat flux
          CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux
-         IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction 
+         IF( nn_ice > 0 .OR. nn_components == jp_iam_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction 
          CALL iom_put( "taum"  , taum       )                   ! wind stress module 
          CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 5682)
@@ -32,22 +32,27 @@
 
    PUBLIC   sbc_rnf       ! routine call in sbcmod module
-   PUBLIC   sbc_rnf_div   ! routine called in sshwzv module
+   PUBLIC   sbc_rnf_div   ! routine called in divcurl module
    PUBLIC   sbc_rnf_alloc ! routine call in sbcmod module
    PUBLIC   sbc_rnf_init  ! (PUBLIC for TAM)
    !                                                     !!* namsbc_rnf namelist *
-   CHARACTER(len=100), PUBLIC ::   cn_dir          !: Root directory for location of ssr files
-   LOGICAL           , PUBLIC ::   ln_rnf_depth    !: depth       river runoffs attribute specified in a file
-   LOGICAL           , PUBLIC ::   ln_rnf_tem      !: temperature river runoffs attribute specified in a file
+   CHARACTER(len=100)         ::   cn_dir          !: Root directory for location of rnf files
+   LOGICAL                    ::   ln_rnf_depth      !: depth       river runoffs attribute specified in a file
+   LOGICAL                    ::   ln_rnf_depth_ini  !: depth       river runoffs  computed at the initialisation
+   REAL(wp)                   ::   rn_rnf_max        !: maximum value of the runoff climatologie ( ln_rnf_depth_ini = .true )
+   REAL(wp)                   ::   rn_dep_max        !: depth over which runoffs is spread ( ln_rnf_depth_ini = .true )
+   INTEGER                    ::   nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0)
+   LOGICAL                    ::   ln_rnf_tem      !: temperature river runoffs attribute specified in a file
    LOGICAL           , PUBLIC ::   ln_rnf_sal      !: salinity    river runoffs attribute specified in a file
-   LOGICAL           , PUBLIC ::   ln_rnf_emp      !: runoffs into a file to be read or already into precipitation
    TYPE(FLD_N)       , PUBLIC ::   sn_rnf          !: information about the runoff file to be read
-   TYPE(FLD_N)       , PUBLIC ::   sn_cnf          !: information about the runoff mouth file to be read
+   TYPE(FLD_N)                ::   sn_cnf          !: information about the runoff mouth file to be read
    TYPE(FLD_N)                ::   sn_s_rnf        !: information about the salinities of runoff file to be read
    TYPE(FLD_N)                ::   sn_t_rnf        !: information about the temperatures of runoff file to be read
    TYPE(FLD_N)                ::   sn_dep_rnf      !: information about the depth which river inflow affects
    LOGICAL           , PUBLIC ::   ln_rnf_mouth    !: specific treatment in mouths vicinity
-   REAL(wp)          , PUBLIC ::   rn_hrnf         !: runoffs, depth over which enhanced vertical mixing is used
+   REAL(wp)                   ::   rn_hrnf         !: runoffs, depth over which enhanced vertical mixing is used
    REAL(wp)          , PUBLIC ::   rn_avt_rnf      !: runoffs, value of the additional vertical mixing coef. [m2/s]
-   REAL(wp)          , PUBLIC ::   rn_rfact        !: multiplicative factor for runoff
+   REAL(wp)                   ::   rn_rfact        !: multiplicative factor for runoff
+
+   LOGICAL           , PUBLIC ::   l_rnfcpl = .false.       ! runoffs recieved from oasis
 
    INTEGER , PUBLIC  ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths
@@ -58,7 +63,7 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s]   
 
-   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read)
-   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)  
-   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)  
+   TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read)
+   TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)  
+   TYPE(FLD),        ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)  
  
    !! * Substitutions  
@@ -105,7 +110,4 @@
       CALL wrk_alloc( jpi,jpj, ztfrz)
 
-      !
-      IF( kt == nit000 )   CALL sbc_rnf_init                           ! Read namelist and allocate structures
-
       !                                            ! ---------------------------------------- !
       IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          !
@@ -116,49 +118,44 @@
       ENDIF
 
-      !                                                   !-------------------!
-      IF( .NOT. ln_rnf_emp ) THEN                         !   Update runoff   !
-         !                                                !-------------------!
-         !
-                             CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt
-         IF( ln_rnf_tem  )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required
-         IF( ln_rnf_sal  )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required
-         !
-         ! Runoff reduction only associated to the ORCA2_LIM configuration
-         ! when reading the NetCDF file runoff_1m_nomask.nc
-         IF( cp_cfg == 'orca' .AND. jp_cfg == 2 )   THEN
-            WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )
-               sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)
+      !                                            !-------------------!
+      !                                            !   Update runoff   !
+      !                                            !-------------------!
+      !
+      IF( .NOT. l_rnfcpl )   CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt
+      IF(   ln_rnf_tem   )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required
+      IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required
+      !
+      ! Runoff reduction only associated to the ORCA2_LIM configuration
+      ! when reading the NetCDF file runoff_1m_nomask.nc
+      IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl )   THEN
+         WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )
+            sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)
+         END WHERE
+      ENDIF
+      !
+      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
+         !
+         IF( .NOT. l_rnfcpl )   rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt
+         !
+         !                                                     ! set temperature & salinity content of runoffs
+         IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data
+            rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature
+               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
             END WHERE
-         ENDIF
-         !
-         IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
-            !
-            rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt
-            !
-            !                                                     ! set temperature & salinity content of runoffs
-            IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data
-               rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
-               WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature
-                   rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
-               END WHERE
-               WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg
-                   ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study)
-                   rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp
-               END WHERE
-            ELSE                                                        ! use SST as runoffs temperature
-               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
-            ENDIF
-            !                                                           ! use runoffs salinity data
-            IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
-            !                                                           ! else use S=0 for runoffs (done one for all in the init)
-            IF ( ANY( rnf(:,:) < 0._wp ) ) z_err=1
-            IF(lk_mpp) CALL mpp_sum(z_err)
-            IF( z_err > 0 ) CALL ctl_stop( 'sbc_rnf : negative runnoff values exist' )
-            !
-            CALL iom_put( "runoffs", rnf )         ! output runoffs arrays
-         ENDIF
-         !
-      ENDIF
-      !
+            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg
+               ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study)
+               rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp
+            END WHERE
+         ELSE                                                        ! use SST as runoffs temperature
+            rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+         ENDIF
+         !                                                           ! use runoffs salinity data
+         IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+         !                                                           ! else use S=0 for runoffs (done one for all in the init)
+         CALL iom_put( "runoffs", rnf )         ! output runoffs arrays
+      ENDIF
+      !
+      !                                                ! ---------------------------------------- !
       IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
          !                                             ! ---------------------------------------- !
@@ -171,6 +168,6 @@
          ELSE                                                   !* no restart: set from nit000 values
             IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000'
-             rnf_b    (:,:  ) = rnf    (:,:  )
-             rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
+            rnf_b    (:,:  ) = rnf    (:,:  )
+            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
          ENDIF
       ENDIF
@@ -186,4 +183,5 @@
          CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) )
       ENDIF
+      !
       CALL wrk_dealloc( jpi,jpj, ztfrz)
       !
@@ -211,5 +209,5 @@
       zfact = 0.5_wp
       !
-      IF( ln_rnf_depth ) THEN      !==   runoff distributed over several levels   ==!
+      IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==!
          IF( lk_vvl ) THEN             ! variable volume case
             DO jj = 1, jpj                   ! update the depth over which runoffs are distributed
@@ -255,12 +253,31 @@
       !!----------------------------------------------------------------------
       CHARACTER(len=32) ::   rn_dep_file   ! runoff file name
-      INTEGER           ::   ji, jj, jk    ! dummy loop indices
+      INTEGER           ::   ji, jj, jk, jm    ! dummy loop indices
       INTEGER           ::   ierror, inum  ! temporary integer
       INTEGER           ::   ios           ! Local integer output status for namelist read
-      !
-      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   &
+      INTEGER           ::   nbrec         ! temporary integer
+      REAL(wp)          ::   zacoef  
+      REAL(wp), DIMENSION(12)                 :: zrec             ! times records
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrnfcl    
+      REAL(wp), DIMENSION(:,:  ), ALLOCATABLE :: zrnf
+      !
+      NAMELIST/namsbc_rnf/ cn_dir            , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   &
          &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   &
-         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact
-      !!----------------------------------------------------------------------
+         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact,     &
+         &                 ln_rnf_depth_ini  , rn_dep_max  , rn_rnf_max, nn_rnf_depth_file
+      !!----------------------------------------------------------------------
+      !
+      !                                         !==  allocate runoff arrays
+      IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' )
+      !
+      IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths 
+         ln_rnf_mouth  = .FALSE.                   ! default definition needed for example by sbc_ssr or by tra_adv_muscl
+         nkrnf         = 0
+         rnf     (:,:) = 0.0_wp
+         rnf_b   (:,:) = 0.0_wp
+         rnfmsk  (:,:) = 0.0_wp
+         rnfmsk_z(:)   = 0.0_wp
+         RETURN
+      ENDIF
       !
       !                                   ! ============
@@ -283,5 +300,4 @@
          WRITE(numout,*) '~~~~~~~ '
          WRITE(numout,*) '   Namelist namsbc_rnf'
-         WRITE(numout,*) '      runoff in a file to be read                ln_rnf_emp   = ', ln_rnf_emp
          WRITE(numout,*) '      specific river mouths treatment            ln_rnf_mouth = ', ln_rnf_mouth
          WRITE(numout,*) '      river mouth additional Kz                  rn_avt_rnf   = ', rn_avt_rnf
@@ -289,21 +305,9 @@
          WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact
       ENDIF
-      !
       !                                   ! ==================
       !                                   !   Type of runoff
       !                                   ! ==================
-      !                                         !==  allocate runoff arrays
-      IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' )
-      !
-      IF( ln_rnf_emp ) THEN                     !==  runoffs directly provided in the precipitations  ==!
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          runoffs directly provided in the precipitations'
-         IF( ln_rnf_depth .OR. ln_rnf_tem .OR. ln_rnf_sal ) THEN
-           CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' )
-           ln_rnf_depth = .FALSE.   ;   ln_rnf_tem = .FALSE.   ;   ln_rnf_sal = .FALSE.
-         ENDIF
-         !
-      ELSE                                      !==  runoffs read in a file : set sf_rnf structure  ==!
-         !
+      !
+      IF( .NOT. l_rnfcpl ) THEN                    
          ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow)
          IF(lwp) WRITE(numout,*)
@@ -314,70 +318,134 @@
          ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1)   )
          IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) )
-         !                                          ! fill sf_rnf with the namelist (sn_rnf) and control print
          CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' )
-         !
-         IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file'
-            ALLOCATE( sf_t_rnf(1), STAT=ierror  )
-            IF( ierror > 0 ) THEN
-               CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN
-            ENDIF
-            ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   )
-            IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) )
-            CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' )
-         ENDIF
-         !
-         IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file'
-            ALLOCATE( sf_s_rnf(1), STAT=ierror  )
-            IF( ierror > 0 ) THEN
-               CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN
-            ENDIF
-            ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   )
-            IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) )
-            CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' )
-         ENDIF
-         !
-         IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '          runoffs depth read in a file'
-            rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname )
-            IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year 
-               IF( sn_dep_rnf%cltype == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month 
-            ENDIF 
-            CALL iom_open ( rn_dep_file, inum )                           ! open file
-            CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array
-            CALL iom_close( inum )                                        ! close file
-            !
-            nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF( h_rnf(ji,jj) > 0._wp ) THEN
-                     jk = 2
-                     DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 ;  END DO
-                     nk_rnf(ji,jj) = jk
-                  ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1
-                  ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
-                  ELSE
-                     CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
-                     WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
-                  ENDIF
+      ENDIF
+      !
+      IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file'
+         ALLOCATE( sf_t_rnf(1), STAT=ierror  )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN
+         ENDIF
+         ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   )
+         IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) )
+         CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' )
+      ENDIF
+      !
+      IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file'
+         ALLOCATE( sf_s_rnf(1), STAT=ierror  )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN
+         ENDIF
+         ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   )
+         IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) )
+         CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' )
+      ENDIF
+      !
+      IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          runoffs depth read in a file'
+         rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname )
+         IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year 
+            IF( sn_dep_rnf%cltype == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month 
+         ENDIF
+         CALL iom_open ( rn_dep_file, inum )                           ! open file
+         CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array
+         CALL iom_close( inum )                                        ! close file
+         !
+         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( h_rnf(ji,jj) > 0._wp ) THEN
+                  jk = 2
+                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
+                  END DO
+                  nk_rnf(ji,jj) = jk
+               ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1
+               ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
+               ELSE
+                  CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
+                  WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
+               ENDIF
+            END DO
+         END DO
+         DO jj = 1, jpj                                ! set the associated depth
+            DO ji = 1, jpi
+               h_rnf(ji,jj) = 0._wp
+               DO jk = 1, nk_rnf(ji,jj)
+                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
                END DO
             END DO
-            DO jj = 1, jpj                                ! set the associated depth
-               DO ji = 1, jpi
-                  h_rnf(ji,jj) = 0._wp
-                  DO jk = 1, nk_rnf(ji,jj)
-                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
+         END DO
+         !
+      ELSE IF( ln_rnf_depth_ini ) THEN           ! runoffs applied at the surface
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '    depth of runoff computed once from max value of runoff'
+         IF(lwp) WRITE(numout,*) '    max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max
+         IF(lwp) WRITE(numout,*) '    depth over which runoffs is spread                        rn_dep_max = ', rn_dep_max
+         IF(lwp) WRITE(numout,*) '     create (=1) a runoff depth file or not (=0)      nn_rnf_depth_file  = ', nn_rnf_depth_file
+
+         CALL iom_open( TRIM( sn_rnf%clname ), inum )    !  open runoff file
+         CALL iom_gettime( inum, zrec, kntime=nbrec)
+         ALLOCATE( zrnfcl(jpi,jpj,nbrec) )     ;      ALLOCATE( zrnf(jpi,jpj) )
+         DO jm = 1, nbrec
+            CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,jm), jm )
+         END DO
+         CALL iom_close( inum )
+         zrnf(:,:) = MAXVAL( zrnfcl(:,:,:), DIM=3 )   !  maximum value in time
+         DEALLOCATE( zrnfcl )
+         !
+         h_rnf(:,:) = 1.
+         !
+         zacoef = rn_dep_max / rn_rnf_max            ! coef of linear relation between runoff and its depth (150m for max of runoff)
+         !
+         WHERE( zrnf(:,:) > 0._wp )  h_rnf(:,:) = zacoef * zrnf(:,:)   ! compute depth for all runoffs
+         !
+         DO jj = 1, jpj                     ! take in account min depth of ocean rn_hmin
+            DO ji = 1, jpi
+               IF( zrnf(ji,jj) > 0._wp ) THEN
+                  jk = mbkt(ji,jj)
+                  h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) )
+               ENDIF
+            END DO
+         END DO
+         !
+         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( zrnf(ji,jj) > 0._wp ) THEN
+                  jk = 2
+                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
                   END DO
+                  nk_rnf(ji,jj) = jk
+               ELSE
+                  nk_rnf(ji,jj) = 1
+               ENDIF
+            END DO
+         END DO
+         !
+         DEALLOCATE( zrnf )
+         !
+         DO jj = 1, jpj                                ! set the associated depth
+            DO ji = 1, jpi
+               h_rnf(ji,jj) = 0._wp
+               DO jk = 1, nk_rnf(ji,jj)
+                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
                END DO
             END DO
-         ELSE                                       ! runoffs applied at the surface
-            nk_rnf(:,:) = 1
-            h_rnf (:,:) = fse3t(:,:,1)
-         ENDIF
-         !
+         END DO
+         !
+         IF( nn_rnf_depth_file == 1 ) THEN      !  save  output nb levels for runoff
+            IF(lwp) WRITE(numout,*) '              create runoff depht file'
+            CALL iom_open  ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib )
+            CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf )
+            CALL iom_close ( inum )
+         ENDIF
+      ELSE                                       ! runoffs applied at the surface
+         nk_rnf(:,:) = 1
+         h_rnf (:,:) = fse3t(:,:,1)
       ENDIF
       !
@@ -400,5 +468,6 @@
          IF( rn_hrnf > 0._wp ) THEN
             nkrnf = 2
-            DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1   ;   END DO
+            DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1
+            END DO
             IF( ln_sco )   CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' )
          ENDIF
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 5682)
@@ -58,12 +58,9 @@
       REAL(wp) ::   zcoef, zf_sbc       ! local scalar
       REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts
-      REAL(wp), DIMENSION(jpi,jpj)      :: zub, zvb,zdep
       !!---------------------------------------------------------------------
-      
-      !                                        !* first wet T-, U-, V- ocean level (ISF) variables (T, S, depth, velocity)
+
+      !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity)
       DO jj = 1, jpj
          DO ji = 1, jpi
-            zub(ji,jj)        = ub (ji,jj,miku(ji,jj))
-            zvb(ji,jj)        = vb (ji,jj,mikv(ji,jj))
             zts(ji,jj,jp_tem) = tsn(ji,jj,mikt(ji,jj),jp_tem)
             zts(ji,jj,jp_sal) = tsn(ji,jj,mikt(ji,jj),jp_sal)
@@ -71,16 +68,8 @@
       END DO
       !
-      IF( lk_vvl ) THEN
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zdep(ji,jj) = fse3t_n(ji,jj,mikt(ji,jj))
-            END DO
-         END DO
-      ENDIF
-      !                                                   ! ---------------------------------------- !
       IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        !
          !                                                ! ---------------------------------------- !
-         ssu_m(:,:) = zub(:,:)
-         ssv_m(:,:) = zvb(:,:)
+         ssu_m(:,:) = ub(:,:,1)
+         ssv_m(:,:) = vb(:,:,1)
          IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
          ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem)
@@ -92,5 +81,7 @@
          ENDIF
          !
-         IF( lk_vvl )   fse3t_m(:,:) = zdep(:,:)
+         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1)
+         !
+         frq_m(:,:) = fraqsr_1lev(:,:)
          !
       ELSE
@@ -101,6 +92,6 @@
             IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values'
             zcoef = REAL( nn_fsbc - 1, wp )
-            ssu_m(:,:) = zcoef * zub(:,:)
-            ssv_m(:,:) = zcoef * zvb(:,:)
+            ssu_m(:,:) = zcoef * ub(:,:,1)
+            ssv_m(:,:) = zcoef * vb(:,:,1)
             IF( ln_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
             ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem)
@@ -112,5 +103,7 @@
             ENDIF
             !
-            IF( lk_vvl )   fse3t_m(:,:) = zcoef * zdep(:,:)
+            IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_n(:,:,1)
+            !
+            frq_m(:,:) = zcoef * fraqsr_1lev(:,:)
             !                                             ! ---------------------------------------- !
          ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   !
@@ -121,11 +114,12 @@
             sss_m(:,:) = 0.e0
             ssh_m(:,:) = 0.e0
-            IF( lk_vvl )   fse3t_m(:,:) = 0.e0
+            IF( lk_vvl )   e3t_m(:,:) = 0.e0
+            frq_m(:,:) = 0.e0
          ENDIF
          !                                                ! ---------------------------------------- !
          !                                                !        Cumulate at each time step        !
          !                                                ! ---------------------------------------- !
-         ssu_m(:,:) = ssu_m(:,:) + zub(:,:)
-         ssv_m(:,:) = ssv_m(:,:) + zvb(:,:)
+         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1)
+         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1)
          IF( ln_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
          ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem)
@@ -137,5 +131,7 @@
          ENDIF
          !
-         IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) + zdep(:,:)
+         IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1)
+         !
+         frq_m(:,:) =   frq_m(:,:) + fraqsr_1lev(:,:)
 
          !                                                ! ---------------------------------------- !
@@ -148,5 +144,6 @@
             ssv_m(:,:) = ssv_m(:,:) * zcoef           !
             ssh_m(:,:) = ssh_m(:,:) * zcoef           ! mean SSH             [m]
-            IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) * zcoef   ! mean vertical scale factor [m]
+            IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) * zcoef   ! mean vertical scale factor [m]
+            frq_m(:,:) = frq_m(:,:) * zcoef   ! mean fraction of solar net radiation absorbed in the 1st T level [-]
             !
          ENDIF
@@ -165,10 +162,19 @@
             CALL iom_rstput( kt, nitrst, numrow, 'sss_m'  , sss_m  )
             CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  )
-            IF( lk_vvl ) THEN
-               CALL iom_rstput( kt, nitrst, numrow, 'fse3t_m'  , fse3t_m(:,:)  )
-            END IF
-            !
-         ENDIF
-         !
+            IF( lk_vvl )   CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m  )
+            CALL iom_rstput( kt, nitrst, numrow, 'frq_m'  , frq_m  )
+            !
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   !
+         CALL iom_put( 'ssu_m', ssu_m )
+         CALL iom_put( 'ssv_m', ssv_m )
+         CALL iom_put( 'sst_m', sst_m )
+         CALL iom_put( 'sss_m', sss_m )
+         CALL iom_put( 'ssh_m', ssh_m )
+         IF( lk_vvl )   CALL iom_put( 'e3t_m', e3t_m )
+         CALL iom_put( 'frq_m', frq_m )
       ENDIF
       !
@@ -206,5 +212,11 @@
             CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m  )   !   "         "    salinity    (T-point)
             CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m  )   !   "         "    height      (T-point)
-            IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_m', fse3t_m(:,:) )
+            IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m )
+            ! fraction of solar net radiation absorbed in 1st T level
+            IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN
+               CALL iom_get( numror, jpdom_autoglo, 'frq_m'  , frq_m  )
+            ELSE
+               frq_m(:,:) = 1._wp   ! default definition
+            ENDIF
             !
             IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN      ! nn_fsbc has changed between 2 runs
@@ -217,5 +229,6 @@
                sss_m(:,:) = zcoef * sss_m(:,:)
                ssh_m(:,:) = zcoef * ssh_m(:,:)
-               IF( lk_vvl ) fse3t_m(:,:) = zcoef * fse3t_m(:,:)
+               IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_m(:,:)
+               frq_m(:,:) = zcoef * frq_m(:,:)
             ELSE
                IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields read in the ocean restart file'
@@ -224,4 +237,19 @@
       ENDIF
       !
+      IF( .NOT. l_ssm_mean ) THEN   ! default initialisation. needed by lim_istate
+         !
+         IF(lwp) WRITE(numout,*) '          default initialisation of ss?_m arrays'
+         ssu_m(:,:) = ub(:,:,1)
+         ssv_m(:,:) = vb(:,:,1)
+         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
+         ELSE                    ;   sst_m(:,:) = tsn(:,:,1,jp_tem)
+         ENDIF
+         sss_m(:,:) = tsn(:,:,1,jp_sal)
+         ssh_m(:,:) = sshn(:,:)
+         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1)
+         frq_m(:,:) = 1._wp
+         !
+      ENDIF
+      !
    END SUBROUTINE sbc_ssm_init
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90	(revision 5682)
@@ -36,5 +36,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.5 , NEMO Consortium (2013)
-   !! $Id: $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 5682)
@@ -39,5 +39,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
-   !! $Id: $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90	(revision 5682)
@@ -35,5 +35,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
-   !! $Id:$ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90	(revision 5682)
@@ -36,5 +36,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.5 , NEMO Consortium (2013)
-   !! $Id: $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -80,4 +80,7 @@
           END DO
        END DO
+       !       
+       ! Ensure that tidal components have been set in namelist_cfg
+       IF( nb_harmo .EQ. 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' )
        !
        IF(lwp) THEN
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90	(revision 5682)
@@ -26,5 +26,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: sbcfwb.F90 3625 2012-11-21 13:19:18Z acc $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 5682)
@@ -92,4 +92,6 @@
       IF( .NOT. lk_agrif .OR. .NOT. ln_rstart) THEN
          IF( sol_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'solver_init : unable to allocate sol_oce arrays' )
+         gcx (:,:) = 0.e0
+         gcxb(:,:) = 0.e0
       ENDIF
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90	(revision 5682)
@@ -0,0 +1,903 @@
+MODULE stopar
+   !!======================================================================
+   !!                       ***  MODULE  stopar  ***
+   !! Stochastic parameters : definition and time stepping
+   !!=====================================================================
+   !! History :  3.3  ! 2011-10 (J.-M. Brankart)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sto_par       : update the stochastic parameters
+   !!   sto_par_init  : define the stochastic parameterization
+   !!   sto_rst_read  : read restart file for stochastic parameters
+   !!   sto_rst_write : write restart file for stochastic parameters
+   !!   sto_par_white : fill input array with white Gaussian noise
+   !!   sto_par_flt   : apply horizontal Laplacian filter to input array
+   !!----------------------------------------------------------------------
+   USE storng          ! random number generator (external module)
+   USE par_oce         ! ocean parameters
+   USE dom_oce         ! ocean space and time domain variables
+   USE lbclnk          ! lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE lib_mpp
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sto_par_init    ! called by nemogcm.F90
+   PUBLIC   sto_par         ! called by step.F90
+   PUBLIC   sto_rst_write   ! called by step.F90
+
+   LOGICAL           :: ln_rststo = .FALSE.  ! restart stochastic parameters from restart file
+   LOGICAL           :: ln_rstseed = .FALSE. ! read seed of RNG from restart file
+   CHARACTER(len=32) :: cn_storst_in = "restart_sto"     ! suffix of sto restart name (input)
+   CHARACTER(len=32) :: cn_storst_out = "restart_sto"    ! suffix of sto restart name (output)
+   INTEGER           :: numstor, numstow     ! logical unit for restart (read and write)
+
+   INTEGER           :: jpsto2d = 0          ! number of 2D stochastic parameters
+   INTEGER           :: jpsto3d = 0          ! number of 3D stochastic parameters
+
+   REAL(wp), PUBLIC, DIMENSION(:,:,:),   ALLOCATABLE :: sto2d      ! 2D stochastic parameters
+   REAL(wp), PUBLIC, DIMENSION(:,:,:,:), ALLOCATABLE :: sto3d      ! 3D stochastic parameters
+   REAL(wp),         DIMENSION(:,:),     ALLOCATABLE :: sto_tmp    ! temporary workspace
+   REAL(wp),         DIMENSION(:,:),     ALLOCATABLE :: sto2d_abc  ! a, b, c parameters (for 2D arrays)
+   REAL(wp),         DIMENSION(:,:),     ALLOCATABLE :: sto3d_abc  ! a, b, c parameters (for 3D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_ave  ! mean value (for 2D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_ave  ! mean value (for 3D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_std  ! standard deviation (for 2D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_std  ! standard deviation (for 3D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_lim  ! limitation factor (for 2D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_lim  ! limitation factor (for 3D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_tcor ! time correlation (for 2D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_tcor ! time correlation (for 3D arrays)
+   INTEGER,          DIMENSION(:),       ALLOCATABLE :: sto2d_ord  ! order of autoregressive process
+   INTEGER,          DIMENSION(:),       ALLOCATABLE :: sto3d_ord  ! order of autoregressive process
+
+   CHARACTER(len=1), DIMENSION(:),       ALLOCATABLE :: sto2d_typ  ! nature of grid point (T, U, V, W, F, I)
+   CHARACTER(len=1), DIMENSION(:),       ALLOCATABLE :: sto3d_typ  ! nature of grid point (T, U, V, W, F, I)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_sgn  ! control of the sign accross the north fold
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_sgn  ! control of the sign accross the north fold
+   INTEGER,          DIMENSION(:),       ALLOCATABLE :: sto2d_flt  ! number of passes of Laplacian filter
+   INTEGER,          DIMENSION(:),       ALLOCATABLE :: sto3d_flt  ! number of passes of Laplacian filter
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_fac  ! factor to restore std after filtering
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_fac  ! factor to restore std after filtering
+
+   LOGICAL, PUBLIC :: ln_sto_ldf = .FALSE.    ! stochastic lateral diffusion
+   INTEGER, PUBLIC :: jsto_ldf                ! index of lateral diffusion stochastic parameter
+   REAL(wp)        :: rn_ldf_std              ! lateral diffusion standard deviation (in percent)
+   REAL(wp)        :: rn_ldf_tcor             ! lateral diffusion correlation timescale (in timesteps)
+
+   LOGICAL, PUBLIC :: ln_sto_hpg = .FALSE.    ! stochastic horizontal pressure gradient
+   INTEGER, PUBLIC :: jsto_hpgi               ! index of stochastic hpg parameter (i direction)
+   INTEGER, PUBLIC :: jsto_hpgj               ! index of stochastic hpg parameter (j direction)
+   REAL(wp)        :: rn_hpg_std              ! density gradient standard deviation (in percent)
+   REAL(wp)        :: rn_hpg_tcor             ! density gradient correlation timescale (in timesteps)
+
+   LOGICAL, PUBLIC :: ln_sto_pstar = .FALSE.  ! stochastic ice strength
+   INTEGER, PUBLIC :: jsto_pstar              ! index of stochastic ice strength
+   REAL(wp), PUBLIC:: rn_pstar_std            ! ice strength standard deviation (in percent)
+   REAL(wp)        :: rn_pstar_tcor           ! ice strength correlation timescale (in timesteps)
+   INTEGER         :: nn_pstar_flt = 0        ! number of passes of Laplacian filter
+   INTEGER         :: nn_pstar_ord = 1        ! order of autoregressive processes
+
+   LOGICAL, PUBLIC :: ln_sto_trd = .FALSE.    ! stochastic model trend
+   INTEGER, PUBLIC :: jsto_trd                ! index of stochastic trend parameter
+   REAL(wp)        :: rn_trd_std              ! trend standard deviation (in percent)
+   REAL(wp)        :: rn_trd_tcor             ! trend correlation timescale (in timesteps)
+
+   LOGICAL, PUBLIC :: ln_sto_eos = .FALSE.    ! stochastic equation of state
+   INTEGER, PUBLIC :: nn_sto_eos = 1          ! number of degrees of freedom in stochastic equation of state
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_eosi ! index of stochastic eos parameter (i direction)
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_eosj ! index of stochastic eos parameter (j direction)
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_eosk ! index of stochastic eos parameter (k direction)
+   REAL(wp)        :: rn_eos_stdxy            ! random walk horz. standard deviation (in grid points)
+   REAL(wp)        :: rn_eos_stdz             ! random walk vert. standard deviation (in grid points)
+   REAL(wp)        :: rn_eos_tcor             ! random walk correlation timescale (in timesteps)
+   REAL(wp)        :: rn_eos_lim = 3.0_wp     ! limitation factor
+   INTEGER         :: nn_eos_flt = 0          ! number of passes of Laplacian filter
+   INTEGER         :: nn_eos_ord = 1          ! order of autoregressive processes
+
+   LOGICAL, PUBLIC :: ln_sto_trc = .FALSE.    ! stochastic tracer dynamics
+   INTEGER, PUBLIC :: nn_sto_trc = 1          ! number of degrees of freedom in stochastic tracer dynamics
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_trci ! index of stochastic trc parameter (i direction)
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_trcj ! index of stochastic trc parameter (j direction)
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_trck ! index of stochastic trc parameter (k direction)
+   REAL(wp)        :: rn_trc_stdxy            ! random walk horz. standard deviation (in grid points)
+   REAL(wp)        :: rn_trc_stdz             ! random walk vert. standard deviation (in grid points)
+   REAL(wp)        :: rn_trc_tcor             ! random walk correlation timescale (in timesteps)
+   REAL(wp)        :: rn_trc_lim = 3.0_wp     ! limitation factor
+   INTEGER         :: nn_trc_flt = 0          ! number of passes of Laplacian filter
+   INTEGER         :: nn_trc_ord = 1          ! order of autoregressive processes
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: dynhpg.F90 2528 2010-12-27 17:33:53Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sto_par( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_par  ***
+      !!
+      !! ** Purpose :   update the stochastic parameters
+      !!
+      !! ** Method  :   model basic stochastic parameters
+      !!                as a first order autoregressive process AR(1),
+      !!                governed by the equation:
+      !!                   X(t) = a * X(t-1) + b * w + c
+      !!                where the parameters a, b and c are related
+      !!                to expected value, standard deviation
+      !!                and time correlation (all stationary in time) by:
+      !!                   E   [X(t)]        = c / ( 1 - a )
+      !!                   STD [X(t)]        = b / SQRT( 1 - a * a )
+      !!                   COR [X(t),X(t-k)] = a ** k
+      !!                and w is a Gaussian white noise.
+      !!
+      !!                Higher order autoregressive proces can be optionally generated
+      !!                by replacing the white noise by a lower order process.
+      !!
+      !!                1) The statistics of the stochastic parameters (X) are assumed
+      !!                constant in space (homogeneous) and time (stationary).
+      !!                This could be generalized by replacing the constant
+      !!                a, b, c parameters by functions of space and time.
+      !!
+      !!                2) The computation is performed independently for every model
+      !!                grid point, which corresponds to assume that the stochastic
+      !!                parameters are uncorrelated in space.
+      !!                This could be generalized by including a spatial filter: Y = Filt[ X ]
+      !!                (possibly non-homgeneous and non-stationary) in the computation,
+      !!                or by solving an elliptic equation: L[ Y ] = X.
+      !!
+      !!                3) The stochastic model for the parameters could also
+      !!                be generalized to depend on the current state of the ocean (not done here).
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  :: ji, jj, jk, jsto, jflt
+      REAL(wp) :: stomax
+
+      !
+      ! Update 2D stochastic arrays
+      !
+      DO jsto = 1, jpsto2d
+        ! Store array from previous time step
+        sto_tmp(:,:) = sto2d(:,:,jsto)
+
+        IF ( sto2d_ord(jsto) == 1 ) THEN
+          ! Draw new random numbers from N(0,1) --> w
+          CALL sto_par_white( sto2d(:,:,jsto) )
+          ! Apply horizontal Laplacian filter to w
+          DO jflt = 1, sto2d_flt(jsto)
+            CALL lbc_lnk( sto2d(:,:,jsto), sto2d_typ(jsto), sto2d_sgn(jsto) )
+            CALL sto_par_flt( sto2d(:,:,jsto) )
+          END DO
+          ! Factor to restore standard deviation after filtering
+          sto2d(:,:,jsto) = sto2d(:,:,jsto) * sto2d_fac(jsto)
+        ELSE
+          ! Use previous process (one order lower) instead of white noise
+          sto2d(:,:,jsto) = sto2d(:,:,jsto-1)
+        ENDIF
+
+        ! Multiply white noise (or lower order process) by b --> b * w
+        sto2d(:,:,jsto) = sto2d(:,:,jsto) * sto2d_abc(jsto,2)
+        ! Update autoregressive processes --> a * X(t-1) + b * w
+        sto2d(:,:,jsto) = sto2d(:,:,jsto) + sto_tmp(:,:) * sto2d_abc(jsto,1)
+        ! Add parameter c --> a * X(t-1) + b * w + c
+        sto2d(:,:,jsto) = sto2d(:,:,jsto) + sto2d_abc(jsto,3)
+        ! Limit random parameter anomalies to std times the limitation factor
+        stomax = sto2d_std(jsto) * sto2d_lim(jsto)
+        sto2d(:,:,jsto) = sto2d(:,:,jsto) - sto2d_ave(jsto)
+        sto2d(:,:,jsto) = SIGN(MIN(stomax,ABS(sto2d(:,:,jsto))),sto2d(:,:,jsto))
+        sto2d(:,:,jsto) = sto2d(:,:,jsto) + sto2d_ave(jsto)
+
+        ! Lateral boundary conditions on sto2d
+        CALL lbc_lnk( sto2d(:,:,jsto), sto2d_typ(jsto), sto2d_sgn(jsto) )
+      END DO
+      !
+      ! Update 3D stochastic arrays
+      !
+      DO jsto = 1, jpsto3d
+         DO jk = 1, jpk
+           ! Store array from previous time step
+           sto_tmp(:,:) = sto3d(:,:,jk,jsto)
+
+           IF ( sto3d_ord(jsto) == 1 ) THEN
+             ! Draw new random numbers from N(0,1) --> w
+             CALL sto_par_white( sto3d(:,:,jk,jsto) )
+             ! Apply horizontal Laplacian filter to w
+             DO jflt = 1, sto3d_flt(jsto)
+               CALL lbc_lnk( sto3d(:,:,jk,jsto), sto3d_typ(jsto), sto3d_sgn(jsto) )
+               CALL sto_par_flt( sto3d(:,:,jk,jsto) )
+             END DO
+             ! Factor to restore standard deviation after filtering
+             sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) * sto3d_fac(jsto)
+           ELSE
+             ! Use previous process (one order lower) instead of white noise
+             sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto-1)
+           ENDIF
+
+           ! Multiply white noise by b --> b * w
+           sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) * sto3d_abc(jsto,2)
+           ! Update autoregressive processes --> a * X(t-1) + b * w
+           sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) + sto_tmp(:,:) * sto3d_abc(jsto,1)
+           ! Add parameter c --> a * X(t-1) + b * w + c
+           sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) + sto3d_abc(jsto,3)
+           ! Limit random parameters anomalies to std times the limitation factor
+           stomax = sto3d_std(jsto) * sto3d_lim(jsto)
+           sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) - sto3d_ave(jsto)
+           sto3d(:,:,jk,jsto) = SIGN(MIN(stomax,ABS(sto3d(:,:,jk,jsto))),sto3d(:,:,jk,jsto))
+           sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) + sto3d_ave(jsto)
+         END DO
+         ! Lateral boundary conditions on sto3d
+         CALL lbc_lnk( sto3d(:,:,:,jsto), sto3d_typ(jsto), sto3d_sgn(jsto) )
+      END DO
+
+   END SUBROUTINE sto_par
+
+
+   SUBROUTINE sto_par_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_par_init  ***
+      !!
+      !! ** Purpose :   define the stochastic parameterization
+      !!----------------------------------------------------------------------
+      NAMELIST/namsto/ ln_sto_ldf, rn_ldf_std, rn_ldf_tcor, &
+        &              ln_sto_hpg, rn_hpg_std, rn_hpg_tcor, &
+        &              ln_sto_pstar, rn_pstar_std, rn_pstar_tcor, nn_pstar_flt, nn_pstar_ord, &
+        &              ln_sto_trd, rn_trd_std, rn_trd_tcor, &
+        &              ln_sto_eos, nn_sto_eos, rn_eos_stdxy, rn_eos_stdz, &
+        &              rn_eos_tcor, nn_eos_ord, nn_eos_flt, rn_eos_lim, &
+        &              ln_sto_trc, nn_sto_trc, rn_trc_stdxy, rn_trc_stdz, &
+        &              rn_trc_tcor, nn_trc_ord, nn_trc_flt, rn_trc_lim, &
+        &              ln_rststo, ln_rstseed, cn_storst_in, cn_storst_out
+      !!----------------------------------------------------------------------
+      INTEGER :: jsto, jmem, jarea, jdof, jord, jordm1, jk, jflt
+      INTEGER(KIND=8) :: zseed1, zseed2, zseed3, zseed4
+      REAL(wp) :: rinflate
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+
+      ! Read namsto namelist : stochastic parameterization
+      REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme
+      READ  ( numnam_ref, namsto, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsto in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme
+      READ  ( numnam_cfg, namsto, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsto in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsto )
+
+      !IF(ln_ens_rst_in) cn_storst_in = cn_mem//cn_storst_in
+
+      ! Parameter print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'sto_par_init : stochastic parameterization'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namsto : stochastic parameterization'
+         WRITE(numout,*) '      restart stochastic parameters           ln_rststo     = ', ln_rststo
+         WRITE(numout,*) '      read seed of RNG from restart file      ln_rstseed    = ', ln_rstseed
+         WRITE(numout,*) '      suffix of sto restart name (input)      cn_storst_in  = ', cn_storst_in
+         WRITE(numout,*) '      suffix of sto restart name (output)     cn_storst_out = ', cn_storst_out
+
+         ! WRITE(numout,*) '      stochastic lateral diffusion            ln_sto_ldf    = ', ln_sto_ldf
+         ! WRITE(numout,*) '      lateral diffusion std (in percent)      rn_ldf_std    = ', rn_ldf_std
+         ! WRITE(numout,*) '      lateral diffusion tcor (in timesteps)   rn_ldf_tcor   = ', rn_ldf_tcor
+
+         ! WRITE(numout,*) '      stochastic horizontal pressure gradient ln_sto_hpg    = ', ln_sto_hpg
+         ! WRITE(numout,*) '      density gradient std (in percent)       rn_hpg_std    = ', rn_hpg_std
+         ! WRITE(numout,*) '      density gradient tcor (in timesteps)    rn_hpg_tcor   = ', rn_hpg_tcor
+
+         ! WRITE(numout,*) '      stochastic ice strength                 ln_sto_pstar  = ', ln_sto_pstar
+         ! WRITE(numout,*) '      ice strength std (in percent)           rn_pstar_std  = ', rn_pstar_std
+         ! WRITE(numout,*) '      ice strength tcor (in timesteps)        rn_pstar_tcor = ', rn_pstar_tcor
+         ! WRITE(numout,*) '      order of autoregressive  processes      nn_pstar_ord  = ', nn_pstar_ord
+         ! WRITE(numout,*) '      passes of Laplacian filter              nn_pstar_flt  = ', nn_pstar_flt
+
+         !WRITE(numout,*) '      stochastic trend                        ln_sto_trd    = ', ln_sto_trd
+         !WRITE(numout,*) '      trend std (in percent)                  rn_trd_std    = ', rn_trd_std
+         !WRITE(numout,*) '      trend tcor (in timesteps)               rn_trd_tcor   = ', rn_trd_tcor
+
+         WRITE(numout,*) '      stochastic equation of state            ln_sto_eos    = ', ln_sto_eos
+         WRITE(numout,*) '      number of degrees of freedom            nn_sto_eos    = ', nn_sto_eos
+         WRITE(numout,*) '      random walk horz. std (in grid points)  rn_eos_stdxy  = ', rn_eos_stdxy
+         WRITE(numout,*) '      random walk vert. std (in grid points)  rn_eos_stdz   = ', rn_eos_stdz
+         WRITE(numout,*) '      random walk tcor (in timesteps)         rn_eos_tcor   = ', rn_eos_tcor
+         WRITE(numout,*) '      order of autoregressive  processes      nn_eos_ord    = ', nn_eos_ord
+         WRITE(numout,*) '      passes of Laplacian filter              nn_eos_flt    = ', nn_eos_flt
+         WRITE(numout,*) '      limitation factor                       rn_eos_lim    = ', rn_eos_lim
+
+         ! WRITE(numout,*) '      stochastic tracers dynamics             ln_sto_trc    = ', ln_sto_trc
+         ! WRITE(numout,*) '      number of degrees of freedom            nn_sto_trc    = ', nn_sto_trc
+         ! WRITE(numout,*) '      random walk horz. std (in grid points)  rn_trc_stdxy  = ', rn_trc_stdxy
+         ! WRITE(numout,*) '      random walk vert. std (in grid points)  rn_trc_stdz   = ', rn_trc_stdz
+         ! WRITE(numout,*) '      random walk tcor (in timesteps)         rn_trc_tcor   = ', rn_trc_tcor
+         ! WRITE(numout,*) '      order of autoregressive  processes      nn_trc_ord    = ', nn_trc_ord
+         ! WRITE(numout,*) '      passes of Laplacian filter              nn_trc_flt    = ', nn_trc_flt
+         ! WRITE(numout,*) '      limitation factor                       rn_trc_lim    = ', rn_trc_lim
+
+      ENDIF
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   stochastic parameterization :'
+
+      ! Set number of 2D stochastic arrays
+      jpsto2d = 0
+      IF( ln_sto_ldf ) THEN
+         IF(lwp) WRITE(numout,*) '       - stochastic lateral diffusion'
+         jpsto2d   = jpsto2d + 1
+         jsto_ldf  = jpsto2d
+      ENDIF
+      IF( ln_sto_pstar ) THEN
+         IF(lwp) WRITE(numout,*) '       - stochastic ice strength'
+         jpsto2d    = jpsto2d + 1 * nn_pstar_ord
+         jsto_pstar = jpsto2d
+      ENDIF
+      IF( ln_sto_eos ) THEN
+         IF ( lk_agrif ) CALL ctl_stop('EOS stochastic parametrization is not compatible with AGRIF')
+         IF(lwp) WRITE(numout,*) '       - stochastic equation of state'
+         ALLOCATE(jsto_eosi(nn_sto_eos))
+         ALLOCATE(jsto_eosj(nn_sto_eos))
+         ALLOCATE(jsto_eosk(nn_sto_eos))
+         DO jdof = 1, nn_sto_eos
+            jpsto2d   = jpsto2d + 3 * nn_eos_ord
+            jsto_eosi(jdof) = jpsto2d - 2 * nn_eos_ord
+            jsto_eosj(jdof) = jpsto2d - 1 * nn_eos_ord
+            jsto_eosk(jdof) = jpsto2d
+         END DO
+      ELSE
+         nn_sto_eos = 0
+      ENDIF
+      IF( ln_sto_trc ) THEN
+         IF(lwp) WRITE(numout,*) '       - stochastic tracers dynamics'
+         ALLOCATE(jsto_trci(nn_sto_trc))
+         ALLOCATE(jsto_trcj(nn_sto_trc))
+         ALLOCATE(jsto_trck(nn_sto_trc))
+         DO jdof = 1, nn_sto_trc
+            jpsto2d   = jpsto2d + 3 * nn_trc_ord
+            jsto_trci(jdof) = jpsto2d - 2 * nn_trc_ord
+            jsto_trcj(jdof) = jpsto2d - 1 * nn_trc_ord
+            jsto_trck(jdof) = jpsto2d
+         END DO
+      ELSE
+         nn_sto_trc = 0
+      ENDIF
+
+      ! Set number of 3D stochastic arrays
+      jpsto3d = 0
+      IF( ln_sto_hpg ) THEN
+         IF(lwp) WRITE(numout,*) '       - stochastic horizontal pressure gradient'
+         jpsto3d   = jpsto3d + 2
+         jsto_hpgi = jpsto3d - 1
+         jsto_hpgj = jpsto3d
+      ENDIF
+      IF( ln_sto_trd ) THEN
+         IF(lwp) WRITE(numout,*) '       - stochastic trend'
+         jpsto3d   = jpsto3d + 1
+         jsto_trd  = jpsto3d
+      ENDIF
+
+      ! Allocate 2D stochastic arrays
+      IF ( jpsto2d > 0 ) THEN
+         ALLOCATE ( sto2d(jpi,jpj,jpsto2d) )
+         ALLOCATE ( sto2d_abc(jpsto2d,3) )
+         ALLOCATE ( sto2d_ave(jpsto2d) )
+         ALLOCATE ( sto2d_std(jpsto2d) )
+         ALLOCATE ( sto2d_lim(jpsto2d) )
+         ALLOCATE ( sto2d_tcor(jpsto2d) )
+         ALLOCATE ( sto2d_ord(jpsto2d) )
+         ALLOCATE ( sto2d_typ(jpsto2d) )
+         ALLOCATE ( sto2d_sgn(jpsto2d) )
+         ALLOCATE ( sto2d_flt(jpsto2d) )
+         ALLOCATE ( sto2d_fac(jpsto2d) )
+      ENDIF
+
+      ! Allocate 3D stochastic arrays
+      IF ( jpsto3d > 0 ) THEN
+         ALLOCATE ( sto3d(jpi,jpj,jpk,jpsto3d) )
+         ALLOCATE ( sto3d_abc(jpsto3d,3) )
+         ALLOCATE ( sto3d_ave(jpsto3d) )
+         ALLOCATE ( sto3d_std(jpsto3d) )
+         ALLOCATE ( sto3d_lim(jpsto3d) )
+         ALLOCATE ( sto3d_tcor(jpsto3d) )
+         ALLOCATE ( sto3d_ord(jpsto3d) )
+         ALLOCATE ( sto3d_typ(jpsto3d) )
+         ALLOCATE ( sto3d_sgn(jpsto3d) )
+         ALLOCATE ( sto3d_flt(jpsto3d) )
+         ALLOCATE ( sto3d_fac(jpsto3d) )
+      ENDIF
+
+      ! Allocate temporary workspace
+      IF ( jpsto2d > 0 .OR. jpsto3d > 0 ) THEN
+         ALLOCATE ( sto_tmp(jpi,jpj) ) ; sto_tmp(:,:) = 0._wp
+      ENDIF
+
+      ! 1) For every stochastic parameter:
+      ! ----------------------------------
+      ! - set nature of grid point and control of the sign
+      !       across the north fold (sto2d_typ, sto2d_sgn)
+      ! - set number of passes of Laplacian filter (sto2d_flt)
+      ! - set order of every autoregressive process (sto2d_ord)
+      DO jsto = 1, jpsto2d
+         sto2d_typ(jsto) = 'T'
+         sto2d_sgn(jsto) = 1._wp
+         sto2d_flt(jsto) = 0
+         sto2d_ord(jsto) = 1
+         DO jord = 0, nn_pstar_ord-1
+            IF ( jsto+jord == jsto_pstar ) THEN ! Stochastic ice strength (ave=1)
+               sto2d_ord(jsto) = nn_pstar_ord - jord
+               sto2d_flt(jsto) = nn_pstar_flt
+            ENDIF
+         ENDDO
+         DO jdof = 1, nn_sto_eos
+         DO jord = 0, nn_eos_ord-1
+            IF ( jsto+jord == jsto_eosi(jdof) ) THEN ! Stochastic equation of state i (ave=0)
+               sto2d_ord(jsto) = nn_eos_ord - jord
+               sto2d_sgn(jsto) = -1._wp
+               sto2d_flt(jsto) = nn_eos_flt
+            ENDIF
+            IF ( jsto+jord == jsto_eosj(jdof) ) THEN ! Stochastic equation of state j (ave=0)
+               sto2d_ord(jsto) = nn_eos_ord - jord
+               sto2d_sgn(jsto) = -1._wp
+               sto2d_flt(jsto) = nn_eos_flt
+            ENDIF
+            IF ( jsto+jord == jsto_eosk(jdof) ) THEN ! Stochastic equation of state k (ave=0)
+               sto2d_ord(jsto) = nn_eos_ord - jord
+               sto2d_flt(jsto) = nn_eos_flt
+            ENDIF
+         END DO
+         END DO
+         DO jdof = 1, nn_sto_trc
+         DO jord = 0, nn_trc_ord-1
+            IF ( jsto+jord == jsto_trci(jdof) ) THEN ! Stochastic tracers dynamics i (ave=0)
+               sto2d_ord(jsto) = nn_trc_ord - jord
+               sto2d_sgn(jsto) = -1._wp
+               sto2d_flt(jsto) = nn_trc_flt
+            ENDIF
+            IF ( jsto+jord == jsto_trcj(jdof) ) THEN ! Stochastic tracers dynamics j (ave=0)
+               sto2d_ord(jsto) = nn_trc_ord - jord
+               sto2d_sgn(jsto) = -1._wp
+               sto2d_flt(jsto) = nn_trc_flt
+            ENDIF
+            IF ( jsto+jord == jsto_trck(jdof) ) THEN ! Stochastic tracers dynamics k (ave=0)
+               sto2d_ord(jsto) = nn_trc_ord - jord
+               sto2d_flt(jsto) = nn_trc_flt
+            ENDIF
+         END DO
+         END DO
+
+         sto2d_fac(jsto) = sto_par_flt_fac ( sto2d_flt(jsto) )
+      END DO
+      !
+      DO jsto = 1, jpsto3d
+         sto3d_typ(jsto) = 'T'
+         sto3d_sgn(jsto) = 1._wp
+         sto3d_flt(jsto) = 0
+         sto3d_ord(jsto) = 1
+         IF ( jsto == jsto_hpgi ) THEN ! Stochastic density gradient i (ave=1)
+            sto3d_typ(jsto) = 'U'
+         ENDIF
+         IF ( jsto == jsto_hpgj ) THEN ! Stochastic density gradient j (ave=1)
+            sto3d_typ(jsto) = 'V'
+         ENDIF
+         sto3d_fac(jsto) = sto_par_flt_fac ( sto3d_flt(jsto) )
+      END DO
+
+      ! 2) For every stochastic parameter:
+      ! ----------------------------------
+      ! set average, standard deviation and time correlation
+      DO jsto = 1, jpsto2d
+         sto2d_ave(jsto)  = 0._wp
+         sto2d_std(jsto)  = 1._wp
+         sto2d_tcor(jsto) = 1._wp
+         sto2d_lim(jsto)  = 3._wp
+         IF ( jsto == jsto_ldf  ) THEN ! Stochastic lateral diffusion (ave=1)
+            sto2d_ave(jsto)  = 1._wp
+            sto2d_std(jsto)  = rn_ldf_std
+            sto2d_tcor(jsto) = rn_ldf_tcor
+         ENDIF
+         DO jord = 0, nn_pstar_ord-1
+            IF ( jsto+jord == jsto_pstar ) THEN ! Stochastic ice strength (ave=1)
+               sto2d_std(jsto) = 1._wp
+               sto2d_tcor(jsto) = rn_pstar_tcor
+            ENDIF
+         ENDDO
+         DO jdof = 1, nn_sto_eos
+         DO jord = 0, nn_eos_ord-1
+            IF ( jsto+jord == jsto_eosi(jdof) ) THEN ! Stochastic equation of state i (ave=0)
+               sto2d_std(jsto)  = rn_eos_stdxy
+               sto2d_tcor(jsto) = rn_eos_tcor
+               sto2d_lim(jsto)  = rn_eos_lim
+            ENDIF
+            IF ( jsto+jord == jsto_eosj(jdof) ) THEN ! Stochastic equation of state j (ave=0)
+               sto2d_std(jsto)  = rn_eos_stdxy
+               sto2d_tcor(jsto) = rn_eos_tcor
+               sto2d_lim(jsto)  = rn_eos_lim
+            ENDIF
+            IF ( jsto+jord == jsto_eosk(jdof) ) THEN ! Stochastic equation of state k (ave=0)
+               sto2d_std(jsto)  = rn_eos_stdz
+               sto2d_tcor(jsto) = rn_eos_tcor
+               sto2d_lim(jsto)  = rn_eos_lim
+            ENDIF
+         END DO
+         END DO
+         DO jdof = 1, nn_sto_trc
+         DO jord = 0, nn_trc_ord-1
+            IF ( jsto+jord == jsto_trci(jdof) ) THEN ! Stochastic tracer dynamics i (ave=0)
+               sto2d_std(jsto)  = rn_trc_stdxy
+               sto2d_tcor(jsto) = rn_trc_tcor
+               sto2d_lim(jsto)  = rn_trc_lim
+            ENDIF
+            IF ( jsto+jord == jsto_trcj(jdof) ) THEN ! Stochastic tracer dynamics j (ave=0)
+               sto2d_std(jsto)  = rn_trc_stdxy
+               sto2d_tcor(jsto) = rn_trc_tcor
+               sto2d_lim(jsto)  = rn_trc_lim
+            ENDIF
+            IF ( jsto+jord == jsto_trck(jdof) ) THEN ! Stochastic tracer dynamics k (ave=0)
+               sto2d_std(jsto)  = rn_trc_stdz
+               sto2d_tcor(jsto) = rn_trc_tcor
+               sto2d_lim(jsto)  = rn_trc_lim
+            ENDIF
+         END DO
+         END DO
+
+      END DO
+      !
+      DO jsto = 1, jpsto3d
+         sto3d_ave(jsto)  = 0._wp
+         sto3d_std(jsto)  = 1._wp
+         sto3d_tcor(jsto) = 1._wp
+         sto3d_lim(jsto)  = 3._wp
+         IF ( jsto == jsto_hpgi ) THEN ! Stochastic density gradient i (ave=1)
+            sto3d_ave(jsto)  = 1._wp
+            sto3d_std(jsto)  = rn_hpg_std
+            sto3d_tcor(jsto) = rn_hpg_tcor
+         ENDIF
+         IF ( jsto == jsto_hpgj ) THEN ! Stochastic density gradient j (ave=1)
+            sto3d_ave(jsto)  = 1._wp
+            sto3d_std(jsto)  = rn_hpg_std
+            sto3d_tcor(jsto) = rn_hpg_tcor
+         ENDIF
+         IF ( jsto == jsto_trd ) THEN ! Stochastic trend (ave=1)
+            sto3d_ave(jsto)  = 1._wp
+            sto3d_std(jsto)  = rn_trd_std
+            sto3d_tcor(jsto) = rn_trd_tcor
+         ENDIF
+      END DO
+
+      ! 3) For every stochastic parameter:
+      ! ----------------------------------
+      ! - compute parameters (a, b, c) of the AR1 autoregressive process
+      !   from expected value (ave), standard deviation (std)
+      !   and time correlation (tcor):
+      !     a = EXP ( - 1 / tcor )           --> sto2d_abc(:,1)
+      !     b = std * SQRT( 1 - a * a )      --> sto2d_abc(:,2)
+      !     c = ave * ( 1 - a )              --> sto2d_abc(:,3)
+      ! - for higher order processes (ARn, n>1), use approximate formula
+      !   for the b parameter (valid for tcor>>1 time step)
+      DO jsto = 1, jpsto2d
+         IF ( sto2d_tcor(jsto) == 0._wp ) THEN
+            sto2d_abc(jsto,1) = 0._wp
+         ELSE
+            sto2d_abc(jsto,1) = EXP ( - 1._wp / sto2d_tcor(jsto) )
+         ENDIF
+         IF ( sto2d_ord(jsto) == 1 ) THEN      ! Exact formula for 1st order process
+            rinflate = sto2d_std(jsto)
+         ELSE
+            ! Approximate formula, valid for tcor >> 1
+            jordm1 = sto2d_ord(jsto) - 1
+            rinflate = SQRT ( REAL( jordm1 , wp ) / REAL( 2*(2*jordm1-1) , wp ) )
+         ENDIF
+         sto2d_abc(jsto,2) = rinflate * SQRT ( 1._wp - sto2d_abc(jsto,1) &
+                                                     * sto2d_abc(jsto,1) )
+         sto2d_abc(jsto,3) = sto2d_ave(jsto) * ( 1._wp - sto2d_abc(jsto,1) )
+      END DO
+      !
+      DO jsto = 1, jpsto3d
+         IF ( sto3d_tcor(jsto) == 0._wp ) THEN
+            sto3d_abc(jsto,1) = 0._wp
+         ELSE
+            sto3d_abc(jsto,1) = EXP ( - 1._wp / sto3d_tcor(jsto) )
+         ENDIF
+         IF ( sto3d_ord(jsto) == 1 ) THEN      ! Exact formula for 1st order process
+            rinflate = sto3d_std(jsto)
+         ELSE
+            ! Approximate formula, valid for tcor >> 1
+            jordm1 = sto3d_ord(jsto) - 1
+            rinflate = SQRT ( REAL( jordm1 , wp ) / REAL( 2*(2*jordm1-1) , wp ) )
+         ENDIF
+         sto3d_abc(jsto,2) = rinflate * SQRT ( 1._wp - sto3d_abc(jsto,1) &
+                                                     * sto3d_abc(jsto,1) )
+         sto3d_abc(jsto,3) = sto3d_ave(jsto) * ( 1._wp - sto3d_abc(jsto,1) )
+      END DO
+
+      ! 4) Initialize seeds for random number generator
+      ! -----------------------------------------------
+      ! using different seeds for different processors (jarea)
+      ! and different ensemble members (jmem)
+      CALL kiss_reset( )
+      DO jarea = 1, narea
+         !DO jmem = 0, nmember
+         zseed1 = kiss() ; zseed2 = kiss() ; zseed3 = kiss() ; zseed4 = kiss()
+         !END DO
+      END DO
+      CALL kiss_seed( zseed1, zseed2, zseed3, zseed4 )
+
+      ! 5) Initialize stochastic parameters to: ave + std * w
+      ! -----------------------------------------------------
+      DO jsto = 1, jpsto2d
+         ! Draw random numbers from N(0,1) --> w
+         CALL sto_par_white( sto2d(:,:,jsto) )
+         ! Apply horizontal Laplacian filter to w
+         DO jflt = 1, sto2d_flt(jsto)
+            CALL lbc_lnk( sto2d(:,:,jsto), sto2d_typ(jsto), sto2d_sgn(jsto) )
+            CALL sto_par_flt( sto2d(:,:,jsto) )
+         END DO
+         ! Factor to restore standard deviation after filtering
+         sto2d(:,:,jsto) = sto2d(:,:,jsto) * sto2d_fac(jsto)
+         ! Limit random parameter to the limitation factor
+         sto2d(:,:,jsto) = SIGN(MIN(sto2d_lim(jsto),ABS(sto2d(:,:,jsto))),sto2d(:,:,jsto))
+         ! Multiply by standard devation and add average value
+         sto2d(:,:,jsto) = sto2d(:,:,jsto) * sto2d_std(jsto) + sto2d_ave(jsto)
+      END DO
+      !
+      DO jsto = 1, jpsto3d
+         DO jk = 1, jpk
+            ! Draw random numbers from N(0,1) --> w
+            CALL sto_par_white( sto3d(:,:,jk,jsto) )
+            ! Apply horizontal Laplacian filter to w
+            DO jflt = 1, sto3d_flt(jsto)
+               CALL lbc_lnk( sto3d(:,:,jk,jsto), sto3d_typ(jsto), sto3d_sgn(jsto) )
+               CALL sto_par_flt( sto3d(:,:,jk,jsto) )
+            END DO
+            ! Factor to restore standard deviation after filtering
+            sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) * sto3d_fac(jsto)
+            ! Limit random parameter to the limitation factor
+            sto3d(:,:,jk,jsto) = SIGN(MIN(sto3d_lim(jsto),ABS(sto3d(:,:,jk,jsto))),sto3d(:,:,jk,jsto))
+            ! Multiply by standard devation and add average value
+            sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) * sto3d_std(jsto) + sto3d_ave(jsto)
+         END DO
+      END DO
+
+      ! 6) Restart stochastic parameters from file
+      ! ------------------------------------------
+      IF( ln_rststo ) CALL sto_rst_read
+
+   END SUBROUTINE sto_par_init
+
+
+   SUBROUTINE sto_rst_read
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_rst_read  ***
+      !!
+
+      !! ** Purpose :   read stochastic parameters from restart file
+      !!----------------------------------------------------------------------
+
+      INTEGER  :: jsto, jseed
+      INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type
+      REAL(KIND=8)        ::   zrseed(4)           ! RNG seeds in real type (with same bits to save in restart)
+      CHARACTER(LEN=9)    ::   clsto2d='sto2d_000' ! stochastic parameter variable name
+      CHARACTER(LEN=9)    ::   clsto3d='sto3d_000' ! stochastic parameter variable name
+      CHARACTER(LEN=10)   ::   clseed='seed0_0000' ! seed variable name
+
+      IF ( jpsto2d > 0 .OR. jpsto3d > 0 ) THEN
+
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'sto_rst_read : read stochastic parameters from restart file'
+            WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
+
+         ! Open the restart file
+         CALL iom_open( cn_storst_in, numstor, kiolib = jprstlib )
+
+         ! Get stochastic parameters from restart file:
+         ! 2D stochastic parameters
+         DO jsto = 1 , jpsto2d
+            WRITE(clsto2d(7:9),'(i3.3)') jsto
+            CALL iom_get( numstor, jpdom_autoglo, clsto2d , sto2d(:,:,jsto) )
+         END DO
+         ! 3D stochastic parameters
+         DO jsto = 1 , jpsto3d
+            WRITE(clsto3d(7:9),'(i3.3)') jsto
+            CALL iom_get( numstor, jpdom_autoglo, clsto3d , sto3d(:,:,:,jsto) )
+         END DO
+
+         IF (ln_rstseed) THEN
+            ! Get saved state of the random number generator
+            DO jseed = 1 , 4
+               WRITE(clseed(5:5) ,'(i1.1)') jseed
+               WRITE(clseed(7:10),'(i4.4)') narea
+               CALL iom_get( numstor, clseed , zrseed(jseed) )
+            END DO
+            ziseed = TRANSFER( zrseed , ziseed)
+            CALL kiss_seed( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) )
+         ENDIF
+
+         ! Close the restart file
+         CALL iom_close( numstor )
+
+      ENDIF
+
+   END SUBROUTINE sto_rst_read
+
+
+   SUBROUTINE sto_rst_write( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_rst_write  ***
+      !!
+      !! ** Purpose :   write stochastic parameters in restart file
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! ocean time-step
+      !!
+      INTEGER  :: jsto, jseed
+      INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type
+      REAL(KIND=8)        ::   zrseed(4)           ! RNG seeds in real type (with same bits to save in restart)
+      CHARACTER(LEN=20)   ::   clkt                ! ocean time-step defined as a character
+      CHARACTER(LEN=50)   ::   clname              ! restart file name
+      CHARACTER(LEN=9)    ::   clsto2d='sto2d_000' ! stochastic parameter variable name
+      CHARACTER(LEN=9)    ::   clsto3d='sto3d_000' ! stochastic parameter variable name
+      CHARACTER(LEN=10)   ::   clseed='seed0_0000' ! seed variable name
+
+      IF ( jpsto2d > 0 .OR. jpsto3d > 0 ) THEN
+
+         IF( kt == nitrst .OR. kt == nitend ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'sto_rst_write : write stochastic parameters in restart file'
+               WRITE(numout,*) '~~~~~~~~~~~~~'
+            ENDIF
+         ENDIF
+
+         ! Put stochastic parameters in restart files
+         ! (as opened at previous timestep, see below)
+         IF( kt > nit000) THEN
+         IF( kt == nitrst .OR. kt == nitend ) THEN
+            ! get and save current state of the random number generator
+            CALL kiss_state( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) )
+            zrseed = TRANSFER( ziseed , zrseed)
+            DO jseed = 1 , 4
+               WRITE(clseed(5:5) ,'(i1.1)') jseed
+               WRITE(clseed(7:10),'(i4.4)') narea
+               CALL iom_rstput( kt, nitrst, numstow, clseed , zrseed(jseed) )
+            END DO
+            ! 2D stochastic parameters
+            DO jsto = 1 , jpsto2d
+               WRITE(clsto2d(7:9),'(i3.3)') jsto
+               CALL iom_rstput( kt, nitrst, numstow, clsto2d , sto2d(:,:,jsto) )
+            END DO
+            ! 3D stochastic parameters
+            DO jsto = 1 , jpsto3d
+               WRITE(clsto3d(7:9),'(i3.3)') jsto
+               CALL iom_rstput( kt, nitrst, numstow, clsto3d , sto3d(:,:,:,jsto) )
+            END DO
+            ! close the restart file
+            CALL iom_close( numstow )
+         ENDIF
+         ENDIF
+
+         ! Open the restart file one timestep before writing restart
+         IF( kt < nitend) THEN
+         IF( kt == nitrst - 1 .OR. nstock == 1 .OR. kt == nitend-1 ) THEN
+            ! create the filename
+            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
+            ENDIF
+            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_storst_out)
+            ! print information
+            IF(lwp) THEN
+               WRITE(numout,*) '             open stochastic parameters restart file: '//clname
+               IF( kt == nitrst - 1 ) THEN
+                  WRITE(numout,*) '             kt = nitrst - 1 = ', kt
+               ELSE
+                  WRITE(numout,*) '             kt = '             , kt
+               ENDIF
+            ENDIF
+            ! open the restart file
+            CALL iom_open( clname, numstow, ldwrt = .TRUE., kiolib = jprstlib )
+         ENDIF
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE sto_rst_write
+
+
+   SUBROUTINE sto_par_white( psto )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_par_white  ***
+      !!
+      !! ** Purpose :   fill input array with white Gaussian noise
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out)           ::   psto
+      !!
+      INTEGER  :: ji, jj
+      REAL(KIND=8) :: gran   ! Gaussian random number (forced KIND=8 as in kiss_gaussian)
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            CALL kiss_gaussian( gran )
+            psto(ji,jj) = gran
+         END DO
+      END DO
+
+   END SUBROUTINE sto_par_white
+
+
+   SUBROUTINE sto_par_flt( psto )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_par_flt  ***
+      !!
+      !! ** Purpose :   apply horizontal Laplacian filter to input array
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out)           ::   psto
+      !!
+      INTEGER  :: ji, jj
+
+      DO jj = 2, jpj-1
+         DO ji = 2, jpi-1
+            psto(ji,jj) = 0.5_wp * psto(ji,jj) + 0.125_wp * &
+                              &  ( psto(ji-1,jj) + psto(ji+1,jj) +  &
+                              &    psto(ji,jj-1) + psto(ji,jj+1) )
+         END DO
+      END DO
+
+   END SUBROUTINE sto_par_flt
+
+
+   FUNCTION sto_par_flt_fac( kpasses )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION sto_par_flt_fac  ***
+      !!
+      !! ** Purpose :   compute factor to restore standard deviation
+      !!                as a function of the number of passes
+      !!                of the Laplacian filter
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kpasses
+      REAL(wp) :: sto_par_flt_fac
+      !!
+      INTEGER :: jpasses, ji, jj, jflti, jfltj
+      INTEGER, DIMENSION(-1:1,-1:1) :: pflt0
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pfltb
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pflta
+      REAL(wp) :: ratio
+
+      pflt0(-1,-1) = 0 ; pflt0(-1,0) = 1 ; pflt0(-1,1) = 0
+      pflt0( 0,-1) = 1 ; pflt0( 0,0) = 4 ; pflt0( 0,1) = 1
+      pflt0( 1,-1) = 0 ; pflt0( 1,0) = 1 ; pflt0( 1,1) = 0
+
+      ALLOCATE(pfltb(-kpasses-1:kpasses+1,-kpasses-1:kpasses+1))
+      ALLOCATE(pflta(-kpasses-1:kpasses+1,-kpasses-1:kpasses+1))
+
+      pfltb(:,:) = 0
+      pfltb(0,0) = 1
+      DO jpasses = 1, kpasses
+        pflta(:,:) = 0
+        DO jflti= -1, 1
+        DO jfltj= -1, 1
+          DO ji= -kpasses, kpasses
+          DO jj= -kpasses, kpasses
+            pflta(ji,jj) = pflta(ji,jj) + pfltb(ji+jflti,jj+jfltj) * pflt0(jflti,jfltj)
+          ENDDO
+          ENDDO
+        ENDDO
+        ENDDO
+        pfltb(:,:) = pflta(:,:)
+      ENDDO
+
+      ratio = SUM(pfltb(:,:))
+      ratio = ratio * ratio / SUM(pfltb(:,:)*pfltb(:,:))
+      ratio = SQRT(ratio)
+
+      DEALLOCATE(pfltb,pflta)
+
+      sto_par_flt_fac = ratio
+
+   END FUNCTION sto_par_flt_fac
+
+
+END MODULE stopar
+
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/STO/stopts.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/STO/stopts.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/STO/stopts.F90	(revision 5682)
@@ -0,0 +1,146 @@
+MODULE stopts
+   !!==============================================================================
+   !!                       ***  MODULE  stopts  ***
+   !! Stochastic parameterization: compute stochastic tracer fluctuations
+   !!==============================================================================
+   !! History :  3.3  ! 2011-12 (J.-M. Brankart)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sto_pts        : compute current stochastic tracer fluctuations
+   !!   sto_pts_init   : initialisation for stochastic tracer fluctuations
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE lbclnk          ! lateral boundary conditions (or mpp link)
+   USE phycst          ! physical constants
+   USE stopar          ! stochastic parameterization
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sto_pts         ! called by step.F90
+   PUBLIC   sto_pts_init    ! called by nemogcm.F90
+
+   ! Public array with random tracer fluctuations
+   REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE :: pts_ran
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: eosbn2.F90 2528 2010-12-27 17:33:53Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sto_pts( pts )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_pts  ***
+      !!
+      !! ** Purpose :   Compute current stochastic tracer fluctuations
+      !!
+      !! ** Method  :   Compute tracer differences from a random walk
+      !!                around every model grid point
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) ::   pts   ! 1 : potential temperature  [Celsius]
+      !                                                               ! 2 : salinity               [psu]
+      INTEGER  ::   ji, jj, jk, jts, jdof ! dummy loop indices
+      INTEGER  ::   jim1, jjm1, jkm1  ! incremented indices
+      INTEGER  ::   jip1, jjp1, jkp1  !     -          -
+      REAL(wp) ::   zdtsim, zdtsjm, zdtskm         ! temporary scalars
+      REAL(wp) ::   zdtsip, zdtsjp, zdtskp, zdts   !     -        -
+      !!----------------------------------------------------------------------
+
+      DO jts = 1, jpts
+        CALL lbc_lnk( pts(:,:,:,jts), 'T' , 1._wp )
+      ENDDO
+
+      DO jdof = 1, nn_sto_eos
+        DO jts = 1, jpts
+           DO jk = 1, jpkm1
+              jkm1 = MAX(jk-1,1) ; jkp1 = MIN(jk+1,jpkm1)
+              DO jj = 1, jpj
+                 jjm1 = MAX(jj-1,1) ; jjp1 = MIN(jj+1,jpj)
+                 DO ji = 1, jpi
+                    jim1 = MAX(ji-1,1) ; jip1 = MIN(ji+1,jpi)
+                    !
+                    ! compute tracer gradient
+                    zdtsip = ( pts(jip1,jj,jk,jts) - pts(ji,jj,jk,jts) ) * tmask(jip1,jj,jk)
+                    zdtsim = ( pts(ji,jj,jk,jts) - pts(jim1,jj,jk,jts) ) * tmask(jim1,jj,jk)
+                    zdtsjp = ( pts(ji,jjp1,jk,jts) - pts(ji,jj,jk,jts) ) * tmask(ji,jjp1,jk)
+                    zdtsjm = ( pts(ji,jj,jk,jts) - pts(ji,jjm1,jk,jts) ) * tmask(ji,jjm1,jk)
+                    zdtskp = ( pts(ji,jj,jkp1,jts) - pts(ji,jj,jk,jts) ) * tmask(ji,jj,jkp1)
+                    zdtskm = ( pts(ji,jj,jk,jts) - pts(ji,jj,jkm1,jts) ) * tmask(ji,jj,jkm1)
+                    !
+                    ! compute random tracer fluctuation (zdts)
+                    zdts   = ( zdtsip + zdtsim ) * sto2d(ji,jj,jsto_eosi(jdof)) + &
+                           & ( zdtsjp + zdtsjm ) * sto2d(ji,jj,jsto_eosj(jdof)) + &
+                           & ( zdtskp + zdtskm ) * sto2d(ji,jj,jsto_eosk(jdof))
+!                   zdts   = zdtsip * MAX(sto2d(ji,jj,jsto_eosi),0._wp) + &
+!                          & zdtsim * MIN(sto2d(ji,jj,jsto_eosi),0._wp) + &
+!                          & zdtsjp * MAX(sto2d(ji,jj,jsto_eosj),0._wp) + &
+!                          & zdtsjm * MIN(sto2d(ji,jj,jsto_eosj),0._wp) + &
+!                          & zdtskp * MAX(sto2d(ji,jj,jsto_eosk),0._wp) + &
+!                          & zdtskm * MIN(sto2d(ji,jj,jsto_eosk),0._wp)
+                    zdts   = zdts  * tmask(ji,jj,jk) *SIN( gphit(ji,jj) * rad )
+                    pts_ran(ji,jj,jk,jts,jdof) = zdts * 0.5_wp
+                    !
+                  END DO
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Eliminate any possible negative salinity
+      DO jdof = 1, nn_sto_eos
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  pts_ran(ji,jj,jk,jp_sal,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_sal,jdof)) ,  &
+                                                &      MAX(pts(ji,jj,jk,jp_sal),0._wp) )     &
+                                                &  * SIGN(1._wp,pts_ran(ji,jj,jk,jp_sal,jdof))
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Eliminate any temperature lower than -2 degC
+!     DO jdof = 1, nn_sto_eos
+!        DO jk = 1, jpkm1
+!           DO jj = 1, jpj
+!              DO ji = 1, jpi
+!                 pts_ran(ji,jj,jk,jp_tem,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_tem,jdof)) ,    &
+!                                               &      MAX(pts(ji,jj,jk,jp_tem)+2._wp,0._wp) ) &
+!                                               &  * SIGN(1._wp,pts_ran(ji,jj,jk,jp_tem,jdof))
+!              END DO
+!           END DO
+!        END DO
+!     END DO
+
+
+      ! Lateral boundary conditions on pts_ran
+      DO jdof = 1, nn_sto_eos
+         DO jts = 1, jpts
+            CALL lbc_lnk( pts_ran(:,:,:,jts,jdof), 'T' , 1._wp )
+         END DO
+      END DO
+
+   END SUBROUTINE sto_pts
+
+
+   SUBROUTINE sto_pts_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_pts_init  ***
+      !!
+      !! ** Purpose :   Initialisation for stochastic tracer fluctuations
+      !!
+      !! ** Method  :   Allocate required array
+      !!
+      !!----------------------------------------------------------------------
+
+      ALLOCATE(pts_ran(jpi,jpj,jpk,jpts,nn_sto_eos))
+
+   END SUBROUTINE sto_pts_init
+
+END MODULE stopts
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/STO/storng.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/STO/storng.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/STO/storng.F90	(revision 5682)
@@ -0,0 +1,407 @@
+MODULE storng
+!$AGRIF_DO_NOT_TREAT
+   !!======================================================================
+   !!                       ***  MODULE  storng  ***
+   !! Random number generator, used in NEMO stochastic parameterization
+   !!
+   !!=====================================================================
+   !! History :  3.3  ! 2011-10 (J.-M. Brankart)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !! The module is based on (and includes) the
+   !! 64-bit KISS (Keep It Simple Stupid) random number generator
+   !! distributed by George Marsaglia :
+   !! http://groups.google.com/group/comp.lang.fortran/
+   !!        browse_thread/thread/a85bf5f2a97f5a55
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   kiss          : 64-bit KISS random number generator (period ~ 2^250)
+   !!   kiss_seed     : Define seeds for KISS random number generator
+   !!   kiss_state    : Get current state of KISS random number generator
+   !!   kiss_save     : Save current state of KISS (for future restart)
+   !!   kiss_load     : Load the saved state of KISS
+   !!   kiss_reset    : Reset the default seeds
+   !!   kiss_check    : Check the KISS pseudo-random sequence
+   !!   kiss_uniform  : Real random numbers with uniform distribution in [0,1]
+   !!   kiss_gaussian : Real random numbers with Gaussian distribution N(0,1)
+   !!   kiss_gamma    : Real random numbers with Gamma distribution Gamma(k,1)
+   !!   kiss_sample   : Select a random sample from a set of integers
+   !!
+   !!   ---CURRENTLY NOT USED IN NEMO :
+   !!   kiss_save, kiss_load, kiss_check, kiss_gamma, kiss_sample
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE lib_mpp
+
+   IMPLICIT NONE
+   PRIVATE
+
+   ! Public functions/subroutines
+   PUBLIC :: kiss, kiss_seed, kiss_state, kiss_reset ! kiss_save, kiss_load, kiss_check
+   PUBLIC :: kiss_uniform, kiss_gaussian, kiss_gamma, kiss_sample
+
+   ! Default/initial seeds
+   INTEGER(KIND=i8) :: x=1234567890987654321_8
+   INTEGER(KIND=i8) :: y=362436362436362436_8
+   INTEGER(KIND=i8) :: z=1066149217761810_8
+   INTEGER(KIND=i8) :: w=123456123456123456_8
+
+   ! Parameters to generate real random variates
+   REAL(KIND=wp), PARAMETER :: huge64=9223372036854775808.0  ! +1
+   REAL(KIND=wp), PARAMETER :: zero=0.0, half=0.5, one=1.0, two=2.0
+
+   ! Variables to store 2 Gaussian random numbers with current index (ig)
+   INTEGER(KIND=i8), SAVE :: ig=1
+   REAL(KIND=wp), SAVE :: gran1, gran2
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: dynhpg.F90 2528 2010-12-27 17:33:53Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION kiss()
+      !! --------------------------------------------------------------------
+      !!                  ***  FUNCTION kiss  ***
+      !!
+      !! ** Purpose :   64-bit KISS random number generator
+      !!
+      !! ** Method  :   combine several random number generators:
+      !!                (1) Xorshift (XSH), period 2^64-1,
+      !!                (2) Multiply-with-carry (MWC), period (2^121+2^63-1)
+      !!                (3) Congruential generator (CNG), period 2^64.
+      !!
+      !!                overall period:
+      !!                (2^250+2^192+2^64-2^186-2^129)/6
+      !!                            ~= 2^(247.42) or 10^(74.48)
+      !!
+      !!                set your own seeds with 'kiss_seed'
+      ! --------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER(KIND=i8) :: kiss, t
+
+      t = ISHFT(x,58) + w
+      IF (s(x).eq.s(t)) THEN
+         w = ISHFT(x,-6) + s(x)
+      ELSE
+         w = ISHFT(x,-6) + 1 - s(x+t)
+      ENDIF
+      x = t + x
+      y = m( m( m(y,13_8), -17_8 ), 43_8 )
+      z = 6906969069_8 * z + 1234567_8
+
+      kiss = x + y + z
+
+      CONTAINS
+
+         FUNCTION s(k)
+            INTEGER(KIND=i8) :: s, k
+            s = ISHFT(k,-63)
+         END FUNCTION s
+
+         FUNCTION m(k, n)
+            INTEGER(KIND=i8) :: m, k, n
+            m =  IEOR(k, ISHFT(k, n) )
+         END FUNCTION m
+
+   END FUNCTION kiss
+
+
+   SUBROUTINE kiss_seed(ix, iy, iz, iw)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_seed  ***
+      !!
+      !! ** Purpose :   Define seeds for KISS random number generator
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER(KIND=i8) :: ix, iy, iz, iw
+
+      x = ix
+      y = iy
+      z = iz
+      w = iw
+
+   END SUBROUTINE kiss_seed
+
+
+   SUBROUTINE kiss_state(ix, iy, iz, iw)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_state  ***
+      !!
+      !! ** Purpose :   Get current state of KISS random number generator
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER(KIND=i8) :: ix, iy, iz, iw
+
+      ix = x
+      iy = y
+      iz = z
+      iw = w
+
+   END SUBROUTINE kiss_state
+
+
+   SUBROUTINE kiss_reset()
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_reset  ***
+      !!
+      !! ** Purpose :   Reset the default seeds for KISS random number generator
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+
+      x=1234567890987654321_8
+      y=362436362436362436_8
+      z=1066149217761810_8
+      w=123456123456123456_8
+
+    END SUBROUTINE kiss_reset
+
+
+   !  SUBROUTINE kiss_check(check_type)
+   !    !! --------------------------------------------------------------------
+   !    !!                  ***  ROUTINE kiss_check  ***
+   !    !!
+   !    !! ** Purpose :   Check the KISS pseudo-random sequence
+   !    !!
+   !    !! ** Method  :   Check that it reproduces the correct sequence
+   !    !!                from the default seed
+   !    !!
+   !    !! --------------------------------------------------------------------
+   !    IMPLICIT NONE
+   !    INTEGER(KIND=i8) :: iter, niter, correct, iran
+   !    CHARACTER(LEN=*) :: check_type
+   !    LOGICAL :: print_success
+
+   !    ! Save current state of KISS
+   !    CALL kiss_save()
+   !    ! Reset the default seed
+   !    CALL kiss_reset()
+
+   !    ! Select check type
+   !    SELECT CASE(check_type)
+   !    CASE('short')
+   !       niter = 5_8
+   !       correct = 542381058189297533
+   !       print_success = .FALSE.
+   !    CASE('long')
+   !       niter = 100000000_8
+   !       correct = 1666297717051644203 ! Check provided by G. Marsaglia
+   !       print_success = .TRUE.
+   !    CASE('default')
+   !    CASE DEFAULT
+   !       STOP 'Bad check type in kiss_check'
+   !    END SELECT
+
+   !    ! Run kiss for the required number of iterations (niter)
+   !    DO iter=1,niter
+   !       iran = kiss()
+   !    ENDDO
+
+   !    ! Check that last iterate is correct
+   !    IF (iran.NE.correct) THEN
+   !       STOP 'Check failed: KISS internal error !!'
+   !    ELSE
+   !       IF (print_success) PRINT *, 'Check successful: 100 million calls to KISS OK'
+   !    ENDIF
+
+   !    ! Reload the previous state of KISS
+   !    CALL kiss_load()
+
+   ! END SUBROUTINE kiss_check
+
+
+   ! SUBROUTINE kiss_save
+   !    !! --------------------------------------------------------------------
+   !    !!                  ***  ROUTINE kiss_save  ***
+   !    !!
+   !    !! ** Purpose :   Save current state of KISS random number generator
+   !    !!
+   !    !! --------------------------------------------------------------------
+   !    INTEGER :: inum     !! Local integer
+
+   !    IMPLICIT NONE
+
+   !    CALL ctl_opn( inum, '.kiss_restart', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+
+   !    ! OPEN(UNIT=30,FILE='.kiss_restart')
+   !    WRITE(inum,*) x
+   !    WRITE(inum,*) y
+   !    WRITE(inum,*) z
+   !    WRITE(inum,*) w
+   !    CALL flush(inum)
+
+   !  END SUBROUTINE kiss_save
+
+
+   !  SUBROUTINE kiss_load
+   !    !! --------------------------------------------------------------------
+   !    !!                  ***  ROUTINE kiss_load  ***
+   !    !!
+   !    !! ** Purpose :   Load the saved state of KISS random number generator
+   !    !!
+   !    !! --------------------------------------------------------------------
+   !    IMPLICIT NONE
+   !    LOGICAL :: filexists
+   ! Use ctl_opn routine rather than fortran intrinsic functions
+   !    INQUIRE(FILE='.kiss_restart',EXIST=filexists)
+   !    IF (filexists) THEN
+   !       OPEN(UNIT=30,FILE='.kiss_restart')
+   !       READ(30,*) x
+   !       READ(30,*) y
+   !       READ(30,*) z
+   !       READ(30,*) w
+   !       CLOSE(30)
+   !    ENDIF
+
+   ! END SUBROUTINE kiss_load
+
+
+   SUBROUTINE kiss_uniform(uran)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_uniform  ***
+      !!
+      !! ** Purpose :   Real random numbers with uniform distribution in [0,1]
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL(KIND=wp) :: uran
+
+      uran = half * ( one + REAL(kiss(),wp) / huge64 )
+
+   END SUBROUTINE kiss_uniform
+
+
+   SUBROUTINE kiss_gaussian(gran)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_gaussian  ***
+      !!
+      !! ** Purpose :   Real random numbers with Gaussian distribution N(0,1)
+      !!
+      !! ** Method  :   Generate 2 new Gaussian draws (gran1 and gran2)
+      !!                from 2 uniform draws on [-1,1] (u1 and u2),
+      !!                using the Marsaglia polar method
+      !!                (see Devroye, Non-Uniform Random Variate Generation, p. 235-236)
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL(KIND=wp) :: gran, u1, u2, rsq, fac
+
+      IF (ig.EQ.1) THEN
+         rsq = two
+         DO WHILE ( (rsq.GE.one).OR. (rsq.EQ.zero) )
+            u1 = REAL(kiss(),wp) / huge64
+            u2 = REAL(kiss(),wp) / huge64
+            rsq = u1*u1 + u2*u2
+         ENDDO
+         fac = SQRT(-two*LOG(rsq)/rsq)
+         gran1 = u1 * fac
+         gran2 = u2 * fac
+      ENDIF
+
+      ! Output one of the 2 draws
+      IF (ig.EQ.1) THEN
+         gran = gran1 ; ig = 2
+      ELSE
+         gran = gran2 ; ig = 1
+      ENDIF
+
+   END SUBROUTINE kiss_gaussian
+
+
+   SUBROUTINE kiss_gamma(gamr,k)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_gamma  ***
+      !!
+      !! ** Purpose :   Real random numbers with Gamma distribution Gamma(k,1)
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL(KIND=wp), PARAMETER :: p1 = 4.5_8
+      REAL(KIND=wp), PARAMETER :: p2 = 2.50407739677627_8  ! 1+LOG(9/2)
+      REAL(KIND=wp), PARAMETER :: p3 = 1.38629436111989_8  ! LOG(4)
+      REAL(KIND=wp) :: gamr, k, u1, u2, b, c, d, xx, yy, zz, rr, ee
+      LOGICAL :: accepted
+
+      IF (k.GT.one) THEN
+         ! Cheng's rejection algorithm
+         ! (see Devroye, Non-Uniform Random Variate Generation, p. 413)
+         b = k - p3 ; d = SQRT(two*k-one) ; c = k + d
+
+         accepted=.FALSE.
+         DO WHILE (.NOT.accepted)
+            CALL kiss_uniform(u1)
+            yy = LOG(u1/(one-u1)) / d  ! Mistake in Devroye: "* k" instead of "/ d"
+            xx = k * EXP(yy)
+            rr = b + c * yy - xx
+            CALL kiss_uniform(u2)
+            zz = u1 * u1 * u2
+
+            accepted = rr .GE. (zz*p1-p2)
+            IF (.NOT.accepted) accepted =  rr .GE. LOG(zz)
+         ENDDO
+
+         gamr = xx
+
+      ELSEIF (k.LT.one) THEN
+        ! Rejection from the Weibull density
+        ! (see Devroye, Non-Uniform Random Variate Generation, p. 415)
+        c = one/k ; d = (one-k) * EXP( (k/(one-k)) * LOG(k) )
+
+        accepted=.FALSE.
+        DO WHILE (.NOT.accepted)
+           CALL kiss_uniform(u1)
+           zz = -LOG(u1)
+           xx = EXP( c * LOG(zz) )
+           CALL kiss_uniform(u2)
+           ee = -LOG(u2)
+
+           accepted = (zz+ee) .GE. (d+xx)  ! Mistake in Devroye: "LE" instead of "GE"
+        ENDDO
+
+        gamr = xx
+
+      ELSE
+         ! Exponential distribution
+         CALL kiss_uniform(u1)
+         gamr = -LOG(u1)
+
+      ENDIF
+
+   END SUBROUTINE kiss_gamma
+
+
+   SUBROUTINE kiss_sample(a,n,k)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_sample  ***
+      !!
+      !! ** Purpose :   Select a random sample of size k from a set of n integers
+      !!
+      !! ** Method  :   The sample is output in the first k elements of a
+      !!                Set k equal to n to obtain a random permutation
+      !!                  of the whole set of integers
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER(KIND=i8), DIMENSION(:) :: a
+      INTEGER(KIND=i8) :: n, k, i, j, atmp
+      REAL(KIND=wp) :: uran
+
+      ! Select the sample using the swapping method
+      ! (see Devroye, Non-Uniform Random Variate Generation, p. 612)
+      DO i=1,k
+         ! Randomly select the swapping element between i and n (inclusive)
+         CALL kiss_uniform(uran)
+         j = i - 1 + CEILING( REAL(n-i+1,8) * uran )
+         ! Swap elements i and j
+         atmp = a(i) ; a(i) = a(j) ; a(j) = atmp
+      ENDDO
+
+   END SUBROUTINE kiss_sample
+!$AGRIF_END_DO_NOT_TREAT
+END MODULE storng
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 5682)
@@ -22,4 +22,5 @@
    !!             -   ! 2013-04  (F. Roquet, G. Madec)  add eos_rab, change bn2 computation and reorganize the module
    !!             -   ! 2014-09  (F. Roquet)  add TEOS-10, S-EOS, and modify EOS-80
+   !!             -   ! 2015-06  (P.A. Bouttier) eos_fzp functions changed to subroutines for AGRIF
    !!----------------------------------------------------------------------
 
@@ -47,4 +48,6 @@
    USE lbclnk         ! ocean lateral boundary conditions
    USE timing          ! Timing
+   USE stopar          ! Stochastic T/S fluctuations
+   USE stopts          ! Stochastic T/S fluctuations
 
    IMPLICIT NONE
@@ -72,7 +75,7 @@
    PUBLIC   eos_init       ! called by istate module
 
-   !                                          !!* Namelist (nameos) *
-   INTEGER , PUBLIC ::   nn_eos   = 0         !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
-   LOGICAL , PUBLIC ::   ln_useCT  = .FALSE.  ! determine if eos_pt_from_ct is used to compute sst_m
+   !                                !!* Namelist (nameos) *
+   INTEGER , PUBLIC ::   nn_eos     ! = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
+   LOGICAL , PUBLIC ::   ln_useCT   ! determine if eos_pt_from_ct is used to compute sst_m
 
    !                                   !!!  simplified eos coefficients
@@ -313,7 +316,9 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m]
       !
-      INTEGER  ::   ji, jj, jk                ! dummy loop indices
-      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars
-      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
+      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices
+      INTEGER  ::   jdof
+      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      -
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors
       !!----------------------------------------------------------------------
       !
@@ -324,43 +329,108 @@
       CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==!
          !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  !
-                  zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
-                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
-                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-                  ztm = tmask(ji,jj,jk)                                         ! tmask
-                  !
-                  zn3 = EOS013*zt   &
-                     &   + EOS103*zs+EOS003
-                     !
-                  zn2 = (EOS022*zt   &
-                     &   + EOS112*zs+EOS012)*zt   &
-                     &   + (EOS202*zs+EOS102)*zs+EOS002
-                     !
-                  zn1 = (((EOS041*zt   &
-                     &   + EOS131*zs+EOS031)*zt   &
-                     &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
-                     &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
-                     &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
-                     !
-                  zn0 = (((((EOS060*zt   &
-                     &   + EOS150*zs+EOS050)*zt   &
-                     &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
-                     &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
-                     &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
-                     &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
-                     &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
-                     !
-                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
-                  !
-                  prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface
-                  !
-                  prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked)
+         ! Stochastic equation of state
+         IF ( ln_sto_eos ) THEN
+            ALLOCATE(zn0_sto(1:2*nn_sto_eos))
+            ALLOCATE(zn_sto(1:2*nn_sto_eos))
+            ALLOCATE(zsign(1:2*nn_sto_eos))
+            DO jsmp = 1, 2*nn_sto_eos, 2
+              zsign(jsmp)   = 1._wp
+              zsign(jsmp+1) = -1._wp
+            END DO
+            !
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     !
+                     ! compute density (2*nn_sto_eos) times:
+                     ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts)
+                     ! (2) for t-dt, s-ds (with the opposite fluctuation)
+                     DO jsmp = 1, nn_sto_eos*2
+                        jdof   = (jsmp + 1) / 2
+                        zh     = pdep(ji,jj,jk) * r1_Z0                                  ! depth
+                        zt     = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0    ! temperature
+                        zstemp = pts  (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp)
+                        zs     = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 )   ! square root salinity
+                        ztm    = tmask(ji,jj,jk)                                         ! tmask
+                        !
+                        zn3 = EOS013*zt   &
+                           &   + EOS103*zs+EOS003
+                           !
+                        zn2 = (EOS022*zt   &
+                           &   + EOS112*zs+EOS012)*zt   &
+                           &   + (EOS202*zs+EOS102)*zs+EOS002
+                           !
+                        zn1 = (((EOS041*zt   &
+                           &   + EOS131*zs+EOS031)*zt   &
+                           &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
+                           &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
+                           &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+                           !
+                        zn0_sto(jsmp) = (((((EOS060*zt   &
+                           &   + EOS150*zs+EOS050)*zt   &
+                           &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
+                           &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
+                           &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
+                           &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
+                           &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+                           !
+                        zn_sto(jsmp)  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp)
+                     END DO
+                     !
+                     ! compute stochastic density as the mean of the (2*nn_sto_eos) densities
+                     prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp
+                     DO jsmp = 1, nn_sto_eos*2
+                        prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp)                      ! potential density referenced at the surface
+                        !
+                        prd(ji,jj,jk) = prd(ji,jj,jk) + (  zn_sto(jsmp) * r1_rau0 - 1._wp  )   ! density anomaly (masked)
+                     END DO
+                     prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos
+                     prd  (ji,jj,jk) = 0.5_wp * prd  (ji,jj,jk) * ztm / nn_sto_eos
+                  END DO
                END DO
             END DO
-         END DO
-         !
+            DEALLOCATE(zn0_sto,zn_sto,zsign)
+         ! Non-stochastic equation of state
+         ELSE
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     !
+                     zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
+                     zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
+                     zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+                     ztm = tmask(ji,jj,jk)                                         ! tmask
+                     !
+                     zn3 = EOS013*zt   &
+                        &   + EOS103*zs+EOS003
+                        !
+                     zn2 = (EOS022*zt   &
+                        &   + EOS112*zs+EOS012)*zt   &
+                        &   + (EOS202*zs+EOS102)*zs+EOS002
+                        !
+                     zn1 = (((EOS041*zt   &
+                        &   + EOS131*zs+EOS031)*zt   &
+                        &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
+                        &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
+                        &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+                        !
+                     zn0 = (((((EOS060*zt   &
+                        &   + EOS150*zs+EOS050)*zt   &
+                        &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
+                        &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
+                        &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
+                        &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
+                        &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+                        !
+                     zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+                     !
+                     prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface
+                     !
+                     prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         
       CASE( 1 )                !==  simplified EOS  ==!
          !
@@ -922,5 +992,5 @@
 
 
-   FUNCTION eos_fzp_2d( psal, pdep ) RESULT( ptf )
+   SUBROUTINE  eos_fzp_2d( psal, ptf, pdep )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE eos_fzp  ***
@@ -936,5 +1006,5 @@
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu]
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m]
-      REAL(wp), DIMENSION(jpi,jpj)                          ::   ptf   ! freezing temperature [Celcius]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celcius]
       !
       INTEGER  ::   ji, jj   ! dummy loop indices
@@ -969,9 +1039,9 @@
          nstop = nstop + 1
          !
-      END SELECT
-      !
-   END FUNCTION eos_fzp_2d
-
-  FUNCTION eos_fzp_0d( psal, pdep ) RESULT( ptf )
+      END SELECT      
+      !
+  END SUBROUTINE eos_fzp_2d
+
+  SUBROUTINE eos_fzp_0d( psal, ptf, pdep )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE eos_fzp  ***
@@ -985,7 +1055,7 @@
       !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in)           ::   psal   ! salinity   [psu]
-      REAL(wp), INTENT(in), OPTIONAL ::   pdep   ! depth      [m]
-      REAL(wp)                       ::   ptf   ! freezing temperature [Celcius]
+      REAL(wp), INTENT(in )           ::   psal         ! salinity   [psu]
+      REAL(wp), INTENT(in ), OPTIONAL ::   pdep         ! depth      [m]
+      REAL(wp), INTENT(out)           ::   ptf          ! freezing temperature [Celcius]
       !
       REAL(wp) :: zs   ! local scalars
@@ -1017,5 +1087,5 @@
       END SELECT
       !
-   END FUNCTION eos_fzp_0d
+   END SUBROUTINE eos_fzp_0d
 
 
@@ -1183,4 +1253,6 @@
             WRITE(numout,*) '             model uses Conservative Temperature'
             WRITE(numout,*) '             Important: model must be initialized with CT and SA fields'
+         ELSE
+            WRITE(numout,*) '             model does not use Conservative Temperature'
          ENDIF
       ENDIF
@@ -1589,7 +1661,8 @@
       END SELECT
       !
+      rau0_rcp    = rau0 * rcp 
       r1_rau0     = 1._wp / rau0
       r1_rcp      = 1._wp / rcp
-      r1_rau0_rcp = 1._wp / ( rau0 * rcp )
+      r1_rau0_rcp = 1._wp / rau0_rcp 
       !
       IF(lwp) WRITE(numout,*)
@@ -1597,4 +1670,5 @@
       IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg'
       IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin'
+      IF(lwp) WRITE(numout,*) '          rau0 * rcp                       rau0_rcp = ', rau0_rcp
       IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 5682)
@@ -26,4 +26,5 @@
    USE cla             ! cross land advection      (cla_traadv     routine)
    USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   !
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
@@ -33,4 +34,5 @@
    USE timing          ! Timing
    USE sbc_oce
+   USE diaptr          ! Poleward heat transport 
 
 
@@ -111,16 +113,20 @@
       !
       IF( ln_mle    )   CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the mle transport (if necessary)
+      !
       CALL iom_put( "uocetr_eff", zun )                                         ! output effective transport      
       CALL iom_put( "vocetr_eff", zvn )
       CALL iom_put( "wocetr_eff", zwn )
-
+      !
+      IF( ln_diaptr )   CALL dia_ptr( zvn )                                     ! diagnose the effective MSF 
+      !
+   
       SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
-      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered
-      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD 
-      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts, ln_traadv_msc_ups )   !  MUSCL 
-      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2 
-      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS 
-      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST 
-      CASE ( 7 )   ;   CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD ZTS
+      CASE ( 1 )   ;    CALL tra_adv_cen2   ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered
+      CASE ( 2 )   ;    CALL tra_adv_tvd    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD 
+      CASE ( 3 )   ;    CALL tra_adv_muscl  ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts, ln_traadv_msc_ups )   !  MUSCL 
+      CASE ( 4 )   ;    CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2 
+      CASE ( 5 )   ;    CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS 
+      CASE ( 6 )   ;    CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST 
+      CASE ( 7 )   ;    CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD ZTS
       !
       CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
@@ -206,6 +212,6 @@
       IF( lk_esopa         )   ioptio =          1
 
-      IF( ( ln_traadv_muscl .OR. ln_traadv_muscl2 .OR. ln_traadv_ubs .OR. ln_traadv_qck ) .AND. nn_isf .NE. 0 )  &
-      &   CALL ctl_stop( 'Only traadv_cen2 and traadv_tvd is compatible with ice shelf cavity')
+      IF( ( ln_traadv_muscl .OR. ln_traadv_muscl2 .OR. ln_traadv_ubs .OR. ln_traadv_qck .OR. ln_traadv_tvd_zts )   &
+         .AND. ln_isfcav )   CALL ctl_stop( 'Only traadv_cen2 and traadv_tvd is compatible with ice shelf cavity')
 
       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 5682)
@@ -173,5 +173,5 @@
          END DO 
       END DO 
-      zfzp(:,:) = eos_fzp( tsn(:,:,1,jp_sal), zpres(:,:) )
+      CALL eos_fzp( tsn(:,:,1,jp_sal), zfzp(:,:), zpres(:,:) )
       DO jk = 1, jpk
          DO jj = 1, jpj
@@ -279,7 +279,7 @@
          END IF
          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
-           IF( jn == jp_tem )   htr_adv(:) = ptr_vj( zwy(:,:,:) )
-           IF( jn == jp_sal )   str_adv(:) = ptr_vj( zwy(:,:,:) )
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )   htr_adv(:) = ptr_sj( zwy(:,:,:) )
+           IF( jn == jp_sal )   str_adv(:) = ptr_sj( zwy(:,:,:) )
          ENDIF
          !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 5682)
@@ -212,5 +212,6 @@
       CHARACTER(len=3) ::   cdtype
       REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn
-      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1)
+      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?',   &
+         &    kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1)
    END SUBROUTINE tra_adv_eiv
 #endif
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90	(revision 5682)
@@ -53,5 +53,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id:$
+   !! $Id$
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 5682)
@@ -21,5 +21,5 @@
    USE trdtra         ! tracers trends manager
    USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient
-   USE sbcrnf          ! river runoffs
+   USE sbcrnf         ! river runoffs
    USE diaptr         ! poleward transport diagnostics
    !
@@ -219,7 +219,7 @@
          END IF
          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
-            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
-            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
+            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
          ENDIF
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 5682)
@@ -200,7 +200,7 @@
 
          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
-            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
-            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
+            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
          ENDIF
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 5682)
@@ -355,7 +355,7 @@
          IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )
          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
-           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
          ENDIF
          !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 5682)
@@ -106,14 +106,15 @@
       ENDIF
       !
-      zwi(:,:,:) = 0.e0 ; zwz(:,:,:) = 0.e0
+      zwi(:,:,:) = 0.e0 ; 
       !
       !                                                          ! ===========
       DO jn = 1, kjpt                                            ! tracer loop
          !                                                       ! ===========
-         ! 1. Bottom value : flux set to zero
+         ! 1. Bottom and k=1 value : flux set to zero
          ! ----------------------------------
          zwx(:,:,jpk) = 0.e0    ;    zwz(:,:,jpk) = 0.e0
          zwy(:,:,jpk) = 0.e0    ;    zwi(:,:,jpk) = 0.e0
-
+          
+         zwz(:,:,1  ) = 0._wp
          ! 2. upstream advection with initial mass fluxes & intermediate update
          ! --------------------------------------------------------------------
@@ -134,28 +135,36 @@
 
          ! upstream tracer flux in the k direction
+         ! Interior value
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
          ! Surface value
          IF( lk_vvl ) THEN   
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zwz(ji,jj, mikt(ji,jj) ) = 0.e0                         ! volume variable
-               END DO
-            END DO
+            IF ( ln_isfcav ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = 0.e0          ! volume variable
+                  END DO
+               END DO
+            ELSE
+               zwz(:,:,1) = 0.e0          ! volume variable
+            END IF
          ELSE                
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
-               END DO
-            END DO   
+            IF ( ln_isfcav ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                  END DO
+               END DO   
+            ELSE
+               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface
+            END IF
          ENDIF
-         ! Interior value
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               DO jk = mikt(ji,jj)+1, jpkm1
-                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
-                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
-                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) )
-               END DO
-            END DO
-         END DO
 
          ! total advective trend
@@ -184,7 +193,7 @@
          END IF
          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
-           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
          ENDIF
 
@@ -202,17 +211,22 @@
       
          ! antidiffusive flux on k
-         zwz(:,:,1) = 0.e0         ! Surface value
-         !
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ik=mikt(ji,jj)
-               ! surface value
-               zwz(ji,jj,1:ik) = 0.e0
-               ! Interior value
-               DO jk = mikt(ji,jj)+1, jpkm1                    
+         ! Interior value
+         DO jk = 2, jpkm1                    
+            DO jj = 1, jpj
+               DO ji = 1, jpi
                   zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk)
                END DO
             END DO
          END DO
+         ! surface value
+         IF ( ln_isfcav ) THEN
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zwz(ji,jj,mikt(ji,jj)) = 0.e0
+               END DO
+            END DO
+         ELSE
+            zwz(:,:,1) = 0.e0
+         END IF
          CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
          CALL lbc_lnk( zwz, 'W',  1. )
@@ -250,7 +264,7 @@
          END IF
          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:)
-           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:)
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)
+           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)
          ENDIF
          !
@@ -358,8 +372,4 @@
 
          ! upstream tracer flux in the k direction
-         ! Surface value
-         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0._wp                        ! volume variable
-         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface 
-         ENDIF
          ! Interior value
          DO jk = 2, jpkm1
@@ -372,4 +382,26 @@
             END DO
          END DO
+         ! Surface value
+         IF( lk_vvl ) THEN
+            IF ( ln_isfcav ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = 0.e0          ! volume variable +    isf
+                  END DO
+               END DO
+            ELSE
+               zwz(:,:,1) = 0.e0                              ! volume variable + no isf
+            END IF
+         ELSE
+            IF ( ln_isfcav ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface +    isf
+                  END DO
+               END DO
+            ELSE
+               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)                                               ! linear free surface + no isf
+            END IF
+         ENDIF
 
          ! total advective trend
@@ -398,7 +430,7 @@
          END IF
          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
-           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) )
          ENDIF
 
@@ -524,7 +556,7 @@
          END IF
          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
-           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:)
-           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:)
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)
+           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)
          ENDIF
          !
@@ -580,10 +612,10 @@
          &        paft * tmask + zbig * ( 1._wp - tmask )  )
 
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            DO jk = mikt(ji,jj), jpkm1
-               ikm1 = MAX(jk-1,mikt(ji,jj))
-               z2dtt = p2dt(jk)
-               
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         z2dtt = p2dt(jk)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+
                ! search maximum in neighbourhood
                zup = MAX(  zbup(ji  ,jj  ,jk  ),   &
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 5682)
@@ -177,7 +177,7 @@
          END IF
          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
-            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( ztv(:,:,:) )
-            IF( jn == jp_sal )  str_adv(:) = ptr_vj( ztv(:,:,:) )
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( ztv(:,:,:) )
+            IF( jn == jp_sal )  str_adv(:) = ptr_sj( ztv(:,:,:) )
          ENDIF
          
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 5682)
@@ -21,4 +21,8 @@
    USE trdtra          ! trends manager: tracers 
    USE in_out_manager  ! I/O manager
+   USE iom             ! I/O manager
+   USE fldread         ! read input fields
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp           ! distributed memory computing library
    USE prtctl          ! Print control
    USE wrk_nemo        ! Memory Allocation
@@ -37,4 +41,5 @@
 
    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh              ! structure of input qgh (file informations, fields read)
  
    !! * Substitutions
@@ -42,5 +47,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id $ 
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -92,4 +97,6 @@
       END DO
       !
+      CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. )
+      !
       IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
@@ -125,6 +132,10 @@
       INTEGER  ::   inum                ! temporary logical unit
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      !
-      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst 
+      INTEGER  ::   ierror              ! local integer
+      !
+      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read
+      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files
+      !
+      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
       !!----------------------------------------------------------------------
 
@@ -161,8 +172,18 @@
          CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
             IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux'
-            CALL iom_open ( 'geothermal_heating.nc', inum )
-            CALL iom_get  ( inum, jpdom_data, 'heatflow', qgh_trd0 )
-            CALL iom_close( inum )
-            qgh_trd0(:,:) = r1_rau0_rcp * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2
+            !
+            ALLOCATE( sf_qgh(1), STAT=ierror )
+            IF( ierror > 0 ) THEN
+               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
+               RETURN
+            ENDIF
+            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
+            IF( sn_qgh%ln_tint )ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
+            ! fill sf_chl with sn_chl and control print
+            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
+               &          'bottom temperature boundary condition', 'nambbc' )
+
+            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
+            qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
             !
          CASE DEFAULT
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 5682)
@@ -21,7 +21,4 @@
    !!   tra_dmp       : update the tracer trend with the internal damping
    !!   tra_dmp_init  : initialization, namlist read, parameters control
-   !!   dtacof_zoom   : restoring coefficient for zoom domain
-   !!   dtacof        : restoring coefficient for global domain
-   !!   cofdis        : compute the distance to the coastline
    !!----------------------------------------------------------------------
    USE oce            ! ocean: variables
@@ -39,4 +36,5 @@
    USE wrk_nemo       ! Memory allocation
    USE timing         ! Timing
+   USE iom
 
    IMPLICIT NONE
@@ -45,17 +43,12 @@
    PUBLIC   tra_dmp      ! routine called by step.F90
    PUBLIC   tra_dmp_init ! routine called by opa.F90
-   PUBLIC   dtacof       ! routine called by tradmp.F90, trcdmp.F90 and dyndmp.F90
-   PUBLIC   dtacof_zoom  ! routine called by tradmp.F90, trcdmp.F90 and dyndmp.F90
-
-!!gm  why all namelist variable public????   only ln_tradmp should be sufficient
 
    !                               !!* Namelist namtra_dmp : T & S newtonian damping *
+   ! nn_zdmp and cn_resto are public as they are used by C1D/dyndmp.F90
    LOGICAL , PUBLIC ::   ln_tradmp   !: internal damping flag
-   INTEGER , PUBLIC ::   nn_hdmp     ! = 0/-1/'latitude' for damping over T and S
    INTEGER , PUBLIC ::   nn_zdmp     ! = 0/1/2 flag for damping in the mixed layer
-   REAL(wp), PUBLIC ::   rn_surf     ! surface time scale for internal damping        [days]
-   REAL(wp), PUBLIC ::   rn_bot      ! bottom time scale for internal damping         [days]
-   REAL(wp), PUBLIC ::   rn_dep      ! depth of transition between rn_surf and rn_bot [meters]
-   INTEGER , PUBLIC ::   nn_file     ! = 1 create a damping.coeff NetCDF file 
+   CHARACTER(LEN=200) , PUBLIC :: cn_resto      ! name of netcdf file containing restoration coefficient field
+   !
+
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   strdmp   !: damping salinity trend (psu/s)
@@ -197,623 +190,60 @@
       !! ** Method  :   read the namtra_dmp namelist and check the parameters
       !!----------------------------------------------------------------------
-      INTEGER  ::   ios   ! Local integer output status for namelist read
-      !!
-      NAMELIST/namtra_dmp/ ln_tradmp, nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file
-      !!----------------------------------------------------------------------
-      !
-      REWIND( numnam_ref )              ! Namelist namtra_dmp in reference namelist : Temperature and salinity damping term
+      NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
+      INTEGER ::  ios         ! Local integer for output status of namelist read
+      INTEGER :: imask        ! File handle 
+      !!
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )   ! Namelist namtra_dmp in reference namelist : T & S relaxation
       READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp )
       !
-      REWIND( numnam_cfg )              ! Namelist namtra_dmp in configuration namelist : Temperature and salinity damping term
+      REWIND( numnam_cfg )   ! Namelist namtra_dmp in configuration namelist : T & S relaxation
       READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namtra_dmp )
-      
-      IF( lzoom .AND. .NOT. lk_c1d )   nn_zdmp = 0          ! restoring to climatology at closed north or south boundaries
-
-      IF(lwp) THEN                       ! Namelist print
+
+      IF(lwp) THEN                 !Namelist print
          WRITE(numout,*)
-         WRITE(numout,*) 'tra_dmp_init : T and S newtonian damping'
+         WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
          WRITE(numout,*) '~~~~~~~'
-         WRITE(numout,*) '   Namelist namtra_dmp : set damping parameter'
-         WRITE(numout,*) '      add a damping term or not       ln_tradmp = ', ln_tradmp
-         WRITE(numout,*) '      T and S damping option          nn_hdmp   = ', nn_hdmp
-         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp, '(non-C1D zoom: forced to 0)'
-         WRITE(numout,*) '      surface time scale (days)       rn_surf   = ', rn_surf
-         WRITE(numout,*) '      bottom time scale (days)        rn_bot    = ', rn_bot
-         WRITE(numout,*) '      depth of transition (meters)    rn_dep    = ', rn_dep
-         WRITE(numout,*) '      create a damping.coeff file     nn_file   = ', nn_file
+         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters'
+         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp
+         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp
+         WRITE(numout,*) '      Damping file name               cn_resto  = ', cn_resto
          WRITE(numout,*)
       ENDIF
 
-      IF( ln_tradmp ) THEN               ! initialization for T-S damping
-         !
+      IF( ln_tradmp) THEN
+         !
+         !Allocate arrays
          IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
-         !
-!!gm  I don't understand the specificities of c1d case......   
-!!gm  to be check with the autor of these lines
-         
-#if ! defined key_c1d
-         SELECT CASE ( nn_hdmp )
-         CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only'
-         CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp, ' degrees'
-         CASE DEFAULT
-            WRITE(ctmp1,*) '          bad flag value for nn_hdmp = ', nn_hdmp
-            CALL ctl_stop(ctmp1)
+
+         !Check values of nn_zdmp
+         SELECT CASE (nn_zdmp)
+         CASE ( 0 )  ; IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
+         CASE ( 1 )  ; IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline'
+         CASE ( 2 )  ; IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
          END SELECT
-         !
-#endif
-         SELECT CASE ( nn_zdmp )
-         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column'
-         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)'
-         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
-         CASE DEFAULT
-            WRITE(ctmp1,*) 'bad flag value for nn_zdmp = ', nn_zdmp
-            CALL ctl_stop(ctmp1)
-         END SELECT
-         !
+
+         !TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
+         !so can damp to something other than intitial conditions files?
          IF( .NOT.ln_tsd_tradmp ) THEN
             CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' )
             CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
          ENDIF
-         !
-         strdmp(:,:,:) = 0._wp       ! internal damping salinity trend (used in asmtrj)
+
+         !initialise arrays - Are these actually used anywhere else?
+         strdmp(:,:,:) = 0._wp
          ttrdmp(:,:,:) = 0._wp
-         !                          ! Damping coefficients initialization
-         IF( lzoom .AND. .NOT. lk_c1d ) THEN   ;   CALL dtacof_zoom( resto )
-         ELSE               ;   CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep, nn_file, 'TRA', resto )
-         ENDIF
-         !
-      ENDIF
-      !
+
+         !Read in mask from file
+         CALL iom_open ( cn_resto, imask)
+         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto)
+         CALL iom_close( imask )
+       ENDIF
+
    END SUBROUTINE tra_dmp_init
 
-
-   SUBROUTINE dtacof_zoom( presto )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dtacof_zoom  ***
-      !!
-      !! ** Purpose :   Compute the damping coefficient for zoom domain
-      !!
-      !! ** Method  : - set along closed boundary due to zoom a damping over
-      !!                6 points with a max time scale of 5 days.
-      !!              - ORCA arctic/antarctic zoom: set the damping along
-      !!                south/north boundary over a latitude strip.
-      !!
-      !! ** Action  : - resto, the damping coeff. for T and S
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)  ::   presto   ! restoring coeff. (s-1)
-      !
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zlat, zlat0, zlat1, zlat2, z1_5d   ! local scalar
-      REAL(wp), DIMENSION(6)  ::   zfact               ! 1Dworkspace
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start( 'dtacof_zoom')
-      !
-
-      zfact(1) =  1._wp
-      zfact(2) =  1._wp
-      zfact(3) = 11._wp / 12._wp
-      zfact(4) =  8._wp / 12._wp
-      zfact(5) =  4._wp / 12._wp
-      zfact(6) =  1._wp / 12._wp
-      zfact(:) = zfact(:) / ( 5._wp * rday )    ! 5 days max restoring time scale
-
-      presto(:,:,:) = 0._wp
-
-      ! damping along the forced closed boundary over 6 grid-points
-      DO jn = 1, 6
-         IF( lzoom_w )   presto( mi0(jn+jpizoom):mi1(jn+jpizoom), : , : )                    = zfact(jn)   ! west  closed
-         IF( lzoom_s )   presto( : , mj0(jn+jpjzoom):mj1(jn+jpjzoom), : )                    = zfact(jn)   ! south closed 
-         IF( lzoom_e )   presto( mi0(jpiglo+jpizoom-1-jn):mi1(jpiglo+jpizoom-1-jn) , : , : ) = zfact(jn)   ! east  closed 
-         IF( lzoom_n )   presto( : , mj0(jpjglo+jpjzoom-1-jn):mj1(jpjglo+jpjzoom-1-jn) , : ) = zfact(jn)   ! north closed
-      END DO
-
-      !                                           ! ====================================================
-      IF( cp_cfz == "arctic" .OR. cp_cfz == "antarctic" ) THEN   !  ORCA configuration : arctic or antarctic zoom
-         !                                        ! ====================================================
-         IF(lwp) WRITE(numout,*)
-         IF(lwp .AND. cp_cfz == "arctic" ) WRITE(numout,*) '              dtacof_zoom : ORCA    Arctic zoom'
-         IF(lwp .AND. cp_cfz == "antarctic" ) WRITE(numout,*) '           dtacof_zoom : ORCA Antarctic zoom'
-         IF(lwp) WRITE(numout,*)
-         !
-         !                          ! Initialization : 
-         presto(:,:,:) = 0._wp
-         zlat0 = 10._wp                     ! zlat0 : latitude strip where resto decreases
-         zlat1 = 30._wp                     ! zlat1 : resto = 1 before zlat1
-         zlat2 = zlat1 + zlat0              ! zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2
-         z1_5d = 1._wp / ( 5._wp * rday )   ! z1_5d : 1 / 5days
-
-         DO jk = 2, jpkm1           ! Compute arrays resto ; value for internal damping : 5 days
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zlat = ABS( gphit(ji,jj) )
-                  IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
-                     presto(ji,jj,jk) = 0.5_wp * z1_5d * (  1._wp - COS( rpi*(zlat2-zlat)/zlat0 )  ) 
-                  ELSEIF( zlat < zlat1 ) THEN
-                     presto(ji,jj,jk) = z1_5d
-                  ENDIF
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF
-      !                             ! Mask resto array
-      presto(:,:,:) = presto(:,:,:) * tmask(:,:,:)
-      !
-      IF( nn_timing == 1 )  CALL timing_stop( 'dtacof_zoom')
-      !
-   END SUBROUTINE dtacof_zoom
-
-
-   SUBROUTINE dtacof( kn_hdmp, pn_surf, pn_bot, pn_dep,  &
-      &               kn_file, cdtype , presto           )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dtacof  ***
-      !!
-      !! ** Purpose :   Compute the damping coefficient
-      !!
-      !! ** Method  :   Arrays defining the damping are computed for each grid
-      !!                point for temperature and salinity (resto)
-      !!                Damping depends on distance to coast, depth and latitude
-      !!
-      !! ** Action  : - resto, the damping coeff. for T and S
-      !!----------------------------------------------------------------------
-      USE iom
-      USE ioipsl
-      !!
-      INTEGER                         , INTENT(in   )  ::  kn_hdmp    ! damping option
-      REAL(wp)                        , INTENT(in   )  ::  pn_surf    ! surface time scale (days)
-      REAL(wp)                        , INTENT(in   )  ::  pn_bot     ! bottom time scale (days)
-      REAL(wp)                        , INTENT(in   )  ::  pn_dep     ! depth of transition (meters)
-      INTEGER                         , INTENT(in   )  ::  kn_file    ! save the damping coef on a file or not
-      CHARACTER(len=3)                , INTENT(in   )  ::  cdtype     ! =TRA, TRC or DYN (tracer/dynamics indicator)
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)  ::  presto     ! restoring coeff. (s-1)
-      !
-      INTEGER  ::   ji, jj, jk                  ! dummy loop indices
-      INTEGER  ::   ii0, ii1, ij0, ij1          ! local integers
-      INTEGER  ::   inum0, icot                 !   -       -
-      REAL(wp) ::   zinfl, zlon                 ! local scalars
-      REAL(wp) ::   zlat, zlat0, zlat1, zlat2   !   -      -
-      REAL(wp) ::   zsdmp, zbdmp                !   -      -
-      CHARACTER(len=20)                   :: cfile
-      REAL(wp), POINTER, DIMENSION(:    ) :: zhfac 
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zmrs 
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdct 
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('dtacof')
-      !
-      CALL wrk_alloc( jpk, zhfac          )
-      CALL wrk_alloc( jpi, jpj, zmrs      )
-      CALL wrk_alloc( jpi, jpj, jpk, zdct )
-#if defined key_c1d
-      !                                   ! ====================
-      !                                   !  C1D configuration : local domain
-      !                                   ! ====================
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '              dtacof : C1D 3x3 local domain'
-      IF(lwp) WRITE(numout,*) '              -----------------------------'
-      !
-      presto(:,:,:) = 0._wp
-      !
-      zsdmp = 1._wp / ( pn_surf * rday )
-      zbdmp = 1._wp / ( pn_bot  * rday )
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !   ONLY vertical variation from zsdmp (sea surface) to zbdmp (bottom)
-               presto(ji,jj,jk) = zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(ji,jj,jk)/pn_dep)
-            END DO
-         END DO
-      END DO
-      !
-      presto(:,:, : ) = presto(:,:,:) * tmask(:,:,:)
-#else
-      !                                   ! ====================
-      !                                   !  ORCA configuration : global domain
-      !                                   ! ====================
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '              dtacof : Global domain of ORCA'
-      IF(lwp) WRITE(numout,*) '              ------------------------------'
-      !
-      presto(:,:,:) = 0._wp
-      !
-      IF( kn_hdmp > 0 ) THEN      !  Damping poleward of 'nn_hdmp' degrees  !
-         !                        !-----------------------------------------!
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '              Damping poleward of ', kn_hdmp, ' deg.'
-         !
-         CALL iom_open ( 'dist.coast.nc', icot, ldstop = .FALSE. )
-         !
-         IF( icot > 0 ) THEN          ! distance-to-coast read in file
-            CALL iom_get  ( icot, jpdom_data, 'Tcoast', zdct )
-            CALL iom_close( icot )
-         ELSE                         ! distance-to-coast computed and saved in file (output in zdct)
-            CALL cofdis( zdct )
-         ENDIF
-
-         !                            ! Compute arrays resto 
-         zinfl = 1000.e3_wp                ! distance of influence for damping term
-         zlat0 = 10._wp                    ! latitude strip where resto decreases
-         zlat1 = REAL( kn_hdmp )           ! resto = 0 between -zlat1 and zlat1
-         zlat2 = zlat1 + zlat0             ! resto increases from 0 to 1 between |zlat1| and |zlat2|
-
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zlat = ABS( gphit(ji,jj) )
-               IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
-                  presto(ji,jj,1) = 0.5_wp * (  1._wp - COS( rpi*(zlat-zlat1)/zlat0 )  )
-               ELSEIF ( zlat > zlat2 ) THEN
-                  presto(ji,jj,1) = 1._wp
-               ENDIF
-            END DO
-         END DO
-
-         IF ( kn_hdmp == 20 ) THEN       ! North Indian ocean (20N/30N x 45E/100E) : resto=0
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zlat = gphit(ji,jj)
-                  zlon = MOD( glamt(ji,jj), 360._wp )
-                  IF ( zlat1 < zlat .AND. zlat < zlat2 .AND. 45._wp < zlon .AND. zlon < 100._wp ) THEN
-                     presto(ji,jj,1) = 0._wp
-                  ENDIF
-               END DO
-            END DO
-         ENDIF
-
-         zsdmp = 1._wp / ( pn_surf * rday )
-         zbdmp = 1._wp / ( pn_bot  * rday )
-         DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zdct(ji,jj,jk) = MIN( zinfl, zdct(ji,jj,jk) )
-                  !   ... Decrease the value in the vicinity of the coast
-                  presto(ji,jj,jk) = presto(ji,jj,1 ) * 0.5_wp * (  1._wp - COS( rpi*zdct(ji,jj,jk)/zinfl)  )
-                  !   ... Vertical variation from zsdmp (sea surface) to zbdmp (bottom)
-                  presto(ji,jj,jk) = presto(ji,jj,jk) * (  zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(ji,jj,jk)/pn_dep)  )
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF
-
-      !                                  ! =========================
-      !                                  !  Med and Red Sea damping    (ORCA configuration only)
-      !                                  ! =========================
-      IF( cp_cfg == "orca" .AND. ( kn_hdmp > 0 .OR. kn_hdmp == -1 ) ) THEN
-         IF(lwp)WRITE(numout,*)
-         IF(lwp)WRITE(numout,*) '              ORCA configuration: Damping in Med and Red Seas'
-         !
-         zmrs(:,:) = 0._wp
-         !
-         SELECT CASE ( jp_cfg )
-         !                                           ! =======================
-         CASE ( 4 )                                  !  ORCA_R4 configuration 
-            !                                        ! =======================
-            ij0 =  50   ;   ij1 =  56                    ! Mediterranean Sea
-
-            ii0 =  81   ;   ii1 =  91   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
-            ij0 =  50   ;   ij1 =  55
-            ii0 =  75   ;   ii1 =  80   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
-            ij0 =  52   ;   ij1 =  53
-            ii0 =  70   ;   ii1 =  74   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
-            ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea
-            DO jk = 1, 17
-               zhfac (jk) = 0.5_wp * (  1._wp - COS( rpi * REAL(jk-1,wp) / 16._wp )  ) / rday
-            END DO
-            DO jk = 18, jpkm1
-               zhfac (jk) = 1._wp / rday
-            END DO
-            !                                        ! =======================
-         CASE ( 2 )                                  !  ORCA_R2 configuration 
-            !                                        ! =======================
-            ij0 =  96   ;   ij1 = 110                    ! Mediterranean Sea
-            ii0 = 157   ;   ii1 = 181   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
-            ij0 = 100   ;   ij1 = 110
-            ii0 = 144   ;   ii1 = 156   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
-            ij0 = 100   ;   ij1 = 103
-            ii0 = 139   ;   ii1 = 143   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
-            !
-            ij0 = 101   ;   ij1 = 102                    ! Decrease before Gibraltar Strait
-            ii0 = 139   ;   ii1 = 141   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0._wp
-            ii0 = 142   ;   ii1 = 142   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp / 90._wp
-            ii0 = 143   ;   ii1 = 143   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40_wp
-            ii0 = 144   ;   ii1 = 144   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75_wp
-            !
-            ij0 =  87   ;   ij1 =  96                    ! Red Sea
-            ii0 = 147   ;   ii1 = 163   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
-            !
-            ij0 =  91   ;   ij1 =  91                    ! Decrease before Bab el Mandeb Strait
-            ii0 = 153   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.80_wp
-            ij0 =  90   ;   ij1 =  90
-            ii0 = 153   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40_wp
-            ij0 =  89   ;   ij1 =  89
-            ii0 = 158   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp / 90._wp
-            ij0 =  88   ;   ij1 =  88
-            ii0 = 160   ;   ii1 = 163   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0._wp
-            ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea
-            DO jk = 1, 17
-               zhfac (jk) = 0.5_wp * (  1._wp - COS( rpi * REAL(jk-1,wp) / 16._wp )  ) / rday
-            END DO
-            DO jk = 18, jpkm1
-               zhfac (jk) = 1._wp / rday
-            END DO
-            !                                        ! =======================
-         CASE ( 05 )                                 !  ORCA_R05 configuration
-            !                                        ! =======================
-            ii0 = 568   ;   ii1 = 574                    ! Mediterranean Sea
-            ij0 = 324   ;   ij1 = 333   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
-            ii0 = 575   ;   ii1 = 658
-            ij0 = 314   ;   ij1 = 366   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
-            !
-            ii0 = 641   ;   ii1 = 651                    ! Black Sea (remaining part
-            ij0 = 367   ;   ij1 = 372   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
-            !
-            ij0 = 324   ;   ij1 = 333                    ! Decrease before Gibraltar Strait
-            ii0 = 565   ;   ii1 = 565   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp / 90._wp
-            ii0 = 566   ;   ii1 = 566   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40_wp
-            ii0 = 567   ;   ii1 = 567   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75_wp
-            !
-            ii0 = 641   ;   ii1 = 665                    ! Red Sea
-            ij0 = 270   ;   ij1 = 310   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
-            !
-            ii0 = 666   ;   ii1 = 675                    ! Decrease before Bab el Mandeb Strait
-            ij0 = 270   ;   ij1 = 290   
-            DO ji = mi0(ii0), mi1(ii1)
-               zmrs( ji , mj0(ij0):mj1(ij1) ) = 0.1_wp * ABS( FLOAT(ji - mi1(ii1)) )
-            END DO 
-            zsdmp = 1._wp / ( pn_surf * rday )
-            zbdmp = 1._wp / ( pn_bot  * rday )
-            DO jk = 1, jpk
-               zhfac(jk) = (  zbdmp + (zsdmp-zbdmp) * EXP( -fsdept(1,1,jk)/pn_dep )  )
-            END DO
-            !                                       ! ========================
-         CASE ( 025 )                               !  ORCA_R025 configuration 
-            !                                       ! ========================
-            CALL ctl_stop( ' Not yet implemented in ORCA_R025' )
-            !
-         END SELECT
-
-         DO jk = 1, jpkm1
-            presto(:,:,jk) = zmrs(:,:) * zhfac(jk) + ( 1._wp - zmrs(:,:) ) * presto(:,:,jk)
-         END DO
-
-         ! Mask resto array and set to 0 first and last levels
-         presto(:,:, : ) = presto(:,:,:) * tmask(:,:,:)
-         presto(:,:, 1 ) = 0._wp
-         presto(:,:,jpk) = 0._wp
-         !                         !--------------------!
-      ELSE                         !     No damping     !
-         !                         !--------------------!
-         CALL ctl_stop( 'Choose a correct value of nn_hdmp or put ln_tradmp to FALSE' )
-      ENDIF
-#endif
-
-      !                            !--------------------------------!
-      IF( kn_file == 1 ) THEN      !  save damping coef. in a file  !
-         !                         !--------------------------------!
-         IF(lwp) WRITE(numout,*) '              create damping.coeff.nc file'
-         IF( cdtype == 'TRA' ) cfile = 'damping.coeff'
-         IF( cdtype == 'TRC' ) cfile = 'damping.coeff.trc'
-         IF( cdtype == 'DYN' ) cfile = 'damping.coeff.dyn'
-         cfile = TRIM( cfile )
-         CALL iom_open  ( cfile, inum0, ldwrt = .TRUE., kiolib = jprstlib )
-         CALL iom_rstput( 0, 0, inum0, 'Resto', presto )
-         CALL iom_close ( inum0 )
-      ENDIF
-      !
-      CALL wrk_dealloc( jpk, zhfac)
-      CALL wrk_dealloc( jpi, jpj, zmrs )
-      CALL wrk_dealloc( jpi, jpj, jpk, zdct )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('dtacof')
-      !
-   END SUBROUTINE dtacof
-
-
-   SUBROUTINE cofdis( pdct )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE cofdis  ***
-      !!
-      !! ** Purpose :   Compute the distance between ocean T-points and the
-      !!      ocean model coastlines. Save the distance in a NetCDF file.
-      !!
-      !! ** Method  :   For each model level, the distance-to-coast is 
-      !!      computed as follows : 
-      !!       - The coastline is defined as the serie of U-,V-,F-points
-      !!      that are at the ocean-land bound.
-      !!       - For each ocean T-point, the distance-to-coast is then 
-      !!      computed as the smallest distance (on the sphere) between the 
-      !!      T-point and all the coastline points.
-      !!       - For land T-points, the distance-to-coast is set to zero.
-      !!      C A U T I O N : Computation not yet implemented in mpp case.
-      !!
-      !! ** Action  : - pdct, distance to the coastline (argument)
-      !!              - NetCDF file 'dist.coast.nc' 
-      !!----------------------------------------------------------------------
-      USE ioipsl      ! IOipsl librairy
-      !!
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   pdct   ! distance to the coastline
-      !!
-      INTEGER ::   ji, jj, jk, jl   ! dummy loop indices
-      INTEGER ::   iju, ijt, icoast, itime, ierr, icot   ! local integers
-      CHARACTER (len=32) ::   clname                     ! local name
-      REAL(wp) ::   zdate0                               ! local scalar
-      REAL(wp), POINTER, DIMENSION(:,:) ::  zxt, zyt, zzt, zmask
-      REAL(wp), POINTER, DIMENSION(:  ) ::  zxc, zyc, zzc, zdis    ! temporary workspace
-      LOGICAL , ALLOCATABLE, DIMENSION(:,:) ::  llcotu, llcotv, llcotf   ! 2D logical workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('cofdis')
-      !
-      CALL wrk_alloc( jpi, jpj , zxt, zyt, zzt, zmask    )
-      CALL wrk_alloc( 3*jpi*jpj, zxc, zyc, zzc, zdis     )
-      ALLOCATE( llcotu(jpi,jpj), llcotv(jpi,jpj), llcotf(jpi,jpj)  )
-      !
-      IF( lk_mpp    )   CALL mpp_sum( ierr )
-      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'cofdis: requested local arrays unavailable')
-
-      ! 0. Initialization
-      ! -----------------
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'cofdis : compute the distance to coastline'
-      IF(lwp) WRITE(numout,*) '~~~~~~'
-      IF(lwp) WRITE(numout,*)
-      IF( lk_mpp ) &
-           & CALL ctl_stop('         Computation not yet implemented with key_mpp_...', &
-           &               '         Rerun the code on another computer or ', &
-           &               '         create the "dist.coast.nc" file using IDL' )
-
-      pdct(:,:,:) = 0._wp
-      zxt(:,:) = COS( rad * gphit(:,:) ) * COS( rad * glamt(:,:) )
-      zyt(:,:) = COS( rad * gphit(:,:) ) * SIN( rad * glamt(:,:) )
-      zzt(:,:) = SIN( rad * gphit(:,:) )
-
-
-      ! 1. Loop on vertical levels
-      ! --------------------------
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         ! Define the coastline points (U, V and F)
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               zmask(ji,jj) =  ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) &
-                   &           + tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk) )
-               llcotu(ji,jj) = ( tmask(ji,jj,  jk) + tmask(ji+1,jj  ,jk) == 1._wp ) 
-               llcotv(ji,jj) = ( tmask(ji,jj  ,jk) + tmask(ji  ,jj+1,jk) == 1._wp ) 
-               llcotf(ji,jj) = ( zmask(ji,jj) > 0._wp ) .AND. ( zmask(ji,jj) < 4._wp )
-            END DO
-         END DO
-
-         ! Lateral boundaries conditions
-         llcotu(:, 1 ) = umask(:,  2  ,jk) == 1
-         llcotu(:,jpj) = umask(:,jpjm1,jk) == 1
-         llcotv(:, 1 ) = vmask(:,  2  ,jk) == 1
-         llcotv(:,jpj) = vmask(:,jpjm1,jk) == 1
-         llcotf(:, 1 ) = fmask(:,  2  ,jk) == 1
-         llcotf(:,jpj) = fmask(:,jpjm1,jk) == 1
-
-         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
-            llcotu( 1 ,:) = llcotu(jpim1,:)
-            llcotu(jpi,:) = llcotu(  2  ,:)
-            llcotv( 1 ,:) = llcotv(jpim1,:)
-            llcotv(jpi,:) = llcotv(  2  ,:)
-            llcotf( 1 ,:) = llcotf(jpim1,:)
-            llcotf(jpi,:) = llcotf(  2  ,:)
-         ELSE
-            llcotu( 1 ,:) = umask(  2  ,:,jk) == 1
-            llcotu(jpi,:) = umask(jpim1,:,jk) == 1
-            llcotv( 1 ,:) = vmask(  2  ,:,jk) == 1
-            llcotv(jpi,:) = vmask(jpim1,:,jk) == 1
-            llcotf( 1 ,:) = fmask(  2  ,:,jk) == 1
-            llcotf(jpi,:) = fmask(jpim1,:,jk) == 1
-         ENDIF
-         IF( nperio == 3 .OR. nperio == 4 ) THEN
-            DO ji = 1, jpim1
-               iju = jpi - ji + 1
-               llcotu(ji,jpj  ) = llcotu(iju,jpj-2)
-               llcotf(ji,jpjm1) = llcotf(iju,jpj-2)
-               llcotf(ji,jpj  ) = llcotf(iju,jpj-3)
-            END DO
-            DO ji = jpi/2, jpim1
-               iju = jpi - ji + 1
-               llcotu(ji,jpjm1) = llcotu(iju,jpjm1)
-            END DO
-            DO ji = 2, jpi
-               ijt = jpi - ji + 2
-               llcotv(ji,jpjm1) = llcotv(ijt,jpj-2)
-               llcotv(ji,jpj  ) = llcotv(ijt,jpj-3)
-            END DO
-         ENDIF
-         IF( nperio == 5 .OR. nperio == 6 ) THEN
-            DO ji = 1, jpim1
-               iju = jpi - ji
-               llcotu(ji,jpj  ) = llcotu(iju,jpjm1)
-               llcotf(ji,jpj  ) = llcotf(iju,jpj-2)
-            END DO
-            DO ji = jpi/2, jpim1
-               iju = jpi - ji
-               llcotf(ji,jpjm1) = llcotf(iju,jpjm1)
-            END DO
-            DO ji = 1, jpi
-               ijt = jpi - ji + 1
-               llcotv(ji,jpj  ) = llcotv(ijt,jpjm1)
-            END DO
-            DO ji = jpi/2+1, jpi
-               ijt = jpi - ji + 1
-               llcotv(ji,jpjm1) = llcotv(ijt,jpjm1)
-            END DO
-         ENDIF
-
-         ! Compute cartesian coordinates of coastline points
-         ! and the number of coastline points
-         icoast = 0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( llcotf(ji,jj) ) THEN
-                  icoast = icoast + 1
-                  zxc(icoast) = COS( rad*gphif(ji,jj) ) * COS( rad*glamf(ji,jj) )
-                  zyc(icoast) = COS( rad*gphif(ji,jj) ) * SIN( rad*glamf(ji,jj) )
-                  zzc(icoast) = SIN( rad*gphif(ji,jj) )
-               ENDIF
-               IF( llcotu(ji,jj) ) THEN
-                  icoast = icoast+1
-                  zxc(icoast) = COS( rad*gphiu(ji,jj) ) * COS( rad*glamu(ji,jj) )
-                  zyc(icoast) = COS( rad*gphiu(ji,jj) ) * SIN( rad*glamu(ji,jj) )
-                  zzc(icoast) = SIN( rad*gphiu(ji,jj) )
-               ENDIF
-               IF( llcotv(ji,jj) ) THEN
-                  icoast = icoast+1
-                  zxc(icoast) = COS( rad*gphiv(ji,jj) ) * COS( rad*glamv(ji,jj) )
-                  zyc(icoast) = COS( rad*gphiv(ji,jj) ) * SIN( rad*glamv(ji,jj) )
-                  zzc(icoast) = SIN( rad*gphiv(ji,jj) )
-               ENDIF
-            END DO
-         END DO
-
-         ! Distance for the T-points
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( tmask(ji,jj,jk) == 0._wp ) THEN
-                  pdct(ji,jj,jk) = 0._wp
-               ELSE
-                  DO jl = 1, icoast
-                     zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2   &
-                        &     + ( zyt(ji,jj) - zyc(jl) )**2   &
-                        &     + ( zzt(ji,jj) - zzc(jl) )**2
-                  END DO
-                  pdct(ji,jj,jk) = ra * SQRT( MINVAL( zdis(1:icoast) ) )
-               ENDIF
-            END DO
-         END DO
-         !                                                ! ===============
-      END DO                                              !   End of slab
-      !                                                   ! ===============
-
-
-      ! 2. Create the  distance to the coast file in NetCDF format
-      ! ----------------------------------------------------------    
-      clname = 'dist.coast'
-      itime  = 0
-      CALL ymds2ju( 0     , 1       , 1     , 0._wp , zdate0 )
-      CALL restini( 'NONE', jpi     , jpj   , glamt, gphit ,   &
-         &          jpk   , gdept_1d, clname, itime, zdate0,   &
-         &          rdt   , icot                         )
-      CALL restput( icot, 'Tcoast', jpi, jpj, jpk, 0, pdct )
-      CALL restclo( icot )
-      !
-      CALL wrk_dealloc( jpi, jpj , zxt, zyt, zzt, zmask    )
-      CALL wrk_dealloc( 3*jpi*jpj, zxc, zyc, zzc, zdis     )
-      DEALLOCATE( llcotu, llcotv, llcotf  )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('cofdis')
-      !
-   END SUBROUTINE cofdis
-   !!======================================================================
 END MODULE tradmp
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 5682)
@@ -290,4 +290,9 @@
       IF(lwp) WRITE(numout,*) '              homogeneous ocean T = ', zt0, ' S = ',zs0
 
+      ! Initialisation of gtui/gtvi in case of no cavity
+      IF ( .NOT. ln_isfcav ) THEN
+         gtui(:,:,:) = 0.0_wp
+         gtvi(:,:,:) = 0.0_wp
+      END IF
       !                                        ! T & S profile (to be coded +namelist parameter
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 5682)
@@ -116,5 +116,4 @@
                END DO
             END DO
-
             !                          !==  Laplacian  ==!
             !
@@ -125,4 +124,5 @@
                END DO
             END DO
+            !
             IF( ln_zps ) THEN                ! set gradient at partial step level (last ocean level)
                DO jj = 1, jpjm1
@@ -130,10 +130,17 @@
                      IF( mbku(ji,jj) == jk )  ztu(ji,jj,jk) = zeeu(ji,jj) * pgu(ji,jj,jn)
                      IF( mbkv(ji,jj) == jk )  ztv(ji,jj,jk) = zeev(ji,jj) * pgv(ji,jj,jn)
-                     ! (ISH)
-                     IF( miku(ji,jj) == jk )  ztu(ji,jj,jk) = zeeu(ji,jj) * pgui(ji,jj,jn)
-                     IF( mikv(ji,jj) == jk )  ztu(ji,jj,jk) = zeev(ji,jj) * pgvi(ji,jj,jn)
                   END DO
                END DO
             ENDIF
+            ! (ISH)
+            IF( ln_zps .AND. ln_isfcav ) THEN ! set gradient at partial step level (first ocean level in a cavity)
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     IF( miku(ji,jj) == MAX(jk,2) )  ztu(ji,jj,jk) = zeeu(ji,jj) * pgui(ji,jj,jn)
+                     IF( mikv(ji,jj) == MAX(jk,2) )  ztu(ji,jj,jk) = zeev(ji,jj) * pgvi(ji,jj,jn)
+                  END DO
+               END DO
+            ENDIF
+            !
             DO jj = 2, jpjm1                 ! Second derivative (divergence) time the eddy diffusivity coefficient
                DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -166,7 +173,7 @@
          !                                                
          ! "zonal" mean lateral diffusive heat and salt transport
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
-           IF( jn == jp_tem )  htr_ldf(:) = ptr_vj( ztv(:,:,:) )
-           IF( jn == jp_sal )  str_ldf(:) = ptr_vj( ztv(:,:,:) )
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
+           IF( jn == jp_tem )  htr_ldf(:) = ptr_sj( ztv(:,:,:) )
+           IF( jn == jp_sal )  str_ldf(:) = ptr_sj( ztv(:,:,:) )
          ENDIF
          !                                                ! ===========
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 5682)
@@ -247,8 +247,8 @@
          !                                                ! ===============
          ! "Poleward" diffusive heat or salt transport
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) THEN
             ! note sign is reversed to give down-gradient diffusive transports (#1043)
-            IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( -zftv(:,:,:) )
-            IF( jn == jp_sal)   str_ldf(:) = ptr_vj( -zftv(:,:,:) )
+            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) )
+            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) )
          ENDIF
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 5682)
@@ -28,8 +28,6 @@
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O library
-#if defined key_diaar5
    USE phycst          ! physical constants
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-#endif
    USE wrk_nemo        ! Memory Allocation
    USE timing          ! Timing
@@ -106,10 +104,8 @@
       !
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::  ikt
       REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars
       REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
       REAL(wp) ::  zcoef0, zbtr, ztra            !   -      -
-#if defined key_diaar5
-      REAL(wp)                         ::   zztmp               ! local scalar
-#endif
       REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdkt, zdk1t, zdit, zdjt, ztfw 
@@ -149,43 +145,59 @@
             END DO
          END DO
+
+         ! partial cell correction
          IF( ln_zps ) THEN      ! partial steps correction at the last ocean level 
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
 ! IF useless if zpshde defines pgu everywhere
-                  IF (mbku(ji,jj) > 1) zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)          
-                  IF (mbkv(ji,jj) > 1) zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
-                  ! (ISF)
+                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)          
+                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
+               END DO
+            END DO
+         ENDIF
+         IF( ln_zps .AND. ln_isfcav ) THEN      ! partial steps correction at the first wet level beneath a cavity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
                   IF (miku(ji,jj) > 1) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)          
                   IF (mikv(ji,jj) > 1) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)     
                END DO
             END DO
-         ENDIF
+         END IF
 
          !!----------------------------------------------------------------------
          !!   II - horizontal trend  (full)
          !!----------------------------------------------------------------------
-!CDIR PARALLEL DO PRIVATE( zdk1t ) 
-         !                                                ! ===============
-         DO jj = 1, jpj                                 ! Horizontal slab
-            !                                             ! ===============
-            DO ji = 1, jpi   ! vector opt.
-               DO jk = mikt(ji,jj), jpkm1
-               ! 1. Vertical tracer gradient at level jk and jk+1
-               ! ------------------------------------------------
-               ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
-                  zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1)
-               !
-                  IF( jk == mikt(ji,jj) ) THEN  ;   zdkt(ji,jj,jk) = zdk1t(ji,jj,jk)
-                  ELSE                          ;   zdkt(ji,jj,jk) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
-                  ENDIF
+!!!!!!!!!!CDIR PARALLEL DO PRIVATE( zdk1t ) 
+            ! 1. Vertical tracer gradient at level jk and jk+1
+            ! ------------------------------------------------
+         ! 
+         ! interior value 
+         DO jk = 2, jpkm1               
+            DO jj = 1, jpj
+               DO ji = 1, jpi   ! vector opt.
+                  zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn  ) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)
+                  !
+                  zdkt(ji,jj,jk)  = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn  ) ) * wmask(ji,jj,jk)
                END DO
             END DO
          END DO
-
-            ! 2. Horizontal fluxes
-            ! --------------------   
-         DO jj = 1 , jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               DO jk = mikt(ji,jj), jpkm1
+         ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+         zdk1t(:,:,1) = ( ptb(:,:,1,jn  ) - ptb(:,:,2,jn) ) * wmask(:,:,2)
+         zdkt (:,:,1) = zdk1t(:,:,1)
+         IF ( ln_isfcav ) THEN
+            DO jj = 1, jpj
+               DO ji = 1, jpi   ! vector opt.
+                  ikt = mikt(ji,jj) ! surface level
+                  zdk1t(ji,jj,ikt) = ( ptb(ji,jj,ikt,jn  ) - ptb(ji,jj,ikt+1,jn) ) * wmask(ji,jj,ikt+1)
+                  zdkt (ji,jj,ikt) = zdk1t(ji,jj,ikt)
+               END DO
+            END DO
+         END IF
+
+         ! 2. Horizontal fluxes
+         ! --------------------   
+         DO jk = 1, jpkm1
+            DO jj = 1 , jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
                   zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
                   zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
@@ -208,12 +220,10 @@
                END DO
             END DO
-         END DO
 
             ! II.4 Second derivative (divergence) and add to the general trend
             ! ----------------------------------------------------------------
-         DO jj = 2 , jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               DO jk = mikt(ji,jj), jpkm1
-                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            DO jj = 2 , jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
                   ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
@@ -225,38 +235,39 @@
          !
          ! "Poleward" diffusive heat or salt transports (T-S case only)
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
             ! note sign is reversed to give down-gradient diffusive transports (#1043)
-            IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( -zftv(:,:,:) )
-            IF( jn == jp_sal)   str_ldf(:) = ptr_vj( -zftv(:,:,:) )
+            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) )
+            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) )
          ENDIF
  
-#if defined key_diaar5
-         IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
-            z2d(:,:) = 0._wp 
-            ! note sign is reversed to give down-gradient diffusive transports (#1043)
-            zztmp = -1.0_wp * rau0 * rcp
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
+         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
+           !
+           IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
+               z2d(:,:) = 0._wp 
+               DO jk = 1, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
+                     END DO
                   END DO
                END DO
-            END DO
-            z2d(:,:) = zztmp * z2d(:,:)
-            CALL lbc_lnk( z2d, 'U', -1. )
-            CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
-            z2d(:,:) = 0._wp 
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
+               z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043)
+               CALL lbc_lnk( z2d, 'U', -1. )
+               CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
+               !
+               z2d(:,:) = 0._wp 
+               DO jk = 1, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
+                     END DO
                   END DO
                END DO
-            END DO
-            z2d(:,:) = zztmp * z2d(:,:)
-            CALL lbc_lnk( z2d, 'V', -1. )
-            CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
-         END IF
-#endif
+               z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043)
+               CALL lbc_lnk( z2d, 'V', -1. )
+               CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
+            END IF
+            !
+         ENDIF
 
          !!----------------------------------------------------------------------
@@ -278,5 +289,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
+                  zcoef0 = - fsahtw(ji,jj,jk) * wmask(ji,jj,jk)
                   !
                   zmsku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      &
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90	(revision 5682)
@@ -113,7 +113,4 @@
       REAL(wp) ::   ze1ur, zdxt, ze2vr, ze3wr, zdyt, zdzt
       REAL(wp) ::   zah, zah_slp, zaei_slp
-#if defined key_diaar5
-      REAL(wp) ::   zztmp              ! local scalar
-#endif
       REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw 
@@ -207,32 +204,34 @@
       END DO
       !
-#if defined key_iomput
-      IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN
-         CALL wrk_alloc( jpi , jpj , jpk  , zw3d )
-         DO jk=1,jpkm1
-            zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz
-         END DO
-         zw3d(:,:,jpk) = 0._wp
-         CALL iom_put( "uoce_eiv", zw3d )    ! i-eiv current
-
-         DO jk=1,jpk-1
-            zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz
-         END DO
-         zw3d(:,:,jpk) = 0._wp
-         CALL iom_put( "voce_eiv", zw3d )    ! j-eiv current
-
-         DO jk=1,jpk-1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1  ! vector opt.
-                  zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + &
-                       &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx
-               END DO
-            END DO
-         END DO
-         zw3d(:,:,jpk) = 0._wp
-         CALL iom_put( "woce_eiv", zw3d )    ! vert. eiv current
-         CALL wrk_dealloc( jpi , jpj , jpk  , zw3d )
+      IF( iom_use("uoce_eiv") .OR. iom_use("voce_eiv") .OR. iom_use("woce_eiv") )  THEN
+         !
+         IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN
+            CALL wrk_alloc( jpi , jpj , jpk  , zw3d )
+            DO jk=1,jpkm1
+               zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz
+            END DO
+            zw3d(:,:,jpk) = 0._wp
+            CALL iom_put( "uoce_eiv", zw3d )    ! i-eiv current
+
+            DO jk=1,jpk-1
+               zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz
+            END DO
+            zw3d(:,:,jpk) = 0._wp
+            CALL iom_put( "voce_eiv", zw3d )    ! j-eiv current
+
+            DO jk=1,jpk-1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1  ! vector opt.
+                     zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + &
+                          &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx
+                  END DO
+               END DO
+            END DO
+            zw3d(:,:,jpk) = 0._wp
+            CALL iom_put( "woce_eiv", zw3d )    ! vert. eiv current
+            CALL wrk_dealloc( jpi , jpj , jpk  , zw3d )
+         ENDIF
+         !
       ENDIF
-#endif
       !                                                          ! ===========
       DO jn = 1, kjpt                                            ! tracer loop
@@ -387,36 +386,38 @@
          !
          !                             ! "Poleward" diffusive heat or salt transports (T-S case only)
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
-            IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) )        ! 3.3  names
-            IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) )
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names
+            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) )
          ENDIF
 
-#if defined key_diaar5
-         IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
-            z2d(:,:) = 0._wp
-            zztmp = rau0 * rcp
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-            z2d(:,:) = zztmp * z2d(:,:)
-            CALL lbc_lnk( z2d, 'U', -1. )
-            CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
-            z2d(:,:) = 0._wp
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-            z2d(:,:) = zztmp * z2d(:,:)
-            CALL lbc_lnk( z2d, 'V', -1. )
-            CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in j-direction
-         END IF
-#endif
+         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
+           !
+           IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
+               z2d(:,:) = 0._wp 
+               DO jk = 1, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
+                     END DO
+                  END DO
+               END DO
+               z2d(:,:) = rau0_rcp * z2d(:,:) 
+               CALL lbc_lnk( z2d, 'U', -1. )
+               CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
+               !
+               z2d(:,:) = 0._wp 
+               DO jk = 1, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
+                     END DO
+                  END DO
+               END DO
+               z2d(:,:) = rau0_rcp * z2d(:,:)     
+               CALL lbc_lnk( z2d, 'V', -1. )
+               CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
+            END IF
+            !
+         ENDIF
          !
       END DO
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 5682)
@@ -102,5 +102,5 @@
                END DO
             END DO
-            IF( ln_zps ) THEN      ! set gradient at partial step level
+            IF( ln_zps ) THEN      ! set gradient at partial step level for the last ocean cell
                DO jj = 1, jpjm1
                   DO ji = 1, fs_jpim1   ! vector opt.
@@ -116,6 +116,12 @@
                         ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn)
                      ENDIF
-                     
-                     ! (ISH)
+                  END DO
+               END DO
+            ENDIF
+            ! (ISH)
+            IF( ln_zps .AND. ln_isfcav ) THEN      ! set gradient at partial step level for the first ocean cell
+                                                   ! into a cavity
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
                      ! ice shelf level level MAX(2,jk) => only where ice shelf
                      iku = miku(ji,jj) 
@@ -148,7 +154,7 @@
          !
          ! "Poleward" diffusive heat or salt transports
-         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
-            IF( jn  == jp_tem)   htr_ldf(:) = ptr_vj( ztv(:,:,:) )
-            IF( jn  == jp_sal)   str_ldf(:) = ptr_vj( ztv(:,:,:) )
+         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+            IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( ztv(:,:,:) )
+            IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( ztv(:,:,:) )
          ENDIF
          !                                                  ! ==================
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 5682)
@@ -9,5 +9,5 @@
    !!            3.0  ! 2008-06  (G. Madec)  applied on ta, sa and called before tranxt in step.F90
    !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
-   !!            3.7  ! 2014-06  (L. Brodeau) new algorithm based on local Brunt-Vaisala freq.
+   !!            3.6  ! 2015-05  (L. Brodeau) new algorithm based on local Brunt-Vaisala freq.
    !!----------------------------------------------------------------------
 
@@ -64,8 +64,9 @@
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       INTEGER  ::   inpcc        ! number of statically instable water column
-      INTEGER  ::   jiter, ikbot, ik, ikup, ikdown, ilayer, ikm   ! local integers
+      INTEGER  ::   jiter, ikbot, ikp, ikup, ikdown, ilayer, ik_low   ! local integers
       LOGICAL  ::   l_bottom_reached, l_column_treated
       REAL(wp) ::   zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z
       REAL(wp) ::   zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt
+      REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp       ! acceptance criteria for neutrality (N2==0)
       REAL(wp), POINTER, DIMENSION(:)       ::   zvn2   ! vertical profile of N2 at 1 given point...
       REAL(wp), POINTER, DIMENSION(:,:)     ::   zvts   ! vertical profile of T and S at 1 given point...
@@ -75,9 +76,7 @@
       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdt, ztrds   ! 3D workspace
       !
-      !!LB debug:
-      LOGICAL, PARAMETER :: l_LB_debug = .FALSE.
-      INTEGER :: ilc1, jlc1, klc1, nncpu
-      LOGICAL :: lp_monitor_point = .FALSE.
-      !!LB debug.
+      LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is
+      INTEGER :: ilc1, jlc1, klc1, nncpu         ! actually happening in a water column at point "ilc1, jlc1"
+      LOGICAL :: lp_monitor_point = .FALSE.      ! in CPU domain "nncpu"
       !!----------------------------------------------------------------------
       !
@@ -97,22 +96,13 @@
          ENDIF
 
-         !LB debug:
-         IF( lwp .AND. l_LB_debug ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) 'LOLO: entering tra_npc, kt, narea =', kt, narea
-         ENDIF
-         !LBdebug: Monitoring of 1 column subject to convection...
          IF( l_LB_debug ) THEN
-            ! Location of 1 known convection spot to follow what's happening in the water column
-            ilc1 = 54 ;  jlc1 = 15 ; ! Labrador ORCA1 4x4 cpus:
-            nncpu = 15  ; ! the CPU domain contains the convection spot
-            !ilc1 = 14 ;  jlc1 = 13 ; ! Labrador ORCA1 8x8 cpus:
-            !nncpu = 54  ; ! the CPU domain contains the convection spot
+            ! Location of 1 known convection site to follow what's happening in the water column
+            ilc1 = 45 ;  jlc1 = 3 ; !  ORCA2 4x4, Antarctic coast, more than 2 unstable portions in the  water column...           
+            nncpu = 1  ;            ! the CPU domain contains the convection spot
             klc1 =  mbkt(ilc1,jlc1) ! bottom of the ocean for debug point...          
          ENDIF
-         !LBdebug.
-
-         CALL eos_rab( tsa, zab )         ! after alpha and beta
-         CALL bn2    ( tsa, zab, zn2 )    ! after Brunt-Vaisala
+         
+         CALL eos_rab( tsa, zab )         ! after alpha and beta (given on T-points)
+         CALL bn2    ( tsa, zab, zn2 )    ! after Brunt-Vaisala  (given on W-points)
         
          inpcc = 0
@@ -134,19 +124,9 @@
                      IF( ( ji == ilc1 ).AND.( jj == jlc1 ) ) lp_monitor_point = .TRUE.
                      ! writing only if on CPU domain where conv region is:
-                     lp_monitor_point = (narea == nncpu).AND.lp_monitor_point 
-                     
-                     IF(lp_monitor_point) THEN
-                        WRITE(numout,*) '' ;WRITE(numout,*) '' ;
-                       WRITE(numout,'("Time step = ",i6.6," !!!")')  kt
-                        WRITE(numout,'(" *** BEFORE anything, N^2 for point ",i3,",",i3,":" )') ji,jj
-                        DO jk = 1, klc1
-                           WRITE(numout,*) jk, zvn2(jk)
-                        END DO
-                        WRITE(numout,*) ' '
-                     ENDIF
+                     lp_monitor_point = (narea == nncpu).AND.lp_monitor_point                      
                   ENDIF                                  !LB debug  end
 
                   ikbot = mbkt(ji,jj)   ! ikbot: ocean bottom T-level
-                  ik = 1                ! because N2 is irrelevant at the surface level (will start at ik=2)
+                  ikp = 1                  ! because N2 is irrelevant at the surface level (will start at ikp=2)
                   ilayer = 0
                   jiter  = 0
@@ -163,34 +143,48 @@
                      DO WHILE ( .NOT. l_bottom_reached )
 
-                        ik = ik + 1
+                        ikp = ikp + 1
                        
-                        !! Checking level ik for instability
+                        !! Testing level ikp for instability
                         !! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-                        IF( zvn2(ik) < 0. ) THEN ! Instability found!
-
-                           ikm  = ik              ! first level whith negative N2
-                           ilayer = ilayer + 1    ! yet another layer found....
-                           IF(jiter == 1) inpcc = inpcc + 1
-
-                           IF(l_LB_debug .AND. lp_monitor_point) &
-                              & WRITE(numout,*) 'Negative N2 at ik =', ikm, ' layer nb.', ilayer, &
-                              & ' inpcc =', inpcc
-
-                           !! Case we mix with upper regions where N2==0:
-                           !! All the points above ikup where N2 == 0 must also be mixed => we go
-                           !! upward to find a new ikup, where the layer doesn't have N2==0
-                           ikup = ikm
-                           DO jk = ikm, 2, -1
-                              ikup = ikup - 1
-                              IF( (zvn2(jk-1) > 0.).OR.(ikup == 1) ) EXIT
-                           END DO
-                          
-                           ! adjusting ikup if the upper part of the unstable column was neutral (N2=0)
-                           IF((zvn2(ikup+1) == 0.).AND.(ikup /= 1)) ikup = ikup+1 ;
-
-                          
-                           IF( lp_monitor_point )   WRITE(numout,*) ' => ikup is =', ikup, ' layer nb.', ilayer
-                          
+                        IF( zvn2(ikp) <  -zn2_zero ) THEN ! Instability found!
+
+                           ilayer = ilayer + 1    ! yet another instable portion of the water column found....
+
+                           IF( lp_monitor_point ) THEN 
+                              WRITE(numout,*)
+                              IF( ilayer == 1 .AND. jiter == 1 ) THEN   ! first time a column is spoted with an instability
+                                 WRITE(numout,*)
+                                 WRITE(numout,*) 'Time step = ',kt,' !!!'
+                              ENDIF
+                              WRITE(numout,*)  ' * Iteration #',jiter,': found instable portion #',ilayer,   &
+                                 &                                    ' in column! Starting at ikp =', ikp
+                              WRITE(numout,*)  ' *** N2 for point (i,j) = ',ji,' , ',jj
+                              DO jk = 1, klc1
+                                 WRITE(numout,*) jk, zvn2(jk)
+                              END DO
+                              WRITE(numout,*)
+                           ENDIF
+                           
+
+                           IF( jiter == 1 )   inpcc = inpcc + 1 
+
+                           IF( lp_monitor_point )   WRITE(numout, *) 'Negative N2 at ikp =',ikp,' for layer #', ilayer
+
+                           !! ikup is the uppermost point where mixing will start:
+                           ikup = ikp - 1 ! ikup is always "at most at ikp-1", less if neutral levels overlying
+                           
+                           !! If the points above ikp-1 have N2 == 0 they must also be mixed:
+                           IF( ikp > 2 ) THEN
+                              DO jk = ikp-1, 2, -1
+                                 IF( ABS(zvn2(jk)) < zn2_zero ) THEN
+                                    ikup = ikup - 1  ! 1 more upper level has N2=0 and must be added for the mixing
+                                 ELSE
+                                    EXIT
+                                 ENDIF
+                              END DO
+                           ENDIF
+                           
+                           IF( ikup < 1 )   CALL ctl_stop( 'tra_npc :  PROBLEM #1')
+
                            zsum_temp = 0._wp
                            zsum_sali = 0._wp
@@ -199,7 +193,5 @@
                            zsum_z    = 0._wp
                                                     
-                           DO jk = ikup, ikbot+1      ! Inside the instable (and overlying neutral) portion of the column
-                              !
-                              IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) '     -> summing for jk =', jk
+                           DO jk = ikup, ikbot      ! Inside the instable (and overlying neutral) portion of the column
                               !
                               zdz       = fse3t(ji,jj,jk)
@@ -209,16 +201,14 @@
                               zsum_beta = zsum_beta + zvab(jk,jp_sal)*zdz
                               zsum_z    = zsum_z    + zdz
-                              !
-                              !! EXIT if we found the bottom of the unstable portion of the water column    
-                              IF( (zvn2(jk+1) > 0.).OR.(jk == ikbot ).OR.((jk==ikm).AND.(zvn2(jk+1) == 0.)) )   EXIT
+                              !                              
+                              IF( jk == ikbot ) EXIT ! avoid array-index overshoot in case ikbot = jpk, cause we're calling jk+1 next line
+                              !! EXIT when we have reached the last layer that is instable (N2<0) or neutral (N2=0):
+                              IF( zvn2(jk+1) > zn2_zero ) EXIT
                            END DO
                           
-                           !ik     = jk !LB remove?
-                           ikdown = jk ! for the current unstable layer, ikdown is the deepest point with a negative N2
-                          
-                           IF(l_LB_debug .AND. lp_monitor_point) &
-                              &    WRITE(numout,*) '  => ikdown =', ikdown, '  layer nb.', ilayer
-                          
-                           ! Mixing Temperature and salinity between ikup and ikdown:
+                           ikdown = jk ! for the current unstable layer, ikdown is the deepest point with a negative or neutral N2
+                           IF( ikup == ikdown )   CALL ctl_stop( 'tra_npc :  PROBLEM #2')
+
+                           ! Mixing Temperature, salinity, alpha and beta from ikup to ikdown included:
                            zta   = zsum_temp/zsum_z
                            zsa   = zsum_sali/zsum_z
@@ -226,8 +216,10 @@
                            zbeta = zsum_beta/zsum_z
 
-                           IF(l_LB_debug .AND. lp_monitor_point) THEN
+                           IF( lp_monitor_point ) THEN
+                              WRITE(numout,*) 'MIXED T, S, alfa and beta between ikup =',ikup,   &
+                                 &            ' and ikdown =',ikdown,', in layer #',ilayer
                               WRITE(numout,*) '  => Mean temp. in that portion =', zta
                               WRITE(numout,*) '  => Mean sali. in that portion =', zsa
-                              WRITE(numout,*) '  => Mean Alpha in that portion =', zalfa
+                              WRITE(numout,*) '  => Mean Alfa  in that portion =', zalfa
                               WRITE(numout,*) '  => Mean Beta  in that portion =', zbeta
                            ENDIF
@@ -240,57 +232,64 @@
                               zvab(jk,jp_sal) = zbeta
                            END DO
-                           !
-                           !! Before updating N2, it is possible that another unstable
-                           !! layer exists underneath the one we just homogeneized!
-                           ik = ikdown
-                           ! 
-                        ENDIF  ! IF( zvn2(ik+1) < 0. ) THEN
-                        !
-                        IF( ik == ikbot ) l_bottom_reached = .TRUE.
+                           
+                           
+                           !! Updating N2 in the relvant portion of the water column
+                           !! Temperature, Salinity, Alpha and Beta have been homogenized in the unstable portion
+                           !! => Need to re-compute N2! will use Alpha and Beta!
+                           
+                           ikup   = MAX(2,ikup)         ! ikup can never be 1 !
+                           ik_low = MIN(ikdown+1,ikbot) ! we must go 1 point deeper than ikdown!
+                           
+                           DO jk = ikup, ik_low              ! we must go 1 point deeper than ikdown!
+
+                              !! Interpolating alfa and beta at W point:
+                              zrw =  (fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk)) &
+                                 & / (fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk))
+                              zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw
+                              zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw
+
+                              !! N2 at W point, doing exactly as in eosbn2.F90:
+                              zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     &
+                                 &            - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )  &
+                                 &       / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+
+                              !! OR, faster  => just considering the vertical gradient of density
+                              !! as only the signa maters...
+                              !zvn2(jk) = (  zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     &
+                              !     &      - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )
+
+                           END DO
+                        
+                           ikp = MIN(ikdown+1,ikbot)
+                           
+
+                        ENDIF  !IF( zvn2(ikp) < 0. )
+
+
+                        IF( ikp == ikbot ) l_bottom_reached = .TRUE.
                         !
                      END DO ! DO WHILE ( .NOT. l_bottom_reached )
 
-                     IF( ik /= ikbot )   STOP 'ERROR: tranpc.F90 => PROBLEM #1'
+                     IF( ikp /= ikbot )   CALL ctl_stop( 'tra_npc :  PROBLEM #3')
                     
-                     ! ******* At this stage ik == ikbot ! *******
+                     ! ******* At this stage ikp == ikbot ! *******
                     
-                     IF( ilayer > 0 ) THEN
-                        !! least an unstable layer has been found
-                        !! Temperature, Salinity, Alpha and Beta have been homogenized in the unstable portion
-                        !! => Need to re-compute N2! will use Alpha and Beta!
+                     IF( ilayer > 0 ) THEN      !! least an unstable layer has been found
                         !
-                        DO jk = ikup+1, ikdown+1   ! we must go 1 point deeper than ikdown!     
-                           !! Doing exactly as in eosbn2.F90:
-                           !! * Except that we only are interested in the sign of N2 !!!
-                           !!   => just considering the vertical gradient of density
-                           zrw =   (fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk)) &
-                               & / (fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk))
-                           zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw
-                           zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw
-                          
-                           !zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     &
-                           !     &           - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )  &
-                           !     &       / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
-                           zvn2(jk) = (  zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     &
-                                &      - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )  
-                        END DO
-
-                        IF(l_LB_debug .AND. lp_monitor_point) THEN
-                           WRITE(numout, '(" *** After iteration #",i3.3,", N^2 for point ",i3,",",i3,":" )') &
-                              & jiter, ji,jj
+                        IF( lp_monitor_point ) THEN
+                           WRITE(numout,*)
+                           WRITE(numout,*) 'After ',jiter,' iteration(s), we neutralized ',ilayer,' instable layer(s)'
+                           WRITE(numout,*) '   ==> N2 at i,j=',ji,',',jj,' now looks like this:'
                            DO jk = 1, klc1
                               WRITE(numout,*) jk, zvn2(jk)
                            END DO
-                           WRITE(numout,*) ' '
+                           WRITE(numout,*)
                         ENDIF
-
-                        ik     = 1  ! starting again at the surface for the next iteration
+                        !
+                        ikp    = 1     ! starting again at the surface for the next iteration
                         ilayer = 0
                      ENDIF
                      !
-                     IF( ik >= ikbot ) THEN
-                        IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) '    --- exiting jiter loop ---'
-                        l_column_treated = .TRUE.
-                     ENDIF
+                     IF( ikp >= ikbot )   l_column_treated = .TRUE.
                      !
                   END DO ! DO WHILE ( .NOT. l_column_treated )
@@ -300,8 +299,8 @@
                   tsa(ji,jj,:,jp_sal) = zvts(:,jp_sal)
 
-                  !! lolo:  Should we update something else????
-                  !! => like alpha and beta?
-
-                  IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) ''
+                  !! LB:  Potentially some other global variable beside theta and S can be treated here
+                  !!      like BGC tracers.
+
+                  IF( lp_monitor_point )   WRITE(numout,*)
 
                ENDIF ! IF( tmask(ji,jj,3) == 1 ) THEN
@@ -321,8 +320,7 @@
          CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ;   CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
          !
-         IF(lwp) THEN
-            WRITE(numout,*) 'LOLO: exiting tra_npc, kt =', kt
-            WRITE(numout,*)' => number of statically instable water column : ',inpcc
-            WRITE(numout,*) '' ; WRITE(numout,*) ''
+         IF( lwp .AND. l_LB_debug ) THEN
+            WRITE(numout,*) 'Exiting tra_npc , kt = ',kt,', => numb. of statically instable water-columns: ', inpcc
+            WRITE(numout,*)
          ENDIF
          !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 5682)
@@ -27,4 +27,6 @@
    USE dom_oce         ! ocean space and time domain variables 
    USE sbc_oce         ! surface boundary condition: ocean
+   USE sbcrnf          ! river runoffs
+   USE sbcisf          ! ice shelf melting/freezing
    USE zdf_oce         ! ocean vertical mixing
    USE domvvl          ! variable volume
@@ -45,5 +47,4 @@
    USE timing          ! Timing
 #if defined key_agrif
-   USE agrif_opa_update
    USE agrif_opa_interp
 #endif
@@ -109,4 +110,8 @@
       ! Update after tracer on domain lateral boundaries
       ! 
+#if defined key_agrif
+      CALL Agrif_tra                     ! AGRIF zoom boundaries
+#endif
+      !
       CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign)
       CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
@@ -114,7 +119,4 @@
 #if defined key_bdy 
       IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
-#endif
-#if defined key_agrif
-      CALL Agrif_tra                     ! AGRIF zoom boundaries
 #endif
  
@@ -143,13 +145,9 @@
       ELSE                                            ! Leap-Frog + Asselin filter time stepping
          !
-         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, 'TRA', tsb, tsn, tsa, jpts )  ! variable volume level (vvl)     
-         ELSE                 ;   CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level 
+         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa,   &
+           &                                                              sbc_tsc, sbc_tsc_b, jpts )  ! variable volume level (vvl) 
+         ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level 
          ENDIF
-      ENDIF 
-      !
-#if defined key_agrif
-      ! Update tracer at AGRIF zoom boundaries
-      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only
-#endif      
+      ENDIF     
       !
       ! trends computation
@@ -241,5 +239,5 @@
 
 
-   SUBROUTINE tra_nxt_vvl( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
+   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE tra_nxt_vvl  ***
@@ -265,13 +263,17 @@
       !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
       !!----------------------------------------------------------------------
-      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
-      INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index
-      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
-      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
-      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
+      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index
+      INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step
+      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content
+      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content
+
       !!     
-      LOGICAL  ::   ll_tra, ll_tra_hpg, ll_traqsr   ! local logical
+      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf   ! local logical
       INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
       REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
@@ -286,16 +288,22 @@
       !
       IF( cdtype == 'TRA' )  THEN   
-         ll_tra     = .TRUE.           ! active tracers case  
          ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg
          ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
+         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
+         IF (nn_isf .GE. 1) THEN 
+            ll_isf = .TRUE.            ! active  tracers case  and  ice shelf melting/freezing
+         ELSE
+            ll_isf = .FALSE.
+         END IF
       ELSE                          
-         ll_tra     = .FALSE.          ! passive tracers case
          ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
          ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
+         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs
+         ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing
       ENDIF
       !
       DO jn = 1, kjpt      
          DO jk = 1, jpkm1
-            zfact1 = atfp * rdttra(jk)
+            zfact1 = atfp * p2dt(jk)
             zfact2 = zfact1 / rau0
             DO jj = 1, jpj
@@ -315,19 +323,40 @@
                   ztc_f  = ztc_n  + atfp * ztc_d
                   !
-                  IF( ll_tra .AND. jk == 1 ) THEN           ! first level only for T & S
-                      ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) )
-                      ztc_f  = ztc_f  - zfact1 * ( sbc_tsc(ji,jj,jn) - sbc_tsc_b(ji,jj,jn) )
+                  IF( jk == mikt(ji,jj) ) THEN           ! first level 
+                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
+                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
+                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
+                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
                   ENDIF
-                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only)
+
+                  ! solar penetration (temperature only)
+                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
                      &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
 
-                   ze3t_f = 1.e0 / ze3t_f
-                   ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
-                   ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
-                   !
-                   IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
-                      ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
-                      pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
-                   ENDIF
+                  ! river runoff
+                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
+                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
+                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
+
+                  ! ice shelf
+                  IF( ll_isf ) THEN
+                     ! level fully include in the Losch_2008 ice shelf boundary layer
+                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
+                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
+                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
+                     ! level partially include in Losch_2008 ice shelf boundary layer 
+                     IF ( jk == misfkb(ji,jj) )                                                   &
+                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
+                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
+                  END IF
+
+                  ze3t_f = 1.e0 / ze3t_f
+                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
+                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
+                  !
+                  IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
+                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
+                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
+                  ENDIF
                END DO
             END DO
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 5682)
@@ -32,5 +32,4 @@
    USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
-   USE sbc_ice, ONLY : lk_lim3
 
    IMPLICIT NONE
@@ -38,5 +37,5 @@
 
    PUBLIC   tra_qsr       ! routine called by step.F90 (ln_traqsr=T)
-   PUBLIC   tra_qsr_init  ! routine called by opa.F90
+   PUBLIC   tra_qsr_init  ! routine called by nemogcm.F90
 
    !                                 !!* Namelist namtra_qsr: penetrative solar radiation
@@ -50,5 +49,5 @@
    REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands)
    REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands)
-   
+ 
    ! Module variables
    REAL(wp) ::   xsi0r                           !: inverse of rn_si0
@@ -165,9 +164,11 @@
          CALL iom_put( 'qsr3d', etot3 )   ! Shortwave Radiation 3D distribution
          ! clem: store attenuation coefficient of the first ocean level
-         IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+         IF ( ln_qsr_ice ) THEN
             DO jj = 1, jpj
                DO ji = 1, jpi
                   IF ( qsr(ji,jj) /= 0._wp ) THEN
                      fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) )
+                  ELSE
+                     fraqsr_1lev(ji,jj) = 1.
                   ENDIF
                END DO
@@ -233,5 +234,5 @@
                END DO
                ! clem: store attenuation coefficient of the first ocean level
-               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+               IF ( ln_qsr_ice ) THEN
                   DO jj = 1, jpj
                      DO ji = 1, jpi
@@ -256,5 +257,5 @@
                END DO
                ! clem: store attenuation coefficient of the first ocean level
-               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+               IF ( ln_qsr_ice ) THEN
                   fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp
                ENDIF
@@ -279,5 +280,5 @@
                END DO
                ! clem: store attenuation coefficient of the first ocean level
-               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+               IF ( ln_qsr_ice ) THEN
                   DO jj = 1, jpj
                      DO ji = 1, jpi
@@ -298,5 +299,5 @@
                END DO
                ! clem: store attenuation coefficient of the first ocean level
-               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+               IF ( ln_qsr_ice ) THEN
                   fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp
                ENDIF
@@ -324,5 +325,6 @@
             &                    'at it= ', kt,' date= ', ndastp
          IF(lwp) WRITE(numout,*) '~~~~'
-         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc )
+         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      )
+         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev )   ! default definition in sbcssm 
          !
       ENDIF
@@ -379,9 +381,4 @@
       !
       IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init')
-      !
-      ! Default value for fraqsr_1lev
-      IF( .NOT. ln_rstart ) THEN
-         fraqsr_1lev(:,:) = 1._wp
-      ENDIF
       !
       CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        ) 
@@ -412,5 +409,4 @@
          WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0
          WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1
-         WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice    
       ENDIF
 
@@ -564,4 +560,11 @@
       ENDIF
       !
+      ! initialisation of fraqsr_1lev used in sbcssm
+      IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN
+         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  )
+      ELSE
+         fraqsr_1lev(:,:) = 1._wp   ! default definition
+      ENDIF
+      !
       CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        ) 
       CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 5682)
@@ -9,4 +9,5 @@
    !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
    !!             -   !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!            3.6  !  2014-11  (P. Mathiot) isf melting forcing 
    !!----------------------------------------------------------------------
 
@@ -20,4 +21,5 @@
    USE sbcmod          ! ln_rnf  
    USE sbcrnf          ! River runoff  
+   USE sbcisf          ! Ice shelf   
    USE traqsr          ! solar radiation penetration
    USE trd_oce         ! trends: ocean variables
@@ -26,7 +28,4 @@
    USE in_out_manager  ! I/O manager
    USE prtctl          ! Print control
-   USE sbcrnf          ! River runoff  
-   USE sbcisf          ! Ice shelf   
-   USE sbcmod          ! ln_rnf  
    USE iom
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
@@ -121,5 +120,4 @@
       REAL(wp) ::   zfact, z1_e3t, zdep
       REAL(wp) ::   zalpha, zhk
-      REAL(wp) ::  zt_frz, zpress
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
@@ -233,11 +231,7 @@
                DO jk = ikt, ikb - 1
                ! compute tfreez for the temperature correction (we add water at freezing temperature)
-!                  zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04
-                  zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress )
                ! compute trend
                   tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                          &
-                     &           + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)          &
-                     &               - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) &
-                     &           * r1_hisf_tbl(ji,jj)
+                     &           + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)) * r1_hisf_tbl(ji,jj)
                   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)                                          &
                      &           + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj)
@@ -246,11 +240,7 @@
                ! level partially include in ice shelf boundary layer 
                ! compute tfreez for the temperature correction (we add water at freezing temperature)
-!               zpress = grav*rau0*fsdept(ji,jj,ikb)*1.e-04
-               zt_frz = -1.9 !eos_fzp( tsn(ji,jj,ikb,jp_sal), zpress )
                ! compute trend
                tsa(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem)                                           &
-                  &              + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)          &
-                  &                  - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) & 
-                  &              * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
+                  &              + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
                tsa(ji,jj,ikb,jp_sal) = tsa(ji,jj,ikb,jp_sal)                                           &
                   &              + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 5682)
@@ -88,4 +88,8 @@
          &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       END SELECT
+      ! DRAKKAR SSS control {
+      ! JMM avoid negative salinities near river outlet ! Ugly fix
+      ! JMM : restore negative salinities to small salinities:
+      WHERE ( tsa(:,:,:,jp_sal) < 0._wp )   tsa(:,:,:,jp_sal) = 0.1_wp
 
       IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 5682)
@@ -122,5 +122,5 @@
             DO jj=1, jpj
                DO ji=1, jpi
-                  zwt(ji,jj,1:mikt(ji,jj)) = 0._wp
+                  zwt(ji,jj,1) = 0._wp
                END DO
             END DO
@@ -184,6 +184,10 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1
-                  zwt(ji,jj,1:mikt(ji,jj)) = zwd(ji,jj,1:mikt(ji,jj))
-                  DO jk = mikt(ji,jj)+1, jpkm1
+                  zwt(ji,jj,1) = zwd(ji,jj,1)
+               END DO
+            END DO
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
                      zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
                   END DO
@@ -196,9 +200,13 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
-               ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,mikt(ji,jj))
-               ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,mikt(ji,jj))
-               pta(ji,jj,mikt(ji,jj),jn) = ze3tb * ptb(ji,jj,mikt(ji,jj),jn)                     &
-                  &                      + p2dt(mikt(ji,jj)) * ze3tn * pta(ji,jj,mikt(ji,jj),jn)
-               DO jk = mikt(ji,jj)+1, jpkm1
+               ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,1)
+               ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,1)
+               pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn)                     &
+                  &                      + p2dt(1) * ze3tn * pta(ji,jj,1,jn)
+            END DO
+         END DO
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
                   ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,jk)
                   ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t  (ji,jj,jk)
@@ -213,5 +221,9 @@
             DO ji = fs_2, fs_jpim1
                pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
-               DO jk = jpk-2, mikt(ji,jj), -1
+            END DO
+         END DO
+         DO jk = jpk-2, 1, -1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
                   pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) )   &
                      &             / zwt(ji,jj,jk) * tmask(ji,jj,jk)
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 5682)
@@ -8,4 +8,5 @@
    !!             -   !  2004-03  (C. Ethe)  adapted for passive tracers
    !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!            3.6  !  2014-11  (P. Mathiot) Add zps_hde_isf (needed to open a cavity)
    !!======================================================================
    
@@ -27,5 +28,6 @@
    PRIVATE
 
-   PUBLIC   zps_hde    ! routine called by step.F90
+   PUBLIC   zps_hde     ! routine called by step.F90
+   PUBLIC   zps_hde_isf ! routine called by step.F90
 
    !! * Substitutions
@@ -40,6 +42,161 @@
 
    SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv,   &
+      &                          prd, pgru, pgrv    )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE zps_hde  ***
+      !!                    
+      !! ** Purpose :   Compute the horizontal derivative of T, S and rho
+      !!      at u- and v-points with a linear interpolation for z-coordinate
+      !!      with partial steps.
+      !!
+      !! ** Method  :   In z-coord with partial steps, scale factors on last 
+      !!      levels are different for each grid point, so that T, S and rd 
+      !!      points are not at the same depth as in z-coord. To have horizontal
+      !!      gradients again, we interpolate T and S at the good depth : 
+      !!      Linear interpolation of T, S   
+      !!         Computation of di(tb) and dj(tb) by vertical interpolation:
+      !!          di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~
+      !!          dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~
+      !!         This formulation computes the two cases:
+      !!                 CASE 1                   CASE 2  
+      !!         k-1  ___ ___________   k-1   ___ ___________
+      !!                    Ti  T~                  T~  Ti+1
+      !!                  _____                        _____
+      !!         k        |   |Ti+1     k           Ti |   |
+      !!                  |   |____                ____|   |
+      !!              ___ |   |   |           ___  |   |   |
+      !!                  
+      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
+      !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1)
+      !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  )
+      !!          or
+      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
+      !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i )
+      !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) )
+      !!          Idem for di(s) and dj(s)          
+      !!
+      !!      For rho, we call eos which will compute rd~(t~,s~) at the right
+      !!      depth zh from interpolated T and S for the different formulations
+      !!      of the equation of state (eos).
+      !!      Gradient formulation for rho :
+      !!          di(rho) = rd~ - rd(i,j,k)   or   rd(i+1,j,k) - rd~
+      !!
+      !! ** Action  : compute for top interfaces
+      !!              - pgtu, pgtv: horizontal gradient of tracer at u- & v-points
+      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index
+      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom)
+      !
+      INTEGER  ::   ji, jj, jn      ! Dummy loop indices
+      INTEGER  ::   iku, ikv, ikum1, ikvm1   ! partial step level (ocean bottom level) at u- and v-points
+      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj)      ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos
+      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::  zti, ztj             ! 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde')
+      !
+      pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ;
+      zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ;
+      zhi (:,:  )=0.0_wp ; zhj (:,:  )=0.0_wp ;
+      !
+      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
+               ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
+               ze3wu = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
+               ze3wv = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+               !
+               ! i- direction
+               IF( ze3wu >= 0._wp ) THEN      ! case 1
+                  zmaxu =  ze3wu / fse3w(ji+1,jj,iku)
+                  ! interpolated values of tracers
+                  zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
+                  ! gradient of  tracers
+                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+               ELSE                           ! case 2
+                  zmaxu = -ze3wu / fse3w(ji,jj,iku)
+                  ! interpolated values of tracers
+                  zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
+                  ! gradient of tracers
+                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+               ENDIF
+               !
+               ! j- direction
+               IF( ze3wv >= 0._wp ) THEN      ! case 1
+                  zmaxv =  ze3wv / fse3w(ji,jj+1,ikv)
+                  ! interpolated values of tracers
+                  ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+               ELSE                           ! case 2
+                  zmaxv =  -ze3wv / fse3w(ji,jj,ikv)
+                  ! interpolated values of tracers
+                  ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+               ENDIF
+            END DO
+         END DO
+         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
+         !
+      END DO
+
+      ! horizontal derivative of density anomalies (rd)
+      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
+         pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ; 
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               iku = mbku(ji,jj)
+               ikv = mbkv(ji,jj)
+               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
+               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji  ,jj,iku)     ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = fsdept(ji+1,jj,iku)     ! -     -      case 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv)     ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv)     ! -     -      case 2
+               ENDIF
+            END DO
+         END DO
+
+         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
+         ! step and store it in  zri, zrj for each  case
+         CALL eos( zti, zhi, zri )  
+         CALL eos( ztj, zhj, zrj )
+
+         ! Gradient of density at the last level 
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               iku = mbku(ji,jj)
+               ikv = mbkv(ji,jj)
+               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
+               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1
+               ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1
+               ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2
+               ENDIF
+            END DO
+         END DO
+         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions
+         !
+      END IF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde')
+      !
+   END SUBROUTINE zps_hde
+   !
+   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv,   &
       &                          prd, pgru, pgrv, pmru, pmrv, pgzu, pgzv, pge3ru, pge3rv,  &
-      &                   sgtu, sgtv, sgru, sgrv, smru, smrv, sgzu, sgzv, sge3ru, sge3rv )
+      &                   pgtui, pgtvi, pgrui, pgrvi, pmrui, pmrvi, pgzui, pgzvi, pge3rui, pge3rvi )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE zps_hde  ***
@@ -82,9 +239,9 @@
       !!
       !! ** Action  : compute for top and bottom interfaces
-      !!              - pgtu, pgtv, sgtu, sgtv: horizontal gradient of tracer at u- & v-points
-      !!              - pgru, pgrv, sgru, sgtv: horizontal gradient of rho (if present) at u- & v-points
-      !!              - pmru, pmrv, smru, smrv: horizontal sum of rho at u- & v- point (used in dynhpg with vvl)
-      !!              - pgzu, pgzv, sgzu, sgzv: horizontal gradient of z at u- and v- point (used in dynhpg with vvl)
-      !!              - pge3ru, pge3rv, sge3ru, sge3rv: horizontal gradient of rho weighted by local e3w at u- & v-points 
+      !!              - pgtu, pgtv, pgtui, pgtvi: horizontal gradient of tracer at u- & v-points
+      !!              - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points
+      !!              - pmru, pmrv, pmrui, pmrvi: horizontal sum of rho at u- & v- point (used in dynhpg with vvl)
+      !!              - pgzu, pgzv, pgzui, pgzvi: horizontal gradient of z at u- and v- point (used in dynhpg with vvl)
+      !!              - pge3ru, pge3rv, pge3rui, pge3rvi: horizontal gradient of rho weighted by local e3w at u- & v-points 
       !!----------------------------------------------------------------------
       INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index
@@ -92,5 +249,5 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields
       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
-      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  sgtu, sgtv  ! hor. grad. of stra at u- & v-pts (ISF)
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtui, pgtvi  ! hor. grad. of stra at u- & v-pts (ISF)
       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv      ! hor. grad of prd at u- & v-pts (bottom)
@@ -98,8 +255,8 @@
       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzu, pgzv      ! hor. grad of z   at u- & v-pts (bottom)
       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3ru, pge3rv  ! hor. grad of prd weighted by local e3w at u- & v-pts (bottom)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  sgru, sgrv      ! hor. grad of prd at u- & v-pts (top)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  smru, smrv      ! hor. sum  of prd at u- & v-pts (top)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  sgzu, sgzv      ! hor. grad of z   at u- & v-pts (top)
-      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  sge3ru, sge3rv  ! hor. grad of prd weighted by local e3w at u- & v-pts (top)
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi      ! hor. grad of prd at u- & v-pts (top)
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pmrui, pmrvi      ! hor. sum  of prd at u- & v-pts (top)
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzui, pgzvi      ! hor. grad of z   at u- & v-pts (top)
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3rui, pge3rvi  ! hor. grad of prd weighted by local e3w at u- & v-pts (top)
       !
       INTEGER  ::   ji, jj, jn      ! Dummy loop indices
@@ -110,8 +267,8 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde')
+      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde_isf')
       !
       pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ;
-      sgtu(:,:,:)=0.0_wp ; sgtv(:,:,:)=0.0_wp ;
+      pgtui(:,:,:)=0.0_wp ; pgtvi(:,:,:)=0.0_wp ;
       zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ;
       zhi (:,:  )=0.0_wp ; zhj (:,:  )=0.0_wp ;
@@ -256,5 +413,5 @@
                   zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku+1,jn) - pta(ji+1,jj,iku,jn) )
                   ! gradient of tracers
-                  sgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+                  pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
                ELSE                           ! case 2
                   zmaxu = - ze3wu / fse3w(ji,jj,iku+1)
@@ -262,5 +419,5 @@
                   zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku+1,jn) - pta(ji,jj,iku,jn) )
                   ! gradient of  tracers
-                  sgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+                  pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
                ENDIF
                !
@@ -271,5 +428,5 @@
                   ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv+1,jn) - pta(ji,jj+1,ikv,jn) )
                   ! gradient of tracers
-                  sgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+                  pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
                ELSE                           ! case 2
                   zmaxv =  - ze3wv / fse3w(ji,jj,ikv+1)
@@ -277,9 +434,9 @@
                   ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv+1,jn) - pta(ji,jj,ikv,jn) )
                   ! gradient of tracers
-                  sgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+                  pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
                ENDIF
             END DO!!
          END DO!!
-         CALL lbc_lnk( sgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( sgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
+         CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
          !
       END DO
@@ -287,8 +444,8 @@
       ! horizontal derivative of density anomalies (rd)
       IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
-         sgru(:,:)  =0.0_wp ; sgrv(:,:)  =0.0_wp ;
-         sgzu(:,:)  =0.0_wp ; sgzv(:,:)  =0.0_wp ;
-         smru(:,:)  =0.0_wp ; smru(:,:)  =0.0_wp ;
-         sge3ru(:,:)=0.0_wp ; sge3rv(:,:)=0.0_wp ;
+         pgrui(:,:)  =0.0_wp ; pgrvi(:,:)  =0.0_wp ;
+         pgzui(:,:)  =0.0_wp ; pgzvi(:,:)  =0.0_wp ;
+         pmrui(:,:)  =0.0_wp ; pmrui(:,:)  =0.0_wp ;
+         pge3rui(:,:)=0.0_wp ; pge3rvi(:,:)=0.0_wp ;
 
          DO jj = 1, jpjm1
@@ -321,31 +478,31 @@
                ze3wv  = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv))
                IF( ze3wu >= 0._wp ) THEN
-                 sgzu  (ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku)
-                 sgru  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) - prd(ji,jj,iku) )          ! i: 1
-                 smru  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) + prd(ji,jj,iku) )          ! i: 1 
-                 sge3ru(ji,jj) = umask(ji,jj,iku+1)                                                                  &
+                 pgzui  (ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku)
+                 pgrui  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) - prd(ji,jj,iku) )          ! i: 1
+                 pmrui  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) + prd(ji,jj,iku) )          ! i: 1 
+                 pge3rui(ji,jj) = umask(ji,jj,iku+1)                                                                  &
                                 * ( (fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj    ) + prd(ji+1,jj,iku+1) + 2._wp)   &
                                    - fse3w(ji  ,jj,iku+1)          * (prd(ji,jj,iku) + prd(ji  ,jj,iku+1) + 2._wp)   ) ! i: 1
                ELSE
-                 sgzu  (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu)
-                 sgru  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) - zri(ji,jj) )      ! i: 2
-                 smru  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) + zri(ji,jj) )      ! i: 2
-                 sge3ru(ji,jj) = umask(ji,jj,iku+1)                                                                   &
+                 pgzui  (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu)
+                 pgrui  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) - zri(ji,jj) )      ! i: 2
+                 pmrui  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) + zri(ji,jj) )      ! i: 2
+                 pge3rui(ji,jj) = umask(ji,jj,iku+1)                                                                   &
                                 * (  fse3w(ji+1,jj,iku+1)          * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp)  &
                                    -(fse3w(ji  ,jj,iku+1) + ze3wu) * (zri(ji,jj      ) + prd(ji  ,jj,iku+1) + 2._wp)  )     ! i: 2
                ENDIF
                IF( ze3wv >= 0._wp ) THEN
-                 sgzv  (ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv) 
-                 sgrv  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )        ! j: 1
-                 smrv  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) + prd(ji,jj,ikv) )        ! j: 1
-                 sge3rv(ji,jj) = vmask(ji,jj,ikv+1)                                                                  & 
+                 pgzvi  (ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv) 
+                 pgrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )        ! j: 1
+                 pmrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) + prd(ji,jj,ikv) )        ! j: 1
+                 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1)                                                                  & 
                                 * ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj    ) + prd(ji,jj+1,ikv+1) + 2._wp)  &
                                    - fse3w(ji,jj  ,ikv+1)          * ( prd(ji,jj,ikv) + prd(ji,jj  ,ikv+1) + 2._wp)  ) ! j: 1
                                   ! + 2 due to the formulation in density and not in anomalie in hpg sco
                ELSE
-                 sgzv  (ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv)
-                 sgrv  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )     ! j: 2
-                 smrv  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) + zrj(ji,jj) )     ! j: 2
-                 sge3rv(ji,jj) = vmask(ji,jj,ikv+1)                                                                   &
+                 pgzvi  (ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv)
+                 pgrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )     ! j: 2
+                 pmrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) + zrj(ji,jj) )     ! j: 2
+                 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1)                                                                   &
                                 * (  fse3w(ji,jj+1,ikv+1)          * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) &
                                    -(fse3w(ji,jj  ,ikv+1) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikv+1) + 2._wp) )  ! j: 2
@@ -353,15 +510,14 @@
             END DO
          END DO
-         CALL lbc_lnk( sgru   , 'U', -1. )   ;   CALL lbc_lnk( sgrv   , 'V', -1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( smru   , 'U',  1. )   ;   CALL lbc_lnk( smrv   , 'V',  1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( sgzu   , 'U', -1. )   ;   CALL lbc_lnk( sgzv   , 'V', -1. )   ! Lateral boundary conditions
-         CALL lbc_lnk( sge3ru , 'U', -1. )   ;   CALL lbc_lnk( sge3rv , 'V', -1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( pgrui   , 'U', -1. )   ;   CALL lbc_lnk( pgrvi   , 'V', -1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( pmrui   , 'U',  1. )   ;   CALL lbc_lnk( pmrvi   , 'V',  1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( pgzui   , 'U', -1. )   ;   CALL lbc_lnk( pgzvi   , 'V', -1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( pge3rui , 'U', -1. )   ;   CALL lbc_lnk( pge3rvi , 'V', -1. )   ! Lateral boundary conditions
          !
       END IF  
       !
-      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde')
-      !
-   END SUBROUTINE zps_hde
-
+      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde_isf')
+      !
+   END SUBROUTINE zps_hde_isf
    !!======================================================================
 END MODULE zpshde
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90	(revision 5682)
@@ -76,5 +76,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: trd_oce.F90 3318 2012-02-25 15:50:01Z gm $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90	(revision 5682)
@@ -40,5 +40,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: trddyn.F90 3325 2012-03-12 14:44:43Z gm $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90	(revision 5682)
@@ -56,5 +56,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: trdglo.F90 3325 2012-03-12 14:44:43Z gm $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90	(revision 5682)
@@ -30,5 +30,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: trdini.F90 3329 2012-03-16 12:22:15Z gm $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90	(revision 5682)
@@ -44,5 +44,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: trdken.F90 3329 2012-03-16 12:22:15Z gm $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -117,28 +117,28 @@
       !
       SELECT CASE( ktrd )
-      	CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient
-      	CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient
-      	CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit)
-      	CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter)
-      	CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity
-      	CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term)
-      	CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had)
-      	CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection
-      	CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion
-      	CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion 
+         CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient
+         CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient
+         CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit)
+         CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter)
+         CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity
+         CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term)
+         CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had)
+         CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection
+         CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion
+         CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion 
                                  !                                   ! wind stress trends
-                              	CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d )
-         						z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1)
-         						z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1)
-         						zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp
-         						DO jj = 2, jpj
-            					   DO ji = 2, jpi
-               						zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   &
-                  					&                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1)
-            					   END DO
-         						END DO
-                              	CALL iom_put( "ketrd_tau", zke2d )
-                              	CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d )
-      	CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case) 
+                                 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d )
+                           z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1)
+                           z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1)
+                           zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp
+                           DO jj = 2, jpj
+                              DO ji = 2, jpi
+                                 zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   &
+                                 &                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1)
+                              END DO
+                           END DO
+                                 CALL iom_put( "ketrd_tau", zke2d )
+                                 CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d )
+         CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case) 
 !!gm TO BE DONE properly
 !!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation....
@@ -162,5 +162,5 @@
 !         ENDIF
 !!gm end
-      	CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends 
+         CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends 
 !! a faire !!!!  idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!!
 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf....
@@ -184,12 +184,12 @@
 !                              CALL iom_put( "ketrd_bfri", zke2d )
 !         ENDIF
-      	CASE( jpdyn_ken )   ;   ! kinetic energy
-      							! called in dynnxt.F90 before asselin time filter
-      							! with putrd=ua and pvtrd=va
-      							zke(:,:,:) = 0.5_wp * zke(:,:,:)
-      							CALL iom_put( "KE", zke )
-      							!
-      							CALL ken_p2k( kt , zke )
-            					CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w
+         CASE( jpdyn_ken )   ;   ! kinetic energy
+                           ! called in dynnxt.F90 before asselin time filter
+                           ! with putrd=ua and pvtrd=va
+                           zke(:,:,:) = 0.5_wp * zke(:,:,:)
+                           CALL iom_put( "KE", zke )
+                           !
+                           CALL ken_p2k( kt , zke )
+                           CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w
          !
       END SELECT
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90	(revision 5682)
@@ -77,5 +77,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: trdmxl.F90 3318 2012-02-25 15:50:01Z gm $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -165,11 +165,11 @@
 
 
-		SELECT CASE( ktrd )
-		CASE( jptra_npc  )               ! non-penetrative convection: regrouped with zdf
+         SELECT CASE( ktrd )
+         CASE( jptra_npc  )               ! non-penetrative convection: regrouped with zdf
 !!gm : to be completed ! 
 !		   IF( ....
 !!gm end
-		CASE( jptra_zdfp )               ! iso-neutral diffusion: "pure" vertical diffusion
-		   !                                   ! regroup iso-neutral diffusion in one term
+         CASE( jptra_zdfp )               ! iso-neutral diffusion: "pure" vertical diffusion
+!                                   ! regroup iso-neutral diffusion in one term
          tmltrd(:,:,jpmxl_ldf) = tmltrd(:,:,jpmxl_ldf) + ( tmltrd(:,:,jpmxl_zdf) - tmltrd(:,:,jpmxl_zdfp) )
          smltrd(:,:,jpmxl_ldf) = smltrd(:,:,jpmxl_ldf) + ( smltrd(:,:,jpmxl_zdf) - smltrd(:,:,jpmxl_zdfp) )
@@ -811,5 +811,5 @@
 
 
-   	nkstp     = nit000 - 1              ! current time step indicator initialization
+       nkstp     = nit000 - 1              ! current time step indicator initialization
 
 
@@ -851,5 +851,5 @@
       IF( nn_ctls == 1 ) THEN
          CALL ctl_opn( inum, 'ctlsurf_idx', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, lwp )
-         READ ( inum ) nbol
+         READ ( inum, * ) nbol
          CLOSE( inum )
       END IF
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90	(revision 5682)
@@ -83,5 +83,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id: $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90	(revision 5682)
@@ -27,5 +27,5 @@
    !!---------------------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: $ 
+   !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!---------------------------------------------------------------------------------
@@ -43,5 +43,6 @@
       INTEGER ::   jk                 ! loop indice
       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
-      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name
+      CHARACTER(LEN=50)   ::   clname   ! output restart file name
+      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file
       !!--------------------------------------------------------------------------------
 
@@ -56,4 +57,6 @@
          ! create the file
          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_out)
+         clpath = TRIM(cn_ocerst_outdir)
+         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
          IF(lwp) THEN
             WRITE(numout,*)
@@ -67,5 +70,5 @@
          ENDIF
 
-         CALL iom_open( clname, nummxlw, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_open( TRIM(clpath)//TRIM(clname), nummxlw, ldwrt = .TRUE., kiolib = jprstlib )
       ENDIF
 
@@ -133,4 +136,5 @@
       INTEGER ::   jlibalt = jprstlib
       LOGICAL ::   llok
+      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file
       !!-----------------------------------------------------------------------------
 
@@ -140,8 +144,12 @@
          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~'
       ENDIF
+
+      clpath = TRIM(cn_ocerst_indir)
+      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+
       IF ( jprstlib == jprstdimg ) THEN
          ! eventually read netcdf file (monobloc)  for restarting on different number of processors
          ! if {cn_trdrst_in}.nc exists, then set jlibalt to jpnf90
-         INQUIRE( FILE = TRIM(cn_trdrst_in)//'.nc', EXIST = llok )
+         INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_in)//'.nc', EXIST = llok )
          IF ( llok ) THEN   ;   jlibalt = jpnf90   
          ELSE               ;   jlibalt = jprstlib   
@@ -149,5 +157,5 @@
       ENDIF
 
-      CALL iom_open( cn_trdrst_in, inum, kiolib = jlibalt ) 
+      CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_in), inum, kiolib = jlibalt ) 
 
       IF( ln_trdmxl_instant ) THEN 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90	(revision 5682)
@@ -41,5 +41,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: trdtra.F90 3318 2012-02-25 15:50:01Z gm $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -99,7 +99,7 @@
                                    CALL wrk_alloc( jpi, jpj, z2d )
                                    z2d(:,:) = wn(:,:,1) * ( &
-                                   	  &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    &
-                                   	  &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    &
-                                      &   					) / fse3t(:,:,1)
+                                   &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    &
+                                   &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    &
+                                   &   ) / fse3t(:,:,1)
                                    CALL iom_put( "petrd_sad" , z2d )
                                    CALL wrk_dealloc( jpi, jpj, z2d )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90	(revision 5682)
@@ -18,5 +18,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: trdtrc.F90 2715 2011-03-30 15:58:35Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 5682)
@@ -43,5 +43,8 @@
    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avmu , avmv    !: vertical viscosity coef at uw- & vw-pts       [m2/s]
    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm  , avt     !: vertical viscosity & diffusivity coef at w-pt [m2/s]
- 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en             !: now turbulent kinetic energy   [m2/s2]
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
@@ -59,6 +62,9 @@
          &     avtb(jpk) , bfrva(jpi,jpj) , avtb_2d(jpi,jpj) ,      &
          &     tfrua(jpi, jpj), tfrva(jpi, jpj)              ,      &
-         &     avmu(jpi,jpj,jpk), avm(jpi,jpj,jpk)           ,      &
-         &     avmv(jpi,jpj,jpk), avt(jpi,jpj,jpk)           , STAT = zdf_oce_alloc )
+         &     avmu  (jpi,jpj,jpk), avm   (jpi,jpj,jpk),            &
+         &     avmv  (jpi,jpj,jpk), avt   (jpi,jpj,jpk),            &
+         &     avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk),            & 
+         &     avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk),            & 
+         &     en    (jpi,jpj,jpk), STAT = zdf_oce_alloc )
          !
       IF( zdf_oce_alloc /= 0 )   CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays')
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 5682)
@@ -120,13 +120,18 @@
                   zbfrt(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp)
                   zbfrt(ji,jj) = MIN(zbfrt(ji,jj), rn_bfri2_max)
-! (ISF)
-                  ikbt = mikt(ji,jj)
-! JC: possible WAD implementation should modify line below if layers vanish
-                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
-                  ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
-                  ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max)
-
                END DO
             END DO
+! (ISF)
+            IF ( ln_isfcav ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     ikbt = mikt(ji,jj)
+! JC: possible WAD implementation should modify line below if layers vanish
+                     ztmp = (1-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
+                     ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
+                     ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max)
+                  END DO
+               END DO
+            END IF
          !   
          ELSE
@@ -152,44 +157,54 @@
                !
                ! in case of 2 cell water column, we assume each cell feels the top and bottom friction
-               IF ( miku(ji,jj) + 2 .GE. mbku(ji,jj) ) THEN
-                  bfrua(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji+1,jj  ) )   &
-                               &            + ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) ) ) &
-                               &          * zecu * (1._wp - umask(ji,jj,1))
-               END IF
-               IF ( mikv(ji,jj) + 2 .GE. mbkv(ji,jj) ) THEN
-                  bfrva(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji  ,jj+1) )   &
-                               &            + ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) ) ) &
-                               &          * zecv * (1._wp - vmask(ji,jj,1))
-               END IF
-               ! (ISF) ========================================================================
-               ikbu = miku(ji,jj)         ! ocean bottom level at u- and v-points 
-               ikbv = mikv(ji,jj)         ! (deepest ocean u- and v-points)
-               !
-               zvu  = 0.25 * (  vn(ji,jj  ,ikbu) + vn(ji+1,jj  ,ikbu)     &
-                  &           + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu)  )
-               zuv  = 0.25 * (  un(ji,jj  ,ikbv) + un(ji-1,jj  ,ikbv)     &
-                  &           + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv)  )
-               !
-               zecu = SQRT(  un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_bfeb2 )
-               zecv = SQRT(  vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2 )
-               !
-               tfrua(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) ) * zecu * (1._wp - umask(ji,jj,1))
-               tfrva(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) ) * zecv * (1._wp - vmask(ji,jj,1))
-               ! (ISF) END ====================================================================
-               ! in case of 2 cell water column, we assume each cell feels the top and bottom friction
-               IF ( miku(ji,jj) + 2 .GE. mbku(ji,jj) ) THEN
-                  tfrua(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) )   &
-                               &            + ( zbfrt(ji,jj) + zbfrt(ji+1,jj  ) ) ) &
-                               &          * zecu * (1._wp - umask(ji,jj,1))
-               END IF
-               IF ( mikv(ji,jj) + 2 .GE. mbkv(ji,jj) ) THEN
-                  tfrva(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) )   &
-                               &            + ( zbfrt(ji,jj) + zbfrt(ji  ,jj+1) ) ) &
-                               &          * zecv * (1._wp - vmask(ji,jj,1))
+               IF ( ln_isfcav ) THEN
+                  IF ( miku(ji,jj) + 1 .GE. mbku(ji,jj) ) THEN
+                     bfrua(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji+1,jj  ) )   &
+                                  &            + ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) ) ) &
+                                  &          * zecu * (1._wp - umask(ji,jj,1))
+                  END IF
+                  IF ( mikv(ji,jj) + 1 .GE. mbkv(ji,jj) ) THEN
+                     bfrva(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji  ,jj+1) )   &
+                                  &            + ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) ) ) &
+                                  &          * zecv * (1._wp - vmask(ji,jj,1))
+                  END IF
                END IF
             END DO
          END DO
-         !
          CALL lbc_lnk( bfrua, 'U', 1. )   ;   CALL lbc_lnk( bfrva, 'V', 1. )      ! Lateral boundary condition
+
+         IF ( ln_isfcav ) THEN
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  ! (ISF) ========================================================================
+                  ikbu = miku(ji,jj)         ! ocean top level at u- and v-points 
+                  ikbv = mikv(ji,jj)         ! (1st wet ocean u- and v-points)
+                  !
+                  zvu  = 0.25 * (  vn(ji,jj  ,ikbu) + vn(ji+1,jj  ,ikbu)     &
+                     &           + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu)  )
+                  zuv  = 0.25 * (  un(ji,jj  ,ikbv) + un(ji-1,jj  ,ikbv)     &
+                     &           + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv)  )
+              !
+                  zecu = SQRT(  un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_tfeb2 )
+                  zecv = SQRT(  vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_tfeb2 )
+              !
+                  tfrua(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) ) * zecu * (1._wp - umask(ji,jj,1))
+                  tfrva(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) ) * zecv * (1._wp - vmask(ji,jj,1))
+              ! (ISF) END ====================================================================
+              ! in case of 2 cell water column, we assume each cell feels the top and bottom friction
+                  IF ( miku(ji,jj) + 1 .GE. mbku(ji,jj) ) THEN
+                     tfrua(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) )   &
+                                  &            + ( zbfrt(ji,jj) + zbfrt(ji+1,jj  ) ) ) &
+                                  &          * zecu * (1._wp - umask(ji,jj,1))
+                  END IF
+                  IF ( mikv(ji,jj) + 1 .GE. mbkv(ji,jj) ) THEN
+                     tfrva(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) )   &
+                                  &            + ( zbfrt(ji,jj) + zbfrt(ji  ,jj+1) ) ) &
+                                  &          * zecv * (1._wp - vmask(ji,jj,1))
+                  END IF
+               END DO
+            END DO
+            CALL lbc_lnk( tfrua, 'U', 1. )   ;   CALL lbc_lnk( tfrva, 'V', 1. )      ! Lateral boundary condition
+         END IF
+         !
          !
          IF(ln_ctl)   CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr  - u: ', mask1=umask,        &
@@ -264,9 +279,11 @@
             IF(lwp) WRITE(numout,*) '      coef rn_bfri2 enhancement factor                rn_bfrien  = ',rn_bfrien
          ENDIF
-         IF(lwp) WRITE(numout,*) '      top    friction coef.   rn_bfri1  = ', rn_bfri1
-         IF( ln_tfr2d ) THEN
-            IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d
-            IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien
-         ENDIF
+         IF ( ln_isfcav ) THEN
+            IF(lwp) WRITE(numout,*) '      top    friction coef.   rn_bfri1  = ', rn_tfri1
+            IF( ln_tfr2d ) THEN
+               IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d
+               IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien
+            ENDIF
+         END IF
          !
          IF(ln_bfr2d) THEN
@@ -282,4 +299,19 @@
          bfrua(:,:) = - bfrcoef2d(:,:)
          bfrva(:,:) = - bfrcoef2d(:,:)
+         !
+         IF ( ln_isfcav ) THEN
+            IF(ln_tfr2d) THEN
+               ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
+               CALL iom_open('tfr_coef.nc',inum)
+               CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array
+               CALL iom_close(inum)
+               tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) )
+            ELSE
+               tfrcoef2d(:,:) = rn_tfri1  ! initialize tfrcoef2d to the namelist variable
+            ENDIF
+            !
+            tfrua(:,:) = - tfrcoef2d(:,:)
+            tfrva(:,:) = - tfrcoef2d(:,:)
+         END IF
          !
       CASE( 2 )
@@ -298,18 +330,20 @@
             IF(lwp) WRITE(numout,*) '      coef rn_bfri2 enhancement factor                rn_bfrien  = ',rn_bfrien
          ENDIF
-         IF(lwp) WRITE(numout,*) '      quadratic top    friction'
-         IF(lwp) WRITE(numout,*) '      friction coef.   rn_bfri2  = ', rn_tfri2
-         IF(lwp) WRITE(numout,*) '      Max. coef. (log case)   rn_tfri2_max  = ', rn_tfri2_max
-         IF(lwp) WRITE(numout,*) '      background tke   rn_tfeb2  = ', rn_tfeb2
-         IF(lwp) WRITE(numout,*) '      log formulation   ln_tfr2d = ', ln_loglayer
-         IF(lwp) WRITE(numout,*) '      bottom roughness  rn_tfrz0 [m] = ', rn_tfrz0
-         IF( rn_tfrz0<=0.e0 ) THEN
-            WRITE(ctmp1,*) '      bottom roughness must be strictly positive'
-            CALL ctl_stop( ctmp1 )
-         ENDIF
-         IF( ln_tfr2d ) THEN
-            IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d
-            IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien
-         ENDIF
+         IF ( ln_isfcav ) THEN
+            IF(lwp) WRITE(numout,*) '      quadratic top    friction'
+            IF(lwp) WRITE(numout,*) '      friction coef.    rn_tfri2     = ', rn_tfri2
+            IF(lwp) WRITE(numout,*) '      Max. coef. (log case)   rn_tfri2_max  = ', rn_tfri2_max
+            IF(lwp) WRITE(numout,*) '      background tke    rn_tfeb2     = ', rn_tfeb2
+            IF(lwp) WRITE(numout,*) '      log formulation   ln_tfr2d     = ', ln_loglayer
+            IF(lwp) WRITE(numout,*) '      top roughness     rn_tfrz0 [m] = ', rn_tfrz0
+            IF( rn_tfrz0<=0.e0 ) THEN
+               WRITE(ctmp1,*) '      top roughness must be strictly positive'
+               CALL ctl_stop( ctmp1 )
+            ENDIF
+            IF( ln_tfr2d ) THEN
+               IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d
+               IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien
+            ENDIF
+         END IF
          !
          IF(ln_bfr2d) THEN
@@ -323,4 +357,17 @@
             bfrcoef2d(:,:) = rn_bfri2  ! initialize bfrcoef2d to the namelist variable
          ENDIF
+         
+         IF ( ln_isfcav ) THEN
+            IF(ln_tfr2d) THEN
+               ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
+               CALL iom_open('tfr_coef.nc',inum)
+               CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array
+               CALL iom_close(inum)
+               !
+               tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) )
+            ELSE
+               tfrcoef2d(:,:) = rn_tfri2  ! initialize tfrcoef2d to the namelist variable
+            ENDIF
+         END IF
          !
          IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all
@@ -333,4 +380,14 @@
                END DO
             END DO
+            IF ( ln_isfcav ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     ikbt = mikt(ji,jj)
+                     ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp
+                     tfrcoef2d(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
+                     tfrcoef2d(ji,jj) = MIN(tfrcoef2d(ji,jj), rn_tfri2_max)
+                  END DO
+               END DO
+            END IF
          ENDIF
          !
@@ -385,4 +442,28 @@
              zminbfr = MIN(  zminbfr, MIN( zfru, ABS( bfrcoef2d(ji,jj) ) )  )
              zmaxbfr = MAX(  zmaxbfr, MIN( zfrv, ABS( bfrcoef2d(ji,jj) ) )  )
+! (ISF)
+             IF ( ln_isfcav ) THEN
+                ikbu = miku(ji,jj)       ! 1st wet ocean level at u- and v-points
+                ikbv = mikv(ji,jj)
+                zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt
+                zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt
+                IF( ABS( tfrcoef2d(ji,jj) ) > zfru ) THEN
+                   IF( ln_ctl ) THEN
+                      WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbu
+                      WRITE(numout,*) 'TFR ', ABS( tfrcoef2d(ji,jj) ), zfru
+                   ENDIF
+                   ictu = ictu + 1
+                ENDIF
+                IF( ABS( tfrcoef2d(ji,jj) ) > zfrv ) THEN
+                   IF( ln_ctl ) THEN
+                      WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbv
+                      WRITE(numout,*) 'TFR ', tfrcoef2d(ji,jj), zfrv
+                   ENDIF
+                   ictv = ictv + 1
+                ENDIF
+                zmintfr = MIN(  zmintfr, MIN( zfru, ABS( tfrcoef2d(ji,jj) ) )  )
+                zmaxtfr = MAX(  zmaxtfr, MIN( zfrv, ABS( tfrcoef2d(ji,jj) ) )  )
+             END IF
+! END ISF
          END DO
       END DO
@@ -392,12 +473,14 @@
          CALL mpp_min( zminbfr )
          CALL mpp_max( zmaxbfr )
+         IF ( ln_isfcav) CALL mpp_min( zmintfr )
+         IF ( ln_isfcav) CALL mpp_max( zmaxtfr )
       ENDIF
       IF( .NOT.ln_bfrimp) THEN
       IF( lwp .AND. ictu + ictv > 0 ) THEN
-         WRITE(numout,*) ' Bottom friction stability check failed at ', ictu, ' U-points '
-         WRITE(numout,*) ' Bottom friction stability check failed at ', ictv, ' V-points '
+         WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictu, ' U-points '
+         WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictv, ' V-points '
          WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zminbfr, ' to ', zmaxbfr
-         WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr
-         WRITE(numout,*) ' Bottom friction coefficient will be reduced where necessary'
+         IF ( ln_isfcav ) WRITE(numout,*) ' Top friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr
+         WRITE(numout,*) ' Bottom/Top friction coefficient will be reduced where necessary'
       ENDIF
       ENDIF
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 5682)
@@ -156,5 +156,5 @@
          END DO
          ! mask zmsk in order to have avt and avs masked
-         zmsks(:,:) = zmsks(:,:) * tmask(:,:,jk)
+         zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk)
 
 
@@ -191,8 +191,8 @@
                avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk),    &
                   &                  avt(ji,jj,jk), avt(ji+1,jj,jk),   &
-                  &                  avs(ji,jj,jk), avs(ji+1,jj,jk) )  * umask(ji,jj,jk)
+                  &                  avs(ji,jj,jk), avs(ji+1,jj,jk) )  * wumask(ji,jj,jk)
                avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk),    &
                   &                  avt(ji,jj,jk), avt(ji,jj+1,jk),   &
-                  &                  avs(ji,jj,jk), avs(ji,jj+1,jk) )  * vmask(ji,jj,jk)
+                  &                  avs(ji,jj,jk), avs(ji,jj+1,jk) )  * wvmask(ji,jj,jk)
             END DO
          END DO
@@ -255,5 +255,5 @@
       IF( zdf_ddm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' )
       !                               ! initialization to masked Kz
-      avs(:,:,:) = rn_avt0 * tmask(:,:,:) 
+      avs(:,:,:) = rn_avt0 * wmask(:,:,:) 
       !
    END SUBROUTINE zdf_ddm_init
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 5682)
@@ -20,4 +20,5 @@
    USE domvvl         ! ocean space and time domain : variable volume layer
    USE zdf_oce        ! ocean vertical physics
+   USE zdfbfr         ! bottom friction (only for rn_bfrz0)
    USE sbc_oce        ! surface boundary condition: ocean
    USE phycst         ! physical constants
@@ -41,22 +42,15 @@
    LOGICAL , PUBLIC, PARAMETER ::   lk_zdfgls = .TRUE.   !: TKE vertical mixing flag
    !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en      !: now turbulent kinetic energy
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zwall   !: wall function
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k   ! not enhanced Kz
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avm_k   ! not enhanced Kz
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k  ! not enhanced Kz
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmv_k  ! not enhanced Kz
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustars2 !: Squared surface velocity scale at T-points
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustarb2 !: Squared bottom  velocity scale at T-points
 
    !                              !! ** Namelist  namzdf_gls  **
-   LOGICAL  ::   ln_crban          ! =T use Craig and Banner scheme
    LOGICAL  ::   ln_length_lim     ! use limit on the dissipation rate under stable stratification (Galperin et al. 1988)
    LOGICAL  ::   ln_sigpsi         ! Activate Burchard (2003) modification for k-eps closure & wave breaking mixing
-   INTEGER  ::   nn_tkebc_surf     ! TKE surface boundary condition (=0/1)
-   INTEGER  ::   nn_tkebc_bot      ! TKE bottom boundary condition (=0/1)
-   INTEGER  ::   nn_psibc_surf     ! PSI surface boundary condition (=0/1)
-   INTEGER  ::   nn_psibc_bot      ! PSI bottom boundary condition (=0/1)
+   INTEGER  ::   nn_bc_surf        ! surface boundary condition (=0/1)
+   INTEGER  ::   nn_bc_bot         ! bottom boundary condition (=0/1)
+   INTEGER  ::   nn_z0_met         ! Method for surface roughness computation
    INTEGER  ::   nn_stab_func      ! stability functions G88, KC or Canuto (=0/1/2)
    INTEGER  ::   nn_clos           ! closure 0/1/2/3 MY82/k-eps/k-w/gen
@@ -66,7 +60,7 @@
    REAL(wp) ::   rn_charn          ! Charnock constant for surface breaking waves mixing : 1400. (standard) or 2.e5 (Stacey value)
    REAL(wp) ::   rn_crban          ! Craig and Banner constant for surface breaking waves mixing
-
-   REAL(wp) ::   hsro          =  0.003_wp    ! Minimum surface roughness
-   REAL(wp) ::   hbro          =  0.003_wp    ! Bottom roughness (m)
+   REAL(wp) ::   rn_hsro           ! Minimum surface roughness
+   REAL(wp) ::   rn_frac_hs        ! Fraction of wave height as surface roughness (if nn_z0_met > 1) 
+
    REAL(wp) ::   rcm_sf        =  0.73_wp     ! Shear free turbulence parameters
    REAL(wp) ::   ra_sf         = -2.0_wp      ! Must be negative -2 < ra_sf < -1 
@@ -96,10 +90,9 @@
    REAL(wp) ::   rm7           =  0.0_wp
    REAL(wp) ::   rm8           =  0.318_wp
-   
+   REAL(wp) ::   rtrans        =  0.1_wp
    REAL(wp) ::   rc02, rc02r, rc03, rc04                          ! coefficients deduced from above parameters
-   REAL(wp) ::   rc03_sqrt2_galp                                  !     -           -           -        -
-   REAL(wp) ::   rsbc_tke1, rsbc_tke2, rsbc_tke3, rfact_tke       !     -           -           -        -
-   REAL(wp) ::   rsbc_psi1, rsbc_psi2, rsbc_psi3, rfact_psi       !     -           -           -        -
-   REAL(wp) ::   rsbc_mb  , rsbc_std , rsbc_zs                    !     -           -           -        -
+   REAL(wp) ::   rsbc_tke1, rsbc_tke2, rfact_tke                  !     -           -           -        -
+   REAL(wp) ::   rsbc_psi1, rsbc_psi2, rfact_psi                  !     -           -           -        -
+   REAL(wp) ::   rsbc_zs1, rsbc_zs2                               !     -           -           -        -
    REAL(wp) ::   rc0, rc2, rc3, rf6, rcff, rc_diff                !     -           -           -        -
    REAL(wp) ::   rs0, rs1, rs2, rs4, rs5, rs6                     !     -           -           -        -
@@ -122,7 +115,5 @@
       !!                ***  FUNCTION zdf_gls_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( en(jpi,jpj,jpk),  mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     &
-         &      avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk),                    &
-         &      avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk),                    &
+      ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     &
          &      ustars2(jpi,jpj), ustarb2(jpi,jpj)                      , STAT= zdf_gls_alloc )
          !
@@ -147,4 +138,5 @@
       REAL(wp) ::   gh, gm, shr, dif, zsqen, zav        !   -      -
       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zdep
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zkar
       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zflxs       ! Turbulence fluxed induced by internal waves 
       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhsro       ! Surface roughness (surface waves)
@@ -153,13 +145,16 @@
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   shear       ! vertical shear
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   eps         ! dissipation rate
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwall_psi   ! Wall function use in the wb case (ln_sigpsi.AND.ln_crban=T)
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_elem_a, z_elem_b, z_elem_c, psi
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwall_psi   ! Wall function use in the wb case (ln_sigpsi)
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   psi         ! psi at time now
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_elem_a    ! element of the first  matrix diagonal
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_elem_b    ! element of the second matrix diagonal
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_elem_c    ! element of the third  matrix diagonal
       !!--------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('zdf_gls')
       !
-      CALL wrk_alloc( jpi,jpj, zdep, zflxs, zhsro )
-      CALL wrk_alloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )
-
+      CALL wrk_alloc( jpi,jpj, zdep, zkar, zflxs, zhsro )
+      CALL wrk_alloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi  )
+      
       ! Preliminary computing
 
@@ -174,27 +169,34 @@
 
       ! Compute surface and bottom friction at T-points
-!CDIR NOVERRCHK
-      DO jj = 2, jpjm1
-!CDIR NOVERRCHK
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ! 
-            ! surface friction 
+!CDIR NOVERRCHK          
+      DO jj = 2, jpjm1          
+!CDIR NOVERRCHK         
+         DO ji = fs_2, fs_jpim1   ! vector opt.         
+            !
+            ! surface friction
             ustars2(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1)
-            !
-            ! bottom friction (explicit before friction)
-            ! Note that we chose here not to bound the friction as in dynbfr)
-            ztx2 = (  bfrua(ji,jj)  * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj))  )   &
-               & * ( 1._wp - 0.5_wp * umask(ji,jj,1) * umask(ji-1,jj,1)  )
-            zty2 = (  bfrva(ji,jj)  * vb(ji,jj,mbkv(ji,jj)) + bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1))  )   &
-               & * ( 1._wp - 0.5_wp * vmask(ji,jj,1) * vmask(ji,jj-1,1)  )
-            ustarb2(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)
-         END DO
-      END DO  
-
-      ! In case of breaking surface waves mixing,
-      ! Compute surface roughness length according to Charnock formula:
-      IF( ln_crban ) THEN   ;   zhsro(:,:) = MAX(rsbc_zs * ustars2(:,:), hsro)
-      ELSE                  ;   zhsro(:,:) = hsro
-      ENDIF
+            !   
+            ! bottom friction (explicit before friction)        
+            ! Note that we chose here not to bound the friction as in dynbfr)   
+            ztx2 = (  bfrua(ji,jj)  * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj))  )   &         
+               & * ( 1._wp - 0.5_wp * umask(ji,jj,1) * umask(ji-1,jj,1)  )      
+            zty2 = (  bfrva(ji,jj)  * vb(ji,jj,mbkv(ji,jj)) + bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1))  )   &         
+               & * ( 1._wp - 0.5_wp * vmask(ji,jj,1) * vmask(ji,jj-1,1)  )      
+            ustarb2(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)         
+         END DO         
+      END DO    
+
+      ! Set surface roughness length
+      SELECT CASE ( nn_z0_met )
+      !
+      CASE ( 0 )             ! Constant roughness          
+         zhsro(:,:) = rn_hsro
+      CASE ( 1 )             ! Standard Charnock formula
+         zhsro(:,:) = MAX(rsbc_zs1 * ustars2(:,:), rn_hsro)
+      CASE ( 2 )             ! Roughness formulae according to Rascle et al., Ocean Modelling (2008)
+         zdep(:,:)  = 30.*TANH(2.*0.3/(28.*SQRT(MAX(ustars2(:,:),rsmall))))             ! Wave age (eq. 10)
+         zhsro(:,:) = MAX(rsbc_zs2 * ustars2(:,:) * zdep(:,:)**1.5, rn_hsro) ! zhsro = rn_frac_hs * Hsw (eq. 11)
+      !
+      END SELECT
 
       ! Compute shear and dissipation rate
@@ -303,78 +305,49 @@
       !
       ! Set surface condition on zwall_psi (1 at the bottom)
-      IF( ln_sigpsi ) THEN
-         zcoef = rsc_psi / rsc_psi0
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwall_psi(ji,jj,1) = zcoef
-            END DO
-         END DO
-      ENDIF
-
+      zwall_psi(:,:,1) = zwall_psi(:,:,2)
+      zwall_psi(:,:,jpk) = 1.
+      !
       ! Surface boundary condition on tke
       ! ---------------------------------
       !
-      SELECT CASE ( nn_tkebc_surf )
+      SELECT CASE ( nn_bc_surf )
       !
       CASE ( 0 )             ! Dirichlet case
-         !
-         IF (ln_crban) THEN     ! Wave induced mixing case
-            !                      ! en(1) = q2(1) = 0.5 * (15.8 * Ccb)^(2/3) * u*^2
-            !                      ! balance between the production and the dissipation terms including the wave effect
-            en(:,:,1) = MAX( rsbc_tke1 * ustars2(:,:), rn_emin )
-            z_elem_a(:,:,1) = en(:,:,1)
-            z_elem_c(:,:,1) = 0._wp
-            z_elem_b(:,:,1) = 1._wp
-            ! 
-            ! one level below
-            en(:,:,2) = MAX( rsbc_tke1 * ustars2(:,:) * ( (zhsro(:,:)+fsdepw(:,:,2))/zhsro(:,:) )**ra_sf, rn_emin )
-            z_elem_a(:,:,2) = 0._wp
-            z_elem_c(:,:,2) = 0._wp
-            z_elem_b(:,:,2) = 1._wp
-            !
-         ELSE                   ! No wave induced mixing case
-            !                      ! en(1) = u*^2/C0^2  &  l(1)  = K*zs
-            !                      ! balance between the production and the dissipation terms
-            en(:,:,1) = MAX( rc02r * ustars2(:,:), rn_emin )
-            z_elem_a(:,:,1) = en(:,:,1) 
-            z_elem_c(:,:,1) = 0._wp
-            z_elem_b(:,:,1) = 1._wp
-            !
-            ! one level below
-            en(:,:,2) = MAX( rc02r * ustars2(:,:), rn_emin )
-            z_elem_a(:,:,2) = 0._wp
-            z_elem_c(:,:,2) = 0._wp
-            z_elem_b(:,:,2) = 1._wp
-            !
-         ENDIF
-         !
+      ! First level
+      en(:,:,1) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1)**(2._wp/3._wp)
+      en(:,:,1) = MAX(en(:,:,1), rn_emin) 
+      z_elem_a(:,:,1) = en(:,:,1)
+      z_elem_c(:,:,1) = 0._wp
+      z_elem_b(:,:,1) = 1._wp
+      ! 
+      ! One level below
+      en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+fsdepw(:,:,2)) &
+         &               / zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp)
+      en(:,:,2) = MAX(en(:,:,2), rn_emin )
+      z_elem_a(:,:,2) = 0._wp 
+      z_elem_c(:,:,2) = 0._wp
+      z_elem_b(:,:,2) = 1._wp
+      !
+      !
       CASE ( 1 )             ! Neumann boundary condition on d(e)/dz
-         !
-         IF (ln_crban) THEN ! Shear free case: d(e)/dz= Fw
-            !
-            ! Dirichlet conditions at k=1 (Cosmetic)
-            en(:,:,1) = MAX( rsbc_tke1 * ustars2(:,:), rn_emin )
-            z_elem_a(:,:,1) = en(:,:,1)
-            z_elem_c(:,:,1) = 0._wp
-            z_elem_b(:,:,1) = 1._wp
-            ! at k=2, set de/dz=Fw
-            z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
-            z_elem_a(:,:,2) = 0._wp        
-            zflxs(:,:) = rsbc_tke3 * ustars2(:,:)**1.5_wp * ( (zhsro(:,:)+fsdept(:,:,1) ) / zhsro(:,:) )**(1.5*ra_sf)
-            en(:,:,2) = en(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
-            !
-         ELSE                   ! No wave induced mixing case: d(e)/dz=0.
-            !
-            ! Dirichlet conditions at k=1 (Cosmetic)
-            en(:,:,1) = MAX( rc02r * ustars2(:,:), rn_emin )
-            z_elem_a(:,:,1) = en(:,:,1)
-            z_elem_c(:,:,1) = 0._wp
-            z_elem_b(:,:,1) = 1._wp
-            ! at k=2 set de/dz=0.:
-            z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2)  ! Remove z_elem_a from z_elem_b
-            z_elem_a(:,:,2) = 0._wp
-            !
-         ENDIF
-         !
+      !
+      ! Dirichlet conditions at k=1
+      en(:,:,1)       = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1)**(2._wp/3._wp)
+      en(:,:,1)       = MAX(en(:,:,1), rn_emin)      
+      z_elem_a(:,:,1) = en(:,:,1)
+      z_elem_c(:,:,1) = 0._wp
+      z_elem_b(:,:,1) = 1._wp
+      !
+      ! at k=2, set de/dz=Fw
+      !cbr
+      z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+      z_elem_a(:,:,2) = 0._wp
+      zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*fsdept(:,:,1)/zhsro(:,:)) ))
+      zflxs(:,:)      = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) &
+          &                       * ((zhsro(:,:)+fsdept(:,:,1)) / zhsro(:,:) )**(1.5_wp*ra_sf)
+
+      en(:,:,2) = en(:,:,2) + zflxs(:,:)/fse3w(:,:,2)
+      !
+      !
       END SELECT
 
@@ -382,5 +355,5 @@
       ! --------------------------------
       !
-      SELECT CASE ( nn_tkebc_bot )
+      SELECT CASE ( nn_bc_bot )
       !
       CASE ( 0 )             ! Dirichlet 
@@ -457,5 +430,5 @@
       !                                            ! set the minimum value of tke 
       en(:,:,:) = MAX( en(:,:,:), rn_emin )
-      
+
       !!----------------------------------------!!
       !!   Solve prognostic equation for psi    !!
@@ -560,84 +533,48 @@
       ! ---------------------------------
       !
-      SELECT CASE ( nn_psibc_surf )
+      SELECT CASE ( nn_bc_surf )
       !
       CASE ( 0 )             ! Dirichlet boundary conditions
-         !
-         IF( ln_crban ) THEN       ! Wave induced mixing case
-            !                      ! en(1) = q2(1) = 0.5 * (15.8 * Ccb)^(2/3) * u*^2
-            !                      ! balance between the production and the dissipation terms including the wave effect
-            zdep(:,:) = rl_sf * zhsro(:,:)
-            psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
-            z_elem_a(:,:,1) = psi(:,:,1)
-            z_elem_c(:,:,1) = 0._wp
-            z_elem_b(:,:,1) = 1._wp
-            !
-            ! one level below
-            zex1 = (rmm*ra_sf+rnn)
-            zex2 = (rmm*ra_sf)
-            zdep(:,:) = ( (zhsro(:,:) + fsdepw(:,:,2))**zex1 ) / zhsro(:,:)**zex2
-            psi (:,:,2) = rsbc_psi1 * ustars2(:,:)**rmm * zdep(:,:) * tmask(:,:,1)
-            z_elem_a(:,:,2) = 0._wp
-            z_elem_c(:,:,2) = 0._wp
-            z_elem_b(:,:,2) = 1._wp
-            ! 
-         ELSE                   ! No wave induced mixing case
-            !                      ! en(1) = u*^2/C0^2  &  l(1)  = K*zs
-            !                      ! balance between the production and the dissipation terms
-            !
-            zdep(:,:) = vkarmn * zhsro(:,:)
-            psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
-            z_elem_a(:,:,1) = psi(:,:,1)
-            z_elem_c(:,:,1) = 0._wp
-            z_elem_b(:,:,1) = 1._wp
-            !
-            ! one level below
-            zdep(:,:) = vkarmn * ( zhsro(:,:) + fsdepw(:,:,2) )
-            psi (:,:,2) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
-            z_elem_a(:,:,2) = 0._wp
-            z_elem_c(:,:,2) = 0._wp
-            z_elem_b(:,:,2) = 1.
-            !
-         ENDIF
-         !
+      !
+      ! Surface value
+      zdep(:,:)       = zhsro(:,:) * rl_sf ! Cosmetic
+      psi (:,:,1)     = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+      z_elem_a(:,:,1) = psi(:,:,1)
+      z_elem_c(:,:,1) = 0._wp
+      z_elem_b(:,:,1) = 1._wp
+      !
+      ! One level below
+      zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*fsdepw(:,:,2)/zhsro(:,:) )))
+      zdep(:,:)       = (zhsro(:,:) + fsdepw(:,:,2)) * zkar(:,:)
+      psi (:,:,2)     = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+      z_elem_a(:,:,2) = 0._wp
+      z_elem_c(:,:,2) = 0._wp
+      z_elem_b(:,:,2) = 1._wp
+      ! 
+      !
       CASE ( 1 )             ! Neumann boundary condition on d(psi)/dz
-         !
-         IF( ln_crban ) THEN     ! Wave induced mixing case
-            !
-            zdep(:,:) = rl_sf * zhsro(:,:)
-            psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
-            z_elem_a(:,:,1) = psi(:,:,1)
-            z_elem_c(:,:,1) = 0._wp
-            z_elem_b(:,:,1) = 1._wp
-            !
-            ! Neumann condition at k=2
-            z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
-            z_elem_a(:,:,2) = 0._wp
-            !
-            ! Set psi vertical flux at the surface:
-            zdep(:,:) = (zhsro(:,:) + fsdept(:,:,1))**(rmm*ra_sf+rnn-1._wp) / zhsro(:,:)**(rmm*ra_sf)
-            zflxs(:,:) = rsbc_psi3 * ( zwall_psi(:,:,1)*avm(:,:,1) + zwall_psi(:,:,2)*avm(:,:,2) ) & 
-               &                   * en(:,:,1)**rmm * zdep         
-            psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
-            !
-      ELSE                   ! No wave induced mixing
-            !
-            zdep(:,:) = vkarmn * zhsro(:,:)
-            psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
-            z_elem_a(:,:,1) = psi(:,:,1)
-            z_elem_c(:,:,1) = 0._wp
-            z_elem_b(:,:,1) = 1._wp
-            !
-            ! Neumann condition at k=2
-            z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
-            z_elem_a(ji,jj,2) = 0._wp
-            !
-            ! Set psi vertical flux at the surface:
-            zdep(:,:)  = zhsro(:,:) + fsdept(:,:,1)
-            zflxs(:,:) = rsbc_psi2 * ( avm(:,:,1) + avm(:,:,2) ) * en(:,:,1)**rmm * zdep**(rnn-1._wp)
-            psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
-            !     
-         ENDIF
-         !
+      !
+      ! Surface value: Dirichlet
+      zdep(:,:)       = zhsro(:,:) * rl_sf
+      psi (:,:,1)     = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+      z_elem_a(:,:,1) = psi(:,:,1)
+      z_elem_c(:,:,1) = 0._wp
+      z_elem_b(:,:,1) = 1._wp
+      !
+      ! Neumann condition at k=2
+      z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+      z_elem_a(:,:,2) = 0._wp
+      !
+      ! Set psi vertical flux at the surface:
+      zkar(:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*fsdept(:,:,1)/zhsro(:,:) )) ! Lengh scale slope
+      zdep(:,:) = ((zhsro(:,:) + fsdept(:,:,1)) / zhsro(:,:))**(rmm*ra_sf)
+      zflxs(:,:) = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp)
+      zdep(:,:) =  rsbc_psi1 * (zwall_psi(:,:,1)*avm(:,:,1)+zwall_psi(:,:,2)*avm(:,:,2)) * &
+             & ustars2(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + fsdept(:,:,1))**(rnn-1.)
+      zflxs(:,:) = zdep(:,:) * zflxs(:,:)
+      psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
+
+      !   
+      !
       END SELECT
 
@@ -645,8 +582,9 @@
       ! --------------------------------
       !
-      SELECT CASE ( nn_psibc_bot )
+      SELECT CASE ( nn_bc_bot )
+      !
       !
       CASE ( 0 )             ! Dirichlet 
-         !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * hbro
+         !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * rn_bfrz0
          !                      ! Balance between the production and the dissipation terms
 !CDIR NOVERRCHK
@@ -656,5 +594,5 @@
                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
                ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
-               zdep(ji,jj) = vkarmn * hbro
+               zdep(ji,jj) = vkarmn * rn_bfrz0
                psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
                z_elem_a(ji,jj,ibot) = 0._wp
@@ -663,5 +601,5 @@
                !
                ! Just above last level, Dirichlet condition again (GOTM like)
-               zdep(ji,jj) = vkarmn * ( hbro + fse3t(ji,jj,ibotm1) )
+               zdep(ji,jj) = vkarmn * ( rn_bfrz0 + fse3t(ji,jj,ibotm1) )
                psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot  )**rmm * zdep(ji,jj)**rnn
                z_elem_a(ji,jj,ibotm1) = 0._wp
@@ -681,5 +619,5 @@
                !
                ! Bottom level Dirichlet condition:
-               zdep(ji,jj) = vkarmn * hbro
+               zdep(ji,jj) = vkarmn * rn_bfrz0
                psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
                !
@@ -693,5 +631,5 @@
                !
                ! Set psi vertical flux at the bottom:
-               zdep(ji,jj) = hbro + 0.5_wp*fse3t(ji,jj,ibotm1)
+               zdep(ji,jj) = rn_bfrz0 + 0.5_wp*fse3t(ji,jj,ibotm1)
                zflxb = rsbc_psi2 * ( avm(ji,jj,ibot) + avm(ji,jj,ibotm1) )   &
                   &  * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp)
@@ -736,5 +674,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / psi(ji,jj,jk)
+                  eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin)
                END DO
             END DO
@@ -783,5 +721,5 @@
                ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 
                zrn2 = MAX( rn2(ji,jj,jk), rsmall )
-               mxln(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), mxln(ji,jj,jk)  )
+               IF (ln_length_lim) mxln(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), mxln(ji,jj,jk) )
             END DO
          END DO
@@ -847,14 +785,10 @@
       ! Boundary conditions on stability functions for momentum (Neumann):
       ! Lines below are useless if GOTM style Dirichlet conditions are used
-      zcoef = rcm_sf / SQRT( 2._wp )
+
+      avmv(:,:,1) = avmv(:,:,2)
+
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            avmv(ji,jj,1) = zcoef
-         END DO
-      END DO
-      zcoef = rc0 / SQRT( 2._wp )
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            avmv(ji,jj,mbkt(ji,jj)+1) = zcoef
+            avmv(ji,jj,mbkt(ji,jj)+1) = avmv(ji,jj,mbkt(ji,jj))
          END DO
       END DO
@@ -900,5 +834,5 @@
       avmv_k(:,:,:) = avmv(:,:,:)
       !
-      CALL wrk_dealloc( jpi,jpj, zdep, zflxs, zhsro )
+      CALL wrk_dealloc( jpi,jpj, zdep, zkar, zflxs, zhsro )
       CALL wrk_dealloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )
       !
@@ -932,8 +866,7 @@
       !!
       NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim, &
-         &            rn_clim_galp, ln_crban, ln_sigpsi,     &
-         &            rn_crban, rn_charn,                    &
-         &            nn_tkebc_surf, nn_tkebc_bot,           &
-         &            nn_psibc_surf, nn_psibc_bot,           &
+         &            rn_clim_galp, ln_sigpsi, rn_hsro,      &
+         &            rn_crban, rn_charn, rn_frac_hs,        &
+         &            nn_bc_surf, nn_bc_bot, nn_z0_met,      &
          &            nn_stab_func, nn_clos
       !!----------------------------------------------------------
@@ -955,21 +888,19 @@
          WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namzdf_gls : set gls mixing parameters'
-         WRITE(numout,*) '      minimum value of en                           rn_emin       = ', rn_emin
-         WRITE(numout,*) '      minimum value of eps                          rn_epsmin     = ', rn_epsmin
-         WRITE(numout,*) '      Limit dissipation rate under stable stratif.  ln_length_lim = ', ln_length_lim
-         WRITE(numout,*) '      Galperin limit (Standard: 0.53, Holt: 0.26)   rn_clim_galp  = ', rn_clim_galp
-         WRITE(numout,*) '      TKE Surface boundary condition                nn_tkebc_surf = ', nn_tkebc_surf
-         WRITE(numout,*) '      TKE Bottom boundary condition                 nn_tkebc_bot  = ', nn_tkebc_bot
-         WRITE(numout,*) '      PSI Surface boundary condition                nn_psibc_surf = ', nn_psibc_surf
-         WRITE(numout,*) '      PSI Bottom boundary condition                 nn_psibc_bot  = ', nn_psibc_bot
-         WRITE(numout,*) '      Craig and Banner scheme                       ln_crban      = ', ln_crban
-         WRITE(numout,*) '      Modify psi Schmidt number (wb case)           ln_sigpsi     = ', ln_sigpsi
+         WRITE(numout,*) '      minimum value of en                           rn_emin        = ', rn_emin
+         WRITE(numout,*) '      minimum value of eps                          rn_epsmin      = ', rn_epsmin
+         WRITE(numout,*) '      Limit dissipation rate under stable stratif.  ln_length_lim  = ', ln_length_lim
+         WRITE(numout,*) '      Galperin limit (Standard: 0.53, Holt: 0.26)   rn_clim_galp   = ', rn_clim_galp
+         WRITE(numout,*) '      TKE Surface boundary condition                nn_bc_surf     = ', nn_bc_surf
+         WRITE(numout,*) '      TKE Bottom boundary condition                 nn_bc_bot      = ', nn_bc_bot
+         WRITE(numout,*) '      Modify psi Schmidt number (wb case)           ln_sigpsi      = ', ln_sigpsi
          WRITE(numout,*) '      Craig and Banner coefficient                  rn_crban       = ', rn_crban
          WRITE(numout,*) '      Charnock coefficient                          rn_charn       = ', rn_charn
+         WRITE(numout,*) '      Surface roughness formula                     nn_z0_met      = ', nn_z0_met
+         WRITE(numout,*) '      Wave height frac. (used if nn_z0_met=2)       rn_frac_hs     = ', rn_frac_hs
          WRITE(numout,*) '      Stability functions                           nn_stab_func   = ', nn_stab_func
          WRITE(numout,*) '      Type of closure                               nn_clos        = ', nn_clos
-         WRITE(numout,*) '   Hard coded parameters'
-         WRITE(numout,*) '      Surface roughness (m)                         hsro          = ', hsro
-         WRITE(numout,*) '      Bottom roughness (m)                          hbro          = ', hbro
+         WRITE(numout,*) '      Surface roughness (m)                         rn_hsro        = ', rn_hsro
+         WRITE(numout,*) '      Bottom roughness (m) (nambfr namelist)        rn_bfrz0       = ', rn_bfrz0
       ENDIF
 
@@ -978,8 +909,7 @@
 
       !                                !* Check of some namelist values
-      IF( nn_tkebc_surf < 0 .OR. nn_tkebc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_tkebc_surf is 0 or 1' )
-      IF( nn_psibc_surf < 0 .OR. nn_psibc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_psibc_surf is 0 or 1' )
-      IF( nn_tkebc_bot  < 0 .OR. nn_tkebc_bot  > 1 ) CALL ctl_stop( 'bad flag: nn_tkebc_bot is 0 or 1' )
-      IF( nn_psibc_bot  < 0 .OR. nn_psibc_bot  > 1 ) CALL ctl_stop( 'bad flag: nn_psibc_bot is 0 or 1' )
+      IF( nn_bc_surf < 0 .OR. nn_bc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_bc_surf is 0 or 1' )
+      IF( nn_bc_surf < 0 .OR. nn_bc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_bc_surf is 0 or 1' )
+      IF( nn_z0_met < 0 .OR. nn_z0_met > 2 ) CALL ctl_stop( 'bad flag: nn_z0_met is 0, 1 or 2' )
       IF( nn_stab_func  < 0 .OR. nn_stab_func  > 3 ) CALL ctl_stop( 'bad flag: nn_stab_func is 0, 1, 2 and 3' )
       IF( nn_clos       < 0 .OR. nn_clos       > 3 ) CALL ctl_stop( 'bad flag: nn_clos is 0, 1, 2 or 3' )
@@ -1001,5 +931,5 @@
          SELECT CASE ( nn_stab_func )
          CASE( 0, 1 )   ;   rpsi3m = 2.53_wp       ! G88 or KC stability functions
-         CASE( 2 )      ;   rpsi3m = 2.38_wp       ! Canuto A stability functions
+         CASE( 2 )      ;   rpsi3m = 2.62_wp       ! Canuto A stability functions
          CASE( 3 )      ;   rpsi3m = 2.38          ! Canuto B stability functions (caution : constant not identified)
          END SELECT
@@ -1012,5 +942,5 @@
          rnn     = -1._wp
          rsc_tke =  1._wp
-         rsc_psi =  1.3_wp  ! Schmidt number for psi
+         rsc_psi =  1.2_wp  ! Schmidt number for psi
          rpsi1   =  1.44_wp
          rpsi3p  =  1._wp
@@ -1140,9 +1070,10 @@
       !                                     ! See Eq. (13) of Carniel et al, OM, 30, 225-239, 2009
       !                                     !  or Eq. (17) of Burchard, JPO, 31, 3133-3145, 2001
-      IF( ln_sigpsi .AND. ln_crban ) THEN
-         zcr = SQRT( 1.5_wp*rsc_tke ) * rcm_sf / vkarmn
-         rsc_psi0 = vkarmn*vkarmn / ( rpsi2 * rcm_sf*rcm_sf )                       & 
-        &         * ( rnn*rnn - 4._wp/3._wp * zcr*rnn*rmm - 1._wp/3._wp * zcr*rnn   &
-        &           + 2._wp/9._wp * rmm * zcr*zcr + 4._wp/9._wp * zcr*zcr * rmm*rmm )                                 
+      IF( ln_sigpsi ) THEN
+         ra_sf = -1.5 ! Set kinetic energy slope, then deduce rsc_psi and rl_sf 
+         ! Verification: retrieve Burchard (2001) results by uncomenting the line below:
+         ! Note that the results depend on the value of rn_cm_sf which is constant (=rc0) in his work
+         ! ra_sf = -SQRT(2./3.*rc0**3./rn_cm_sf*rn_sc_tke)/vkarmn
+         rsc_psi0 = rsc_tke/(24.*rpsi2)*(-1.+(4.*rnn + ra_sf*(1.+4.*rmm))**2./(ra_sf**2.))
       ELSE
          rsc_psi0 = rsc_psi
@@ -1151,11 +1082,17 @@
       !                                !* Shear free turbulence parameters
       !
-      ra_sf  = -4._wp * rnn * SQRT( rsc_tke ) / ( (1._wp+4._wp*rmm) * SQRT( rsc_tke )   &
-         &                                      - SQRT(rsc_tke + 24._wp*rsc_psi0*rpsi2 ) )
-      rl_sf  = rc0 * SQRT( rc0 / rcm_sf )                                                                   &
-         &         * SQRT(  (  (1._wp + 4._wp*rmm + 8._wp*rmm*rmm) * rsc_tke                                &
-         &                   + 12._wp * rsc_psi0 * rpsi2                                                    &
-         &                   - (1._wp + 4._wp*rmm) * SQRT( rsc_tke*(rsc_tke+ 24._wp*rsc_psi0*rpsi2) )  )    &
-         &                / ( 12._wp*rnn*rnn )                                                              )
+      ra_sf  = -4._wp*rnn*SQRT(rsc_tke) / ( (1._wp+4._wp*rmm)*SQRT(rsc_tke) &
+               &                              - SQRT(rsc_tke + 24._wp*rsc_psi0*rpsi2 ) )
+
+      IF ( rn_crban==0._wp ) THEN
+         rl_sf = vkarmn
+      ELSE
+         rl_sf = rc0 * SQRT(rc0/rcm_sf) * SQRT( ( (1._wp + 4._wp*rmm + 8._wp*rmm**2_wp)*rsc_tke          &
+                 &                                       + 12._wp * rsc_psi0*rpsi2 - (1._wp + 4._wp*rmm) &
+                 &                                                *SQRT(rsc_tke*(rsc_tke                 &
+                 &                                                   + 24._wp*rsc_psi0*rpsi2)) )         &
+                 &                                         /(12._wp*rnn**2.)                             &
+                 &                                       )
+      ENDIF
 
       !
@@ -1187,16 +1124,15 @@
       rc03  = rc02 * rc0
       rc04  = rc03 * rc0
-      rc03_sqrt2_galp = rc03 / SQRT(2._wp) / rn_clim_galp
-      rsbc_mb   = 0.5_wp * (15.8_wp*rn_crban)**(2._wp/3._wp)               ! Surf. bound. cond. from Mellor and Blumberg
-      rsbc_std  = 3.75_wp                                                  ! Surf. bound. cond. standard (prod=diss)
-      rsbc_tke1 = (-rsc_tke*rn_crban/(rcm_sf*ra_sf*rl_sf))**(2._wp/3._wp)  ! k_eps = 53.  Dirichlet + Wave breaking 
-      rsbc_tke2 = 0.5_wp / rau0
-      rsbc_tke3 = rdt * rn_crban                                                         ! Neumann + Wave breaking
-      rsbc_zs   = rn_charn / grav                                                        ! Charnock formula
-      rsbc_psi1 = rc0**rpp * rsbc_tke1**rmm * rl_sf**rnn                           ! Dirichlet + Wave breaking
-      rsbc_psi2 = -0.5_wp * rdt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi                   ! Neumann + NO Wave breaking 
-      rsbc_psi3 = -0.5_wp * rdt * rc0**rpp * rl_sf**rnn / rsc_psi  * (rnn + rmm*ra_sf) ! Neumann + Wave breaking
-      rfact_tke = -0.5_wp / rsc_tke * rdt               ! Cst used for the Diffusion term of tke
-      rfact_psi = -0.5_wp / rsc_psi * rdt               ! Cst used for the Diffusion term of tke
+      rsbc_tke1 = -3._wp/2._wp*rn_crban*ra_sf*rl_sf                      ! Dirichlet + Wave breaking
+      rsbc_tke2 = rdt * rn_crban / rl_sf                                 ! Neumann + Wave breaking 
+      zcr = MAX(rsmall, rsbc_tke1**(1./(-ra_sf*3._wp/2._wp))-1._wp )
+      rtrans = 0.2_wp / zcr                                              ! Ad. inverse transition length between log and wave layer 
+      rsbc_zs1  = rn_charn/grav                                          ! Charnock formula for surface roughness
+      rsbc_zs2  = rn_frac_hs / 0.85_wp / grav * 665._wp                  ! Rascle formula for surface roughness 
+      rsbc_psi1 = -0.5_wp * rdt * rc0**(rpp-2._wp*rmm) / rsc_psi
+      rsbc_psi2 = -0.5_wp * rdt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking 
+
+      rfact_tke = -0.5_wp / rsc_tke * rdt                                ! Cst used for the Diffusion term of tke
+      rfact_psi = -0.5_wp / rsc_psi * rdt                                ! Cst used for the Diffusion term of tke
 
       !                                !* Wall proximity function
@@ -1257,5 +1193,5 @@
                IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop'
                en  (:,:,:) = rn_emin
-               mxln(:,:,:) = 0.001        
+               mxln(:,:,:) = 0.05        
                avt_k (:,:,:) = avt (:,:,:)
                avm_k (:,:,:) = avm (:,:,:)
@@ -1267,5 +1203,5 @@
             IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of en and mxln by background values'
             en  (:,:,:) = rn_emin
-            mxln(:,:,:) = 0.001       
+            mxln(:,:,:) = 0.05       
          ENDIF
          !
@@ -1273,8 +1209,8 @@
          !                                   ! -------------------
          IF(lwp) WRITE(numout,*) '---- gls-rst ----'
-         CALL iom_rstput( kt, nitrst, numrow, 'en'   , en     )
+         CALL iom_rstput( kt, nitrst, numrow, 'en'   , en     ) 
          CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt_k  )
          CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm_k  )
-         CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k )
+         CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k ) 
          CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k )
          CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln   )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 5682)
@@ -14,5 +14,4 @@
    !!----------------------------------------------------------------------
    USE par_oce         ! mesh and scale factors
-   USE sbc_oce         ! surface module (only for nn_isf in the option compatibility test)
    USE ldftra_oce      ! ocean active tracers: lateral physics
    USE ldfdyn_oce      ! ocean dynamics lateral physics
@@ -118,5 +117,5 @@
       IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa )   &
          &   CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' )
-      IF( ( lk_zdfric .OR. lk_zdfgls .OR. lk_zdfkpp ) .AND. nn_isf .NE. 0 )   &
+      IF( ( lk_zdfric .OR. lk_zdfgls .OR. lk_zdfkpp ) .AND. ln_isfcav )   &
          &   CALL ctl_stop( ' only zdfcst and zdftke were tested with ice shelves cavities ' )
       !
@@ -125,6 +124,7 @@
       IF(lwp) WRITE(numout,*) '   convection :'
       !
-      IF( ln_zdfnpc )   CALL ctl_stop( ' zdf_init: non penetrative convective scheme is not working',   &
-         &                                       ' set ln_zdfnpc to FALSE' )
+#if defined key_top
+      IF( ln_zdfnpc )   CALL ctl_stop( ' zdf_init: npc scheme is not working with key_top' )
+#endif
       !
       ioptio = 0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 5682)
@@ -26,4 +26,5 @@
    !!                 !                                + cleaning of the parameters + bugs correction
    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
+   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability
    !!----------------------------------------------------------------------
 #if defined key_zdftke   ||   defined key_esopa
@@ -52,4 +53,8 @@
    USE timing         ! Timing
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+#if defined key_agrif
+   USE agrif_opa_interp
+   USE agrif_opa_update
+#endif
 
    IMPLICIT NONE
@@ -84,9 +89,7 @@
    REAL(wp) ::   rhftau_scl = 1.0_wp       ! scale factor applied to HF part of taum  (nn_etau=3)
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en             !: now turbulent kinetic energy   [m2/s2]
    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau)
    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   apdlr          ! now mixing lenght of dissipation
 #if defined key_c1d
    !                                                                        !!** 1D cfg only  **   ('key_c1d')
@@ -114,7 +117,6 @@
          &      e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) ,                          &
 #endif
-         &      en    (jpi,jpj,jpk) , htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     & 
-         &      avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk),                          &
-         &      avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), STAT= zdf_tke_alloc      )
+         &      apdlr(jpi,jpj,jpk) , htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     & 
+         &      STAT= zdf_tke_alloc      )
          !
       IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc )
@@ -172,4 +174,9 @@
       !!----------------------------------------------------------------------
       !
+#if defined key_agrif 
+      ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2)
+      IF( .NOT.Agrif_Root() )   CALL Agrif_Tke
+#endif
+      !
       IF( kt /= nit000 ) THEN   ! restore before value to compute tke
          avt (:,:,:) = avt_k (:,:,:) 
@@ -188,5 +195,11 @@
       avmv_k(:,:,:) = avmv(:,:,:) 
       !
-   END SUBROUTINE zdf_tke
+#if defined key_agrif
+      ! Update child grid f => parent grid 
+      IF(lwp) WRITE(numout,*)  'sebseb', Agrif_Root(), kt, Agrif_NbStepint()
+      IF( .NOT.Agrif_Root() )   CALL Agrif_Update_Tke( kt )      ! children only
+#endif      
+     ! 
+  END SUBROUTINE zdf_tke
 
 
@@ -222,5 +235,6 @@
       INTEGER , POINTER, DIMENSION(:,:  ) :: imlc
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zhlc
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw, z3du, z3dv
+      REAL(wp)                            ::   zri  !   local Richardson number
       !!--------------------------------------------------------------------
       !
@@ -229,5 +243,5 @@
       CALL wrk_alloc( jpi,jpj, imlc )    ! integer
       CALL wrk_alloc( jpi,jpj, zhlc ) 
-      CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 
+      CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 
       !
       zbbrau = rn_ebb / rau0       ! Local constant initialisation
@@ -236,14 +250,18 @@
       zfact3 = 0.5_wp       * rn_ediss
       !
+      !
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       !                     !  Surface boundary condition on tke
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF ( ln_isfcav ) THEN
+         DO jj = 2, jpjm1            ! en(mikt(ji,jj))   = rn_emin
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               en(ji,jj,mikt(ji,jj))=rn_emin * tmask(ji,jj,1)
+            END DO
+         END DO
+      END IF
       DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0)
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            IF (mikt(ji,jj) .GT. 1) THEN
-               en(ji,jj,mikt(ji,jj))=rn_emin
-            ELSE
-               en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)
-            END IF
+            en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)
          END DO
       END DO
@@ -301,6 +319,9 @@
          END DO
          zcof = 0.016 / SQRT( zrhoa * zcdrag )
+!CDIR NOVERRCHK
          DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en
-            DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO jj = 2, jpjm1
+!CDIR NOVERRCHK
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift
@@ -309,5 +330,5 @@
                   zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) )
                   !                                           ! TKE Langmuir circulation source term
-                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * tmask(ji,jj,jk)
+                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1)
                END DO
             END DO
@@ -324,21 +345,38 @@
       !
       DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form)
-         DO jj = 1, jpj                 ! here avmu, avmv used as workspace
-            DO ji = 1, jpi
-               avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   &
-                  &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   & 
-                  &           / (  fse3uw_n(ji,jj,jk)         &
-                  &              * fse3uw_b(ji,jj,jk) )
-               avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )   &
-                  &                            * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )   &
-                  &                            / (  fse3vw_n(ji,jj,jk)               &
-                  &                              *  fse3vw_b(ji,jj,jk)  )
-            END DO
-         END DO
-      END DO
-      !
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            DO jk = mikt(ji,jj)+1, jpkm1           !* Matrix and right hand side in en
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               z3du(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji+1,jj,jk) )   &
+                  &                 * (  un(ji,jj,jk-1) -  un(ji  ,jj,jk) )   &
+                  &                 * (  ub(ji,jj,jk-1) -  ub(ji  ,jj,jk) ) / (  fse3uw_n(ji,jj,jk) * fse3uw_b(ji,jj,jk) )
+               z3dv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji,jj+1,jk) )   &
+                  &                 * (  vn(ji,jj,jk-1) -  vn(ji,jj  ,jk) )   &
+                  &                 * (  vb(ji,jj,jk-1) -  vb(ji,jj  ,jk) ) / (  fse3vw_n(ji,jj,jk) * fse3vw_b(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      !
+      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: compute apdlr
+         ! Note that zesh2 is also computed in the next loop.
+         ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !                                          ! shear prod. at w-point weightened by mask
+                  zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                     &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
+                  !                                          ! local Richardson number
+                  zri   = MAX( rn2b(ji,jj,jk), 0._wp ) * avm(ji,jj,jk) / ( zesh2 + rn_bshear )
+                  apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  )
+                  
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+         !         
+      DO jk = 2, jpkm1           !* Matrix and right hand side in en
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
                zcof   = zfact1 * tmask(ji,jj,jk)
                zzd_up = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &  ! upper diagonal
@@ -346,8 +384,8 @@
                zzd_lw = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &  ! lower diagonal
                   &          / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
-                  !                                                           ! shear prod. at w-point weightened by mask
-               zesh2  =  ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
-                  &    + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
-                  !
+               !                                   ! shear prod. at w-point weightened by mask
+               zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                  &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
+               !
                zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw)
                zd_lw(ji,jj,jk) = zzd_lw
@@ -357,26 +395,48 @@
                en(ji,jj,jk) = en(ji,jj,jk) + rdt * (  zesh2  -   avt(ji,jj,jk) * rn2(ji,jj,jk)    &
                   &                                 + zfact3 * dissl(ji,jj,jk) * en (ji,jj,jk)  ) &
-                  &                                 * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
-            END DO
-            !                          !* Matrix inversion from level 2 (tke prescribed at level 1)
-            DO jk = mikt(ji,jj)+2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+                  &                                 * wmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !                          !* Matrix inversion from level 2 (tke prescribed at level 1)
+      DO jk = 3, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
                zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
             END DO
-            ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
-            zd_lw(ji,jj,mikt(ji,jj)+1) = en(ji,jj,mikt(ji,jj)+1) - zd_lw(ji,jj,mikt(ji,jj)+1) * en(ji,jj,mikt(ji,jj))    ! Surface boudary conditions on tke
-            !
-            DO jk = mikt(ji,jj)+2, jpkm1
+         END DO
+      END DO
+      !
+      ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke
+         END DO
+      END DO
+      DO jk = 3, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
                zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1)
             END DO
-            !
-            ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+         END DO
+      END DO
+      !
+      ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
             en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1)
-            !
-            DO jk = jpk-2, mikt(ji,jj)+1, -1
+         END DO
+      END DO
+      DO jk = jpk-2, 2, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
                en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
             END DO
-            !
-            DO jk = mikt(ji,jj), jpkm1                             ! set the minimum value of tke
-               en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * tmask(ji,jj,jk)
+         END DO
+      END DO
+      DO jk = 2, jpkm1                             ! set the minimum value of tke
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk)
             END DO
          END DO
@@ -391,5 +451,5 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
-                     &                                 * ( 1._wp - fr_i(ji,jj) )  * tmask(ji,jj,jk) * tmask(ji,jj,1)
+                     &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
                END DO
             END DO
@@ -400,5 +460,5 @@
                jk = nmln(ji,jj)
                en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
-                  &                                 * ( 1._wp - fr_i(ji,jj) )  * tmask(ji,jj,jk) * tmask(ji,jj,1)
+                  &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
             END DO
          END DO
@@ -416,5 +476,5 @@
                   zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications...
                   en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
-                     &                        * ( 1._wp - fr_i(ji,jj) ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * tmask(ji,jj,1)
+                     &                        * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
                END DO
             END DO
@@ -425,5 +485,5 @@
       CALL wrk_dealloc( jpi,jpj, imlc )    ! integer
       CALL wrk_dealloc( jpi,jpj, zhlc ) 
-      CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 
+      CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tke_tke')
@@ -469,5 +529,5 @@
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   zrn2, zraug, zcoef, zav     ! local scalars
-      REAL(wp) ::   zdku, zpdlr, zri, zsqen     !   -      -
+      REAL(wp) ::   zdku, zri, zsqen     !   -      -
       REAL(wp) ::   zdkv, zemxl, zemlm, zemlp   !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zmpdl, zmxlm, zmxld
@@ -484,34 +544,28 @@
       !                     !* Buoyancy length scale: l=sqrt(2*e/n**2)
       !
+      ! initialisation of interior minimum value (avoid a 2d loop with mikt)
+      zmxlm(:,:,:)  = rmxl_min    
+      zmxld(:,:,:)  = rmxl_min
+      !
       IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
-               IF (mikt(ji,jj) .GT. 1) THEN
-                  zmxlm(ji,jj,mikt(ji,jj)) = rmxl_min
-               ELSE
-                  zraug = vkarmn * 2.e5_wp / ( rau0 * grav )
-                  zmxlm(ji,jj,mikt(ji,jj)) = MAX( rn_mxl0, zraug * taum(ji,jj) )
-               END IF
+               zraug = vkarmn * 2.e5_wp / ( rau0 * grav )
+               zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) )
             END DO
          END DO
       ELSE 
+         zmxlm(:,:,1) = rn_mxl0
+      ENDIF
+      !
+!CDIR NOVERRCHK
+      DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2)
+!CDIR NOVERRCHK
          DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1                         ! surface set to the minimum value
-               zmxlm(ji,jj,mikt(ji,jj)) = MAX( tmask(ji,jj,1) * rn_mxl0, rmxl_min)
-            END DO
-         END DO
-      ENDIF
-      zmxlm(:,:,jpk)  = rmxl_min     ! last level set to the interior minium value
-      !
-!CDIR NOVERRCHK
-      DO jj = 2, jpjm1
-!CDIR NOVERRCHK
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            !CDIR NOVERRCHK
-            DO jk = mikt(ji,jj)+1, jpkm1              ! interior value : l=sqrt(2*e/n^2)
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1   ! vector opt.
                zrn2 = MAX( rn2(ji,jj,jk), rsmall )
-               zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  )
-            END DO
-            zmxld(ji,jj,mikt(ji,jj)) = zmxlm(ji,jj,mikt(ji,jj))   ! surface set to the minimum value 
+               zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) )
+            END DO
          END DO
       END DO
@@ -519,17 +573,19 @@
       !                     !* Physical limits for the mixing length
       !
-      zmxld(:,:, 1 ) = zmxlm(:,:,1)   ! surface set to the zmxlm   value
+      zmxld(:,:,1  ) = zmxlm(:,:,1)   ! surface set to the minimum value 
       zmxld(:,:,jpk) = rmxl_min       ! last level  set to the minimum value
       !
       SELECT CASE ( nn_mxl )
       !
+      ! where wmask = 0 set zmxlm == fse3w
       CASE ( 0 )           ! bounded by the distance to surface and bottom
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               DO jk = mikt(ji,jj)+1, jpkm1
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
                   zemxl = MIN( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk),   &
                   &            fsdepw(ji,jj,mbkt(ji,jj)+1) - fsdepw(ji,jj,jk) )
-                  zmxlm(ji,jj,jk) = zemxl
-                  zmxld(ji,jj,jk) = zemxl
+                  ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj)
+                  zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),fse3w(ji,jj,jk)) * (1 - wmask(ji,jj,jk))
+                  zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),fse3w(ji,jj,jk)) * (1 - wmask(ji,jj,jk))
                END DO
             END DO
@@ -537,7 +593,7 @@
          !
       CASE ( 1 )           ! bounded by the vertical scale factor
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               DO jk = mikt(ji,jj)+1, jpkm1
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
                   zemxl = MIN( fse3w(ji,jj,jk), zmxlm(ji,jj,jk) )
                   zmxlm(ji,jj,jk) = zemxl
@@ -548,10 +604,14 @@
          !
       CASE ( 2 )           ! |dk[xml]| bounded by e3t :
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               DO jk = mikt(ji,jj)+1, jpkm1         ! from the surface to the bottom :
+         DO jk = 2, jpkm1         ! from the surface to the bottom :
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
                   zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
                END DO
-               DO jk = jpkm1, mikt(ji,jj)+1, -1     ! from the bottom to the surface :
+            END DO
+         END DO
+         DO jk = jpkm1, 2, -1     ! from the bottom to the surface :
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
                   zemxl = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
                   zmxlm(ji,jj,jk) = zemxl
@@ -562,10 +622,14 @@
          !
       CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t :
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               DO jk = mikt(ji,jj)+1, jpkm1         ! from the surface to the bottom : lup
+         DO jk = 2, jpkm1         ! from the surface to the bottom : lup
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
                   zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
                END DO
-               DO jk = jpkm1, mikt(ji,jj)+1, -1     ! from the bottom to the surface : ldown
+            END DO
+         END DO
+         DO jk = jpkm1, 2, -1     ! from the bottom to the surface : ldown
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
                   zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
                END DO
@@ -604,6 +668,6 @@
                zsqen = SQRT( en(ji,jj,jk) )
                zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen
-               avm  (ji,jj,jk) = MAX( zav,                  avmb(jk) ) * tmask(ji,jj,jk)
-               avt  (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
+               avm  (ji,jj,jk) = MAX( zav,                  avmb(jk) ) * wmask(ji,jj,jk)
+               avt  (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
                dissl(ji,jj,jk) = zsqen / zmxld(ji,jj,jk)
             END DO
@@ -612,35 +676,22 @@
       CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged)
       !
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            DO jk = miku(ji,jj)+1, jpkm1            !* vertical eddy viscosity at u- and v-points
-               avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj  ,jk) ) * umask(ji,jj,jk)
-            END DO
-            DO jk = mikv(ji,jj)+1, jpkm1
-               avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji  ,jj+1,jk) ) * vmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! Lateral boundary conditions
-      !
-      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt
+      DO jk = 2, jpkm1            !* vertical eddy viscosity at wu- and wv-points
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               DO jk = mikt(ji,jj)+1, jpkm1
-                  zcoef = avm(ji,jj,jk) * 2._wp * fse3w(ji,jj,jk) * fse3w(ji,jj,jk)
-                  !                                          ! shear
-                  zdku = avmu(ji-1,jj,jk) * ( un(ji-1,jj,jk-1) - un(ji-1,jj,jk) ) * ( ub(ji-1,jj,jk-1) - ub(ji-1,jj,jk) )   &
-                    &  + avmu(ji  ,jj,jk) * ( un(ji  ,jj,jk-1) - un(ji  ,jj,jk) ) * ( ub(ji  ,jj,jk-1) - ub(ji  ,jj,jk) )
-                  zdkv = avmv(ji,jj-1,jk) * ( vn(ji,jj-1,jk-1) - vn(ji,jj-1,jk) ) * ( vb(ji,jj-1,jk-1) - vb(ji,jj-1,jk) )   &
-                    &  + avmv(ji,jj  ,jk) * ( vn(ji,jj  ,jk-1) - vn(ji,jj  ,jk) ) * ( vb(ji,jj  ,jk-1) - vb(ji,jj  ,jk) )
-                  !                                          ! local Richardson number
-                  zri   = MAX( rn2b(ji,jj,jk), 0._wp ) * zcoef / (zdku + zdkv + rn_bshear )
-                  zpdlr = MAX(  0.1_wp,  0.2 / MAX( 0.2 , zri )  )
-!!gm and even better with the use of the "true" ri_crit=0.22222...  (this change the results!)
-!!gm              zpdlr = MAX(  0.1_wp,  ri_crit / MAX( ri_crit , zri )  )
-                  avt(ji,jj,jk)   = MAX( zpdlr * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
+               avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj  ,jk) ) * wumask(ji,jj,jk)
+               avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji  ,jj+1,jk) ) * wvmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! Lateral boundary conditions
+      !
+      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
 # if defined key_c1d
-                  e_pdl(ji,jj,jk) = zpdlr * tmask(ji,jj,jk)  ! c1d configuration : save masked Prandlt number
-                  e_ric(ji,jj,jk) = zri   * tmask(ji,jj,jk)  ! c1d config. : save Ri
+                  e_pdl(ji,jj,jk) = apdlr(ji,jj,jk) * wmask(ji,jj,jk)    ! c1d configuration : save masked Prandlt number
+                  e_ric(ji,jj,jk) = zri * wmask(ji,jj,jk)                            ! c1d config. : save Ri
 # endif
               END DO
@@ -729,5 +780,5 @@
       IF( nn_pdl  < 0   .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1    ' )
       IF( nn_htau < 0   .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' )
-      IF( nn_etau == 3 .AND. .NOT. lk_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' )
+      IF( nn_etau == 3 .AND. .NOT. ln_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' )
 
       IF( ln_mxl0 ) THEN
@@ -749,8 +800,8 @@
       !                               !* set vertical eddy coef. to the background value
       DO jk = 1, jpk
-         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
-         avm (:,:,jk) = avmb(jk) * tmask(:,:,jk)
-         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
-         avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
+         avt (:,:,jk) = avtb(jk) * wmask (:,:,jk)
+         avm (:,:,jk) = avmb(jk) * wmask (:,:,jk)
+         avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk)
+         avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk)
       END DO
       dissl(:,:,:) = 1.e-12_wp
@@ -803,4 +854,10 @@
               en (:,:,:) = rn_emin * tmask(:,:,:)
               CALL tke_avn                               ! recompute avt, avm, avmu, avmv and dissl (approximation)
+              !
+              avt_k (:,:,:) = avt (:,:,:)
+              avm_k (:,:,:) = avm (:,:,:)
+              avmu_k(:,:,:) = avmu(:,:,:)
+              avmv_k(:,:,:) = avmv(:,:,:)
+              !
               DO jit = nit000 + 1, nit000 + 10   ;   CALL zdf_tke( jit )   ;   END DO
            ENDIF
@@ -808,8 +865,8 @@
            en(:,:,:) = rn_emin * tmask(:,:,:)
            DO jk = 1, jpk                           ! set the Kz to the background value
-              avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
-              avm (:,:,jk) = avmb(jk) * tmask(:,:,jk)
-              avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
-              avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
+              avt (:,:,jk) = avtb(jk) * wmask (:,:,jk)
+              avm (:,:,jk) = avmb(jk) * wmask (:,:,jk)
+              avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk)
+              avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk)
            END DO
         ENDIF
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 5682)
@@ -126,5 +126,5 @@
       zkz(:,:) = 0.e0               !* Associated potential energy consummed over the whole water column
       DO jk = 2, jpkm1
-         zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk)* tmask(:,:,jk) * tmask(:,:,jk-1)
+         zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk)
       END DO
 
@@ -135,8 +135,8 @@
       END DO
 
-      DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
-         DO ji = 1, jpi
-            DO jk = mikt(ji,jj)+1, jpkm1     !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s
-               zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. )   !kz max = 300 cm2/s
+      DO jk = 2, jpkm1     !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s
+         DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
+            DO ji = 1, jpi
+               zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk)  !kz max = 300 cm2/s
             END DO
          END DO
@@ -166,18 +166,18 @@
       !                          !   Update  mixing coefs  !                          
       !                          ! ----------------------- !
-      DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
-         DO ji = 1, jpi
-            DO jk = mikt(ji,jj)+1, jpkm1              !* update momentum & tracer diffusivity with tidal mixing
-               avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk)
-               avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk)
+      DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing
+         DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
+            DO ji = 1, jpi
+               avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk)
+               avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk)
             END DO
          END DO
       END DO
       
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1  ! vector opt.
-            DO jk = mikt(ji,jj)+1, jpkm1              !* update momentum & tracer diffusivity with tidal mixing
-               avmu(ji,jj,jk) = avmu(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji+1,jj  ,jk) ) * umask(ji,jj,jk)
-               avmv(ji,jj,jk) = avmv(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji  ,jj+1,jk) ) * vmask(ji,jj,jk)
+      DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1  ! vector opt.
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji+1,jj  ,jk) ) * wumask(ji,jj,jk)
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji  ,jj+1,jk) ) * wvmask(ji,jj,jk)
             END DO
          END DO
@@ -457,8 +457,8 @@
          ztpc = 0.e0
          zpc(:,:,:) = MAX(rn_n2min,rn2(:,:,:)) * zav_tide(:,:,:)
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               DO jk= mikt(ji,jj)+1, jpkm1
-                  ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+         DO jk= 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
                END DO
             END DO
@@ -473,8 +473,8 @@
          zav_tide(:,:,:) = MIN( zav_tide(:,:,:), 60.e-4 )   
          zkz(:,:) = 0.e0
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               DO jk = mikt(ji,jj)+1, jpkm1
-               zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zav_tide(ji,jj,jk)* tmask(ji,jj,jk)
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk) * MAX(0.e0, rn2(ji,jj,jk)) * rau0 * zav_tide(ji,jj,jk) * wmask(ji,jj,jk)
                END DO
             END DO
@@ -498,8 +498,8 @@
          WRITE(numout,*) '          Min de zkz ', ztpc, ' Max = ', maxval(zkz(:,:) )
 
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               DO jk = mikt(ji,jj)+1, jpkm1
-                  zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. )   !kz max = 300 cm2/s
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk)  !kz max = 300 cm2/s
                END DO
             END DO
@@ -510,5 +510,5 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
                END DO
             END DO
@@ -519,5 +519,5 @@
          DO jk = 1, jpk
             ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zav_tide(:,:,jk)     * tmask_i(:,:) )   &
-               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) )
+               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) )
             ztpc = 1.E50
             DO jj = 1, jpj
@@ -540,5 +540,5 @@
             END DO
             ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zkz(:,:)     * tmask_i(:,:) )   &
-               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) )
+               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) )
             WRITE(numout,*) '                jk= ', jk,'   ', ze_z * 1.e4,' cm2/s'
          END DO
@@ -546,5 +546,5 @@
             zkz(:,:) = az_tmx(:,:,jk) /rn_n2min
             ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zkz(:,:)     * tmask_i(:,:) )   &
-               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) )
+               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) )
             WRITE(numout,*) 
             WRITE(numout,*) '          N2 min - jk= ', jk,'   ', ze_z * 1.e4,' cm2/s min= ',MINVAL(zkz)*1.e4,   &
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 5682)
@@ -82,4 +82,7 @@
    USE crsini          ! initialise grid coarsening utility
    USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
+   USE sbc_oce, ONLY: lk_oasis
+   USE stopar
+   USE stopts
 
    IMPLICIT NONE
@@ -158,7 +161,11 @@
           ENDIF
 
+#if defined key_agrif
+          CALL Agrif_Regrid()
+#endif
+
          DO WHILE ( istp <= nitend .AND. nstop == 0 )
 #if defined key_agrif
-            CALL Agrif_Step( stp )           ! AGRIF: time stepping
+            CALL stp                         ! AGRIF: time stepping
 #else
             CALL stp( istp )                 ! standard time stepping
@@ -169,5 +176,5 @@
 #endif
 
-      IF( lk_diaobs   )   CALL dia_obs_wri
+      IF( ln_diaobs   )   CALL dia_obs_wri
       !
       IF( ln_icebergs )   CALL icb_end( nitend )
@@ -184,8 +191,10 @@
       !
 #if defined key_agrif
-      CALL Agrif_ParentGrid_To_ChildGrid()
-      IF( lk_diaobs ) CALL dia_obs_wri
-      IF( nn_timing == 1 )   CALL timing_finalize
-      CALL Agrif_ChildGrid_To_ParentGrid()
+      IF( .NOT. Agrif_Root() ) THEN
+         CALL Agrif_ParentGrid_To_ChildGrid()
+         IF( ln_diaobs ) CALL dia_obs_wri
+         IF( nn_timing == 1 )   CALL timing_finalize
+         CALL Agrif_ChildGrid_To_ParentGrid()
+      ENDIF
 #endif
       IF( nn_timing == 1 )   CALL timing_finalize
@@ -195,7 +204,7 @@
 #if defined key_iomput
       CALL xios_finalize                ! end mpp communications with xios
-      IF( lk_cpl ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS
+      IF( lk_oasis ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS
 #else
-      IF( lk_cpl ) THEN 
+      IF( lk_oasis ) THEN 
          CALL cpl_finalize              ! end coupling and mpp communications with OASIS
       ELSE
@@ -222,8 +231,9 @@
          &             nn_bench, nn_timing
       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
-         &             jpizoom, jpjzoom, jperio
+         &             jpizoom, jpjzoom, jperio, ln_use_jattr
       !!----------------------------------------------------------------------
       !
       cltxt = ''
+      cxios_context = 'nemo'
       !
       !                             ! Open reference namelist and configuration namelist files
@@ -261,4 +271,5 @@
       nperio  = 0
       jperio  = 0
+      ln_use_jattr = .false.
    ENDIF
 #endif
@@ -271,21 +282,24 @@
 #if defined key_iomput
       IF( Agrif_Root() ) THEN
-         IF( lk_cpl ) THEN
-            CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis
-            CALL xios_initialize( "oceanx",local_comm=ilocal_comm )    ! send nemo communicator to xios
+         IF( lk_oasis ) THEN
+            CALL cpl_init( "oceanx", ilocal_comm )                     ! nemo local communicator given by oasis
+            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios
          ELSE
-            CALL  xios_initialize( "nemo",return_comm=ilocal_comm )    ! nemo local communicator given by xios
+            CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios
          ENDIF
       ENDIF
-      narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection
+      ! Nodes selection (control print return in cltxt)
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
 #else
-      IF( lk_cpl ) THEN
+      IF( lk_oasis ) THEN
          IF( Agrif_Root() ) THEN
-            CALL cpl_init( ilocal_comm )                       ! nemo local communicator given by oasis
+            CALL cpl_init( "oceanx", ilocal_comm )                      ! nemo local communicator given by oasis
          ENDIF
-         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt)
+         ! Nodes selection (control print return in cltxt)
+         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
       ELSE
          ilocal_comm = 0
-         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
+         ! Nodes selection (control print return in cltxt)
+         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )
       ENDIF
 #endif
@@ -326,6 +340,14 @@
          jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
 #endif
-      ENDIF
+      ENDIF         
          jpk = jpkdta                                             ! third dim
+#if defined key_agrif
+         ! simple trick to use same vertical grid as parent
+         ! but different number of levels: 
+         ! Save maximum number of levels in jpkdta, then define all vertical grids
+         ! with this number.
+         ! Suppress once vertical online interpolation is ok
+         IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent(jpkdta)
+#endif
          jpim1 = jpi-1                                            ! inner domain indices
          jpjm1 = jpj-1                                            !   "           "
@@ -341,5 +363,5 @@
          WRITE(numout,*) '                       NEMO team'
          WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.4  (2011) '
+         WRITE(numout,*) '                  version 3.6  (2015) '
          WRITE(numout,*)
          WRITE(numout,*)
@@ -383,4 +405,6 @@
       IF( lk_tide       )   CALL    tide_init( nit000 )    ! Initialisation of the tidal harmonics
 
+                            CALL     sbc_init   ! Forcings : surface module (clem: moved here for bdy purpose)
+
       IF( lk_bdy        )   CALL     bdy_init   ! Open boundaries initialisation
       IF( lk_bdy        )   CALL bdy_dta_init   ! Open boundaries initialisation of external data arrays
@@ -389,10 +413,8 @@
 
                             CALL dyn_nept_init  ! simplified form of Neptune effect
-
       !     
       IF( ln_crs        )   CALL     crs_init   ! Domain initialization of coarsened grid
       !
                                 ! Ocean physics
-                            CALL     sbc_init   ! Forcings : surface module
       !                                         ! Vertical physics
                             CALL     zdf_init      ! namelist read
@@ -431,4 +453,6 @@
       IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_init       ! Cross Land Advection
                             CALL icb_init( rdt, nit000)   ! initialise icebergs instance
+                            CALL sto_par_init   ! Stochastic parametrization
+      IF( ln_sto_eos     )  CALL sto_pts_init   ! RRandom T/S fluctuations
      
 #if defined key_top
@@ -443,10 +467,8 @@
                             CALL dia_hsb_init   ! heat content, salt content and volume budgets
                             CALL     trd_init   ! Mixed-layer/Vorticity/Integral constraints trends
-      IF( lk_diaobs     ) THEN                  ! Observation & model comparison
                             CALL dia_obs_init            ! Initialize observational data
-                            CALL dia_obs( nit000 - 1 )   ! Observation operator for restart
-      ENDIF
-
-      !                                     ! Assimilation increments
+      IF( ln_diaobs     )   CALL dia_obs( nit000 - 1 )   ! Observation operator for restart
+
+      !                                         ! Assimilation increments
       IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments
       IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
@@ -506,4 +528,5 @@
          WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
          WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio   
+         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
       ENDIF
       !                             ! Parameter control
@@ -699,10 +722,8 @@
       INTEGER :: ifac, jl, inu
       INTEGER, PARAMETER :: ntest = 14
-      INTEGER :: ilfax(ntest)
-      !
+      INTEGER, DIMENSION(ntest) :: ilfax
+      !!----------------------------------------------------------------------
       ! lfax contains the set of allowed factors.
-      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  &
-         &                            128,   64,   32,   16,    8,   4,   2  /
-      !!----------------------------------------------------------------------
+      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
 
       ! Clear the error flag and initialise output vars
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 5682)
@@ -53,4 +53,11 @@
    !                                       !  = 6 cyclic East-West AND North fold F-point pivot
 
+   ! Input file read offset
+   LOGICAL       ::   ln_use_jattr     !: Use file global attribute: open_ocean_jstart to determine start j-row 
+                                           ! when reading input from those netcdf files that have the 
+                                           ! attribute defined. This is designed to enable input files associated 
+                                           ! with the extended grids used in the under ice shelf configurations to 
+                                           ! be used without redundant rows when the ice shelves are not in use.
+
    !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
    !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 5682)
@@ -50,5 +50,5 @@
 
 #if defined key_agrif
-   SUBROUTINE stp( )
+   RECURSIVE SUBROUTINE stp( )
       INTEGER             ::   kstp   ! ocean time-step index
 #else
@@ -79,20 +79,25 @@
 #if defined key_agrif
       kstp = nit000 + Agrif_Nb_Step()
-!      IF ( Agrif_Root() .and. lwp) Write(*,*) '---'
-!      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp
+      IF ( lk_agrif_debug ) THEN
+         IF ( Agrif_Root() .and. lwp) Write(*,*) '---'
+         IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint()
+      ENDIF
+
       IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE.
+
 # if defined key_iomput
-      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( "nemo" )
+      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context )
 # endif
 #endif
                              indic = 0           ! reset to no error condition
       IF( kstp == nit000 ) THEN
-                      CALL iom_init( "nemo" )      ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
-         IF( ln_crs ) CALL iom_init( "nemo_crs" )  ! initialize context for coarse grid
+         ! must be done after nemo_init for AGRIF+XIOS+OASIS
+                      CALL iom_init(      cxios_context          )  ! iom_put initialization
+         IF( ln_crs ) CALL iom_init( TRIM(cxios_context)//"_crs" )  ! initialize context for coarse grid
       ENDIF
 
       IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
-                             CALL iom_setkt( kstp - nit000 + 1, "nemo"     )   ! say to iom that we are at time step kstp
-      IF( ln_crs     )       CALL iom_setkt( kstp - nit000 + 1, "nemo_crs" )   ! say to iom that we are at time step kstp
+                             CALL iom_setkt( kstp - nit000 + 1,      cxios_context          )   ! tell iom we are at time step kstp
+      IF( ln_crs     )       CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell iom we are at time step kstp
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -100,8 +105,14 @@
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       IF( lk_tide    )   CALL sbc_tide( kstp )
-      IF( lk_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries
-
+      IF( lk_bdy     )  THEN
+         IF( ln_apr_dyn) CALL sbc_apr( kstp )   ! bdy_dta needs ssh_ib 
+                         CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries
+      ENDIF
                          CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
                                                       ! clem: moved here for bdy ice purpose
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Update stochastic parameters and random T/S fluctuations
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+                        CALL sto_par( kstp )          ! Stochastic parameters
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -122,7 +133,7 @@
       IF( lk_zdfkpp  )   CALL zdf_kpp( kstp )            ! KPP closure scheme for Kz
       IF( lk_zdfcst  ) THEN                              ! Constant Kz (reset avt, avm[uv] to the background value)
-         avt (:,:,:) = rn_avt0 * tmask(:,:,:)
-         avmu(:,:,:) = rn_avm0 * umask(:,:,:)
-         avmv(:,:,:) = rn_avm0 * vmask(:,:,:)
+         avt (:,:,:) = rn_avt0 * wmask (:,:,:)
+         avmu(:,:,:) = rn_avm0 * wumask(:,:,:)
+         avmv(:,:,:) = rn_avm0 * wvmask(:,:,:)
       ENDIF
       IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths
@@ -145,8 +156,13 @@
       !
       IF( lk_ldfslp ) THEN                            ! slope of lateral mixing
-                         CALL eos( tsb, rhd, gdept_0(:,:,:) )             ! before in situ density
-         IF( ln_zps )    CALL zps_hde( kstp, jpts, tsb, gtsu, gtsv,  &        ! Partial steps: before horizontal gradient
-            &                                      rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &             !
-            &                               gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi  )  ! of t, s, rd at the last ocean level
+         IF(ln_sto_eos ) CALL sto_pts( tsn )          ! Random T/S fluctuations
+                         CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density
+         IF( ln_zps .AND. .NOT. ln_isfcav)                               &
+            &            CALL zps_hde    ( kstp, jpts, tsb, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient
+            &                                          rhd, gru , grv    )  ! of t, s, rd at the last ocean level
+         IF( ln_zps .AND.       ln_isfcav)                               &
+            &            CALL zps_hde_isf( kstp, jpts, tsb, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
+            &                                          rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
+            &                                   gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the first ocean level
          IF( ln_traldf_grif ) THEN                           ! before slope for Griffies operator
                          CALL ldf_slp_grif( kstp )
@@ -158,8 +174,8 @@
       IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )      ! eddy induced velocity coefficient
 #endif
-#if defined key_traldf_c3d && key_traldf_smag
+#if defined key_traldf_c3d && defined key_traldf_smag
                           CALL ldf_tra_smag( kstp )      ! eddy induced velocity coefficient
 #  endif
-#if defined key_dynldf_c3d && key_dynldf_smag
+#if defined key_dynldf_c3d && defined key_dynldf_smag
                           CALL ldf_dyn_smag( kstp )      ! eddy induced velocity coefficient
 #  endif
@@ -176,12 +192,17 @@
           ! Note that the computation of vertical velocity above, hence "after" sea level
           ! is necessary to compute momentum advection for the rhs of barotropic loop:
+            IF(ln_sto_eos ) CALL sto_pts( tsn )                             ! Random T/S fluctuations
                             CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation
-            IF( ln_zps )    CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv,  &        ! Partial steps: before horizontal gradient
-               &                                      rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &             !
-               &                               gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi  )  ! of t, s, rd at the last ocean level
+            IF( ln_zps .AND. .NOT. ln_isfcav)                               &
+               &            CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
+               &                                          rhd, gru , grv    )  ! of t, s, rd at the last ocean level
+            IF( ln_zps .AND.       ln_isfcav)                               &
+               &            CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
+               &                                          rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
+               &                                   gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
 
                                   ua(:,:,:) = 0.e0             ! set dynamics trends to zero
                                   va(:,:,:) = 0.e0
-          IF(  ln_asmiau .AND. &
+          IF(  lk_asminc .AND. ln_asmiau .AND. &
              & ln_dyninc       )  CALL dyn_asm_inc  ( kstp )   ! apply dynamics assimilation increment
           IF( ln_neptsimp )       CALL dyn_nept_cor ( kstp )   ! subtract Neptune velocities (simplified)
@@ -208,15 +229,13 @@
       ! diagnostics and outputs             (ua, va, tsa used as workspace)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats
-      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth)
-      IF( .NOT. lk_cpl ) CALL dia_fwb( kstp )         ! Fresh water budget diagnostics
-      IF( ln_diaptr  )   CALL dia_ptr( kstp )         ! Poleward TRansports diagnostics
-      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports
-      IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag
-      IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis
-                         CALL dia_wri( kstp )         ! ocean model: outputs
-      !
-      IF( ln_crs     )   CALL crs_fld( kstp )         ! ocean model: online field coarsening & output
-
+      IF( lk_floats  )      CALL flo_stp( kstp )         ! drifting Floats
+      IF( lk_diahth  )      CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth)
+      IF( .NOT. ln_cpl )    CALL dia_fwb( kstp )         ! Fresh water budget diagnostics
+      IF( lk_diadct  )      CALL dia_dct( kstp )         ! Transports
+      IF( lk_diaar5  )      CALL dia_ar5( kstp )         ! ar5 diag
+      IF( lk_diaharm )      CALL dia_harm( kstp )        ! Tidal harmonic analysis
+                            CALL dia_wri( kstp )         ! ocean model: outputs
+      !
+      IF( ln_crs     )      CALL crs_fld( kstp )         ! ocean model: online field coarsening & output
 
 #if defined key_top
@@ -233,5 +252,5 @@
                              tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero
 
-      IF(  ln_asmiau .AND. &
+      IF(  lk_asminc .AND. ln_asmiau .AND. &
          & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment
                              CALL tra_sbc    ( kstp )       ! surface boundary condition
@@ -244,4 +263,7 @@
       IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes
                              CALL tra_ldf    ( kstp )       ! lateral mixing
+
+      IF( ln_diaptr      )   CALL dia_ptr                   ! Poleward adv/ldf TRansports diagnostics
+
 #if defined key_agrif
       IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge
@@ -252,14 +274,24 @@
          IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection
                              CALL tra_nxt( kstp )                ! tracer fields at next time step
+            IF( ln_sto_eos ) CALL sto_pts( tsn )                 ! Random T/S fluctuations
                              CALL eos    ( tsa, rhd, rhop, fsdept_n(:,:,:) )  ! Time-filtered in situ density for hpg computation
-         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsa, gtsu, gtsv,  &        ! Partial steps: before horizontal gradient
-            &                                      rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &             !
-            &                               gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi  )  ! of t, s, rd at the last ocean level
+            IF( ln_zps .AND. .NOT. ln_isfcav)                                &
+               &             CALL zps_hde    ( kstp, jpts, tsa, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
+               &                                           rhd, gru , grv    )  ! of t, s, rd at the last ocean level
+            IF( ln_zps .AND.       ln_isfcav)                                &
+               &             CALL zps_hde_isf( kstp, jpts, tsa, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
+               &                                           rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
+               &                                    gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
       ELSE                                                  ! centered hpg  (eos then time stepping)
          IF ( .NOT. lk_dynspg_ts ) THEN                     ! eos already called in time-split case
+            IF( ln_sto_eos ) CALL sto_pts( tsn )    ! Random T/S fluctuations
                              CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )  ! now in situ density for hpg computation
-         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv,  &        ! Partial steps: before horizontal gradient
-         &                                      rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &             !
-         &                               gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi  )  ! of t, s, rd at the last ocean level
+         IF( ln_zps .AND. .NOT. ln_isfcav)                                   &
+               &             CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
+               &                                           rhd, gru , grv    )  ! of t, s, rd at the last ocean level
+         IF( ln_zps .AND.       ln_isfcav)                                   & 
+               &             CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps for top cell (ISF)
+               &                                           rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   &
+               &                                    gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level
          ENDIF
          IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection
@@ -286,5 +318,5 @@
                                va(:,:,:) = 0.e0
 
-        IF(  ln_asmiau .AND. &
+        IF(  lk_asminc .AND. ln_asmiau .AND. &
            & ln_dyninc      )  CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment
         IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields
@@ -307,10 +339,23 @@
                                CALL ssh_swp( kstp )         ! swap of sea surface height
       IF( lk_vvl           )   CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors
-
+      !
+      IF( lrst_oce         )   CALL rst_write( kstp )       ! write output ocean restart file
+
+#if defined key_agrif
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! AGRIF
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
+                               CALL Agrif_Integrate_ChildGrids( stp )  
+
+      IF ( Agrif_NbStepint().EQ.0 ) THEN
+                               CALL Agrif_Update_Tra()      ! Update active tracers
+                               CALL Agrif_Update_Dyn()      ! Update momentum
+      ENDIF
+#endif
       IF( ln_diahsb        )   CALL dia_hsb( kstp )         ! - ML - global conservation diagnostics
-      IF( lk_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Control and restarts
+      IF( ln_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Control
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                                CALL stp_ctl( kstp, indic )
@@ -322,21 +367,21 @@
                  CALL iom_close( numror )     ! close input  ocean restart file
          IF(lwm) CALL FLUSH    ( numond )     ! flush output namelist oce
-         IF( lwm.AND.numoni /= -1 ) CALL FLUSH    ( numoni )     ! flush output namelist ice    
-      ENDIF
-      IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file
+         IF( lwm.AND.numoni /= -1 ) CALL FLUSH    ( numoni )     ! flush output namelist ice
+      ENDIF
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Coupled mode
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( lk_cpl           )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges
+      IF( lk_oasis         )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges
       !
 #if defined key_iomput
       IF( kstp == nitend .OR. indic < 0 ) THEN 
-                      CALL iom_context_finalize( "nemo"     ) ! needed for XIOS+AGRIF
-         IF( ln_crs ) CALL iom_context_finalize( "nemo_crs" ) ! 
+                      CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF
+         IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! 
       ENDIF
 #endif
       !
       IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset
+      !     
       !
    END SUBROUTINE stp
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 5682)
@@ -27,4 +27,5 @@
    USE sbc_oce          ! surface boundary condition: ocean
    USE sbctide          ! Tide initialisation
+   USE sbcapr           ! surface boundary condition: ssh_ib required by bdydta 
 
    USE traqsr           ! solar radiation penetration      (tra_qsr routine)
@@ -53,4 +54,7 @@
 
    USE dynnxt           ! time-stepping                    (dyn_nxt routine)
+
+   USE stopar           ! Stochastic parametrization       (sto_par routine)
+   USE stopts 
 
    USE bdy_par          ! for lk_bdy
@@ -108,4 +112,5 @@
 #if defined key_agrif
    USE agrif_opa_sponge ! Momemtum and tracers sponges
+   USE agrif_opa_update ! Update (2-way nesting)
 #endif
 #if defined key_top
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/timing.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/timing.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/timing.F90	(revision 5682)
@@ -211,5 +211,5 @@
          WRITE(numtime,*) '                             NEMO team'
          WRITE(numtime,*) '                  Ocean General Circulation Model'
-         WRITE(numtime,*) '                        version 3.3  (2010) '
+         WRITE(numtime,*) '                        version 3.6  (2015) '
          WRITE(numtime,*)
          WRITE(numtime,*) '                        Timing Informations '
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 5682)
@@ -32,4 +32,5 @@
    !!   'key_top'                                                 bio-model          
    !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_top     = .TRUE.   !: TOP model
    LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .TRUE.   !: bio-model light absorption flag
 #else
@@ -37,4 +38,5 @@
    !! Default option                          No bio-model light absorption      
    !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_top     = .FALSE.   !: TOP model
    LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .FALSE.   !: bio-model light absorption flag
 #endif
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90	(revision 5682)
@@ -121,7 +121,8 @@
 
    LOGICAL ::   linit = .FALSE.
+   LOGICAL ::   ldebug = .FALSE.
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id:$
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -486,4 +487,5 @@
       
       IF( SUM( tree(ii)%ishape ) == 0 ) THEN                    ! create a new branch 
+         IF(ldebug) PRINT *, 'create new branch ', ii,ishape, isrt, itype
          tree(ii)%itype = itype                                        ! define the type of this branch 
          tree(ii)%ishape(:) = ishape(:)                                ! define the shape of this branch 
@@ -515,4 +517,5 @@
          tree(ii)%current%next%in_use = .FALSE.                        ! this leaf is not yet used
          tree(ii)%current%next%indic = tree(ii)%current%indic + 1      ! number of this leaf
+         IF(ldebug) PRINT *, 'add a leaf ', ii, tree(ii)%current%indic
          tree(ii)%current%next%prev => tree(ii)%current                ! previous leaf of the new leaf is the current leaf
          tree(ii)%current%next%next => NULL()                          ! next leaf is not yet defined
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/daymod.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/daymod.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/daymod.F90	(revision 5682)
@@ -45,5 +45,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: daymod.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -71,4 +71,9 @@
       !!----------------------------------------------------------------------
       !
+      ! max number of seconds between each restart
+      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
+         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
+            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
+      ENDIF
       ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0
       IF( MOD( rday     , rdttra(1) ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
@@ -80,15 +85,8 @@
       ndt05   = NINT(0.5 * rdttra(1))
 
-      ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
-      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
-      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
-      IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
-      !
-      IF(lwp) THEN
-         WRITE(numout,*) ' *** Info used values : '
-         WRITE(numout,*) '   date ndastp                                      : ', ndastp
-         WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
-         WRITE(numout,*)
-      ENDIF
+      ! ==> clem: here we read the ocean restart for the date (only if it exists)
+      !           It is not clean and another solution should be found
+      CALL day_rst( nit000, 'READ' )
+      ! ==>
 
       ! set the calendar from ndastp (read in restart file and namelist)
@@ -131,5 +129,5 @@
 
       ! control print
-      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
+      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
            &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week
 
@@ -246,9 +244,4 @@
                nday_year = 1
                nsec_year = ndt05
-               IF( nsec1jan000 >= 2 * (2**30 - nsecd * nyear_len(1) / 2 ) ) THEN   ! test integer 4 max value
-                  CALL ctl_stop( 'The number of seconds between Jan. 1st 00h of nit000 year and Jan. 1st 00h ',   &
-                     &           'of the current year is exceeding the INTEGER 4 max VALUE: 2^31-1 -> 68.09 years in seconds', &
-                     & 'You must do a restart at higher frequency (or remove this STOP and recompile everything in I8)' )
-               ENDIF
                nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
                IF( nleapy == 1 )   CALL day_mth
@@ -285,4 +278,98 @@
       !
    END SUBROUTINE day
+
+
+   SUBROUTINE day_rst( kt, cdrw )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE ts_rst  ***
+      !!
+      !!  ** Purpose : Read or write calendar in restart file:
+      !!
+      !!  WRITE(READ) mode:
+      !!       kt        : number of time step since the begining of the experiment at the
+      !!                   end of the current(previous) run
+      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
+      !!                   end of the current(previous) run (REAL -> keep fractions of day)
+      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
+      !!
+      !!   According to namelist parameter nrstdt,
+      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary).
+      !!       nrstdt = 1  we verify that nit000 is equal to the last
+      !!                   time step of previous run + 1.
+      !!       In both those options, the  exact duration of the experiment
+      !!       since the beginning (cumulated duration of all previous restart runs)
+      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
+      !!       This is valid is the time step has remained constant.
+      !!
+      !!       nrstdt = 2  the duration of the experiment in days (adatrj)
+      !!                    has been stored in the restart file.
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      !
+      REAL(wp) ::   zkt, zndastp
+      !!----------------------------------------------------------------------
+
+      IF( TRIM(cdrw) == 'READ' ) THEN
+
+         IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN
+            ! Get Calendar informations
+            CALL iom_get( numror, 'kt', zkt )   ! last time-step of previous run
+            IF(lwp) THEN
+               WRITE(numout,*) ' *** Info read in restart : '
+               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
+               WRITE(numout,*) ' *** restart option'
+               SELECT CASE ( nrstdt )
+               CASE ( 0 )   ;   WRITE(numout,*) ' nrstdt = 0 : no control of nit000'
+               CASE ( 1 )   ;   WRITE(numout,*) ' nrstdt = 1 : no control the date at nit000 (use ndate0 read in the namelist)'
+               CASE ( 2 )   ;   WRITE(numout,*) ' nrstdt = 2 : calendar parameters read in restart'
+               END SELECT
+               WRITE(numout,*)
+            ENDIF
+            ! Control of date
+            IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 )                                         &
+                 &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 &
+                 &                  ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
+            ! define ndastp and adatrj
+            IF ( nrstdt == 2 ) THEN
+               ! read the parameters correspondting to nit000 - 1 (last time step of previous run)
+               CALL iom_get( numror, 'ndastp', zndastp )
+               ndastp = NINT( zndastp )
+               CALL iom_get( numror, 'adatrj', adatrj  )
+            ELSE
+               ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
+               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
+               adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+               ! note this is wrong if time step has changed during run
+            ENDIF
+         ELSE
+            ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
+            ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
+            adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+         ENDIF
+         IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) ' *** Info used values : '
+            WRITE(numout,*) '   date ndastp                                      : ', ndastp
+            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
+            WRITE(numout,*)
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
+         !
+         IF( kt == nitrst ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file  kt =', kt
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+         ENDIF
+         ! calendar control
+         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step
+         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date
+         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since
+         !                                                                     ! the begining of the run [s]
+      ENDIF
+      !
+   END SUBROUTINE day_rst
    !!======================================================================
 END MODULE daymod
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/diawri.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/diawri.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/diawri.F90	(revision 5682)
@@ -70,5 +70,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 5682)
@@ -42,5 +42,4 @@
    USE step_oce        ! module used in the ocean time stepping module
    USE sbc_oce         ! surface boundary condition: ocean
-   USE cla             ! cross land advection               (tra_cla routine)
    USE domcfg          ! domain configuration               (dom_cfg routine)
    USE daymod          ! calendar
@@ -50,9 +49,19 @@
    USE step            ! NEMO time-stepping                 (stp     routine)
    USE lib_mpp         ! distributed memory computing
+#if defined key_nosignedzero
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+#endif
 #if defined key_iomput
    USE xios
 #endif
+   USE cpl_oasis3
    USE sbcssm
-   USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges 
+   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
+   USE icbstp          ! handle bergs, calving, themodynamics and transport
+#if defined key_bdy
+   USE bdyini          ! open boundary cond. setting       (bdy_init routine). clem: mandatory for LIM3
+   USE bdydta          ! open boundary cond. setting   (bdy_dta_init routine). clem: mandatory for LIM3
+#endif
+   USE bdy_par
 
    IMPLICIT NONE
@@ -66,5 +75,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO Consortium (2011)
-   !! $Id: nemogcm.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -96,5 +105,12 @@
       !                            !-----------------------!
 #if defined key_agrif
-      CALL Agrif_Declare_Var       ! AGRIF: set the meshes
+      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM
+      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA 
+# if defined key_top
+      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP
+# endif
+# if defined key_lim2
+      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM
+# endif
 #endif
       ! check that all process are still there... If some process have an error,
@@ -118,4 +134,7 @@
          IF( lk_mpp )   CALL mpp_max( nstop )
       END DO
+      !
+      IF( ln_icebergs )   CALL icb_end( nitend )
+
       !                            !------------------------!
       !                            !==  finalize the run  ==!
@@ -136,8 +155,14 @@
       !
       CALL nemo_closefile
+      !
 #if defined key_iomput
       CALL xios_finalize                ! end mpp communications with xios
+      IF( lk_oasis ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS
 #else
-      IF( lk_mpp )   CALL mppstop       ! end mpp communications
+      IF( lk_oasis ) THEN 
+         CALL cpl_finalize              ! end coupling and mpp communications with OASIS
+      ELSE
+         IF( lk_mpp )   CALL mppstop    ! end mpp communications
+      ENDIF
 #endif
       !
@@ -154,18 +179,28 @@
       INTEGER ::   ilocal_comm   ! local integer      
       INTEGER ::   ios
-
       CHARACTER(len=80), DIMENSION(16) ::   cltxt
-      !!
+      CHARACTER(len=80) ::   clname
+      !
       NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
          &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
          &             nn_bench, nn_timing
       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
-         &             jpizoom, jpjzoom, jperio
-      !!----------------------------------------------------------------------
+         &             jpizoom, jpjzoom, jperio, ln_use_jattr
+      !!----------------------------------------------------------------------
+      !
       cltxt = ''
       !
       !                             ! Open reference namelist and configuration namelist files
-      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
-      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      IF( lk_oasis ) THEN 
+         CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+         CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+         cxios_context = 'sas'
+         clname = 'output.namelist_sas.dyn'
+      ELSE
+         CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+         CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+         cxios_context = 'nemo'
+         clname = 'output.namelist.dyn'
+   ENDIF
       !
       REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark
@@ -186,4 +221,21 @@
 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
 
+! Force values for AGRIF zoom (cf. agrif_user.F90)
+#if defined key_agrif
+   IF( .NOT. Agrif_Root() ) THEN
+      jpiglo  = nbcellsx + 2 + 2*nbghostcells
+      jpjglo  = nbcellsy + 2 + 2*nbghostcells
+      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
+      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
+      jpidta  = jpiglo
+      jpjdta  = jpjglo
+      jpizoom = 1
+      jpjzoom = 1
+      nperio  = 0
+      jperio  = 0
+      ln_use_jattr = .false.
+   ENDIF
+#endif
+      !
       !                             !--------------------------------------------!
       !                             !  set communicator & select the local node  !
@@ -193,10 +245,22 @@
 #if defined key_iomput
       IF( Agrif_Root() ) THEN
-         CALL  xios_initialize( "nemo",return_comm=ilocal_comm )
-      ENDIF
-      narea = mynode ( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection
+         IF( lk_oasis ) THEN
+            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis 
+            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios
+         ELSE
+            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )        ! nemo local communicator given by xios
+         ENDIF
+      ENDIF
+      narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection
 #else
-      ilocal_comm = 0
-      narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )        ! Nodes selection (control print return in cltxt)
+      IF( lk_oasis ) THEN
+         IF( Agrif_Root() ) THEN
+            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis
+         ENDIF
+         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt)
+      ELSE
+         ilocal_comm = 0
+         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
+      ENDIF
 #endif
       narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
@@ -229,10 +293,12 @@
       ! than variables
       IF( Agrif_Root() ) THEN
+#if defined key_nemocice_decomp
+         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim.
+         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 
+#else
          jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim.
-#if defined key_nemocice_decomp
-         jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 
-#else
          jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
 #endif
+      ENDIF
          jpk = jpkdta                                             ! third dim
          jpim1 = jpi-1                                            ! inner domain indices
@@ -240,9 +306,12 @@
          jpkm1 = jpk-1                                            !   "           "
          jpij  = jpi*jpj                                          !  jpi x j
-      ENDIF
 
       IF(lwp) THEN                            ! open listing units
          !
-         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         IF( lk_oasis ) THEN
+            CALL ctl_opn( numout,   'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         ELSE
+            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         ENDIF
          !
          WRITE(numout,*)
@@ -250,5 +319,5 @@
          WRITE(numout,*) '                       NEMO team'
          WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.4  (2011) '
+         WRITE(numout,*) '                  version 3.6  (2015) '
          WRITE(numout,*) '             StandAlone Surface version (SAS) '
          WRITE(numout,*)
@@ -287,9 +356,14 @@
 
       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
-                            CALL flush(numout)
-
                             CALL day_init   ! model calendar (using both namelist and restart infos)
 
                             CALL sbc_init   ! Forcings : surface module 
+                            
+      ! ==> clem: open boundaries init. is mandatory for LIM3 because ice BDY is not decoupled from  
+      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules. 
+      !           This is not clean and should be changed in the future. 
+      IF( lk_bdy        )   CALL     bdy_init
+      IF( lk_bdy        )   CALL bdy_dta_init
+      ! ==>
       
       IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
@@ -348,4 +422,5 @@
          WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
          WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio   
+         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
       ENDIF
       !                             ! Parameter control
@@ -396,4 +471,8 @@
       ENDIF
       !
+      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
+         &                                               'f2003 standard. '                              ,  &
+         &                                               'Compile with key_nosignedzero enabled' )
+      !
    END SUBROUTINE nemo_ctl
 
@@ -435,14 +514,37 @@
       USE diawri    , ONLY: dia_wri_alloc
       USE dom_oce   , ONLY: dom_oce_alloc
-      USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
-      !
-      INTEGER :: ierr,ierr4
+#if defined key_bdy   
+      USE bdy_oce   , ONLY: bdy_oce_alloc
+      USE oce         ! clem: mandatory for LIM3 because needed for bdy arrays
+#else
+      USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
+#endif
+      !
+      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6
+      INTEGER :: jpm
       !!----------------------------------------------------------------------
       !
       ierr =        dia_wri_alloc   ()
       ierr = ierr + dom_oce_alloc   ()          ! ocean domain
-      ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             &
-         &      snwice_fmass(jpi,jpj), STAT= ierr4 )
-      ierr = ierr + ierr4
+#if defined key_bdy
+      ierr = ierr + bdy_oce_alloc   ()          ! bdy masks (incl. initialization)
+      ierr = ierr + oce_alloc       ()          ! (tsn...)
+#endif
+
+#if ! defined key_bdy
+       ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             &
+         &      snwice_fmass(jpi,jpj)  , STAT= ierr1 )
+      !
+      ! lim code currently uses surface temperature and salinity in tsn array for initialisation
+      ! and ub, vb arrays in ice dynamics, so allocate enough of arrays to use
+      ! clem: should not be needed. To be checked out
+      jpm = MAX(jp_tem, jp_sal)
+      ALLOCATE( tsn(jpi,jpj,1,jpm)  , STAT=ierr2 )
+      ALLOCATE( ub(jpi,jpj,1)       , STAT=ierr3 )
+      ALLOCATE( vb(jpi,jpj,1)       , STAT=ierr4 )
+      ALLOCATE( tsb(jpi,jpj,1,jpm)  , STAT=ierr5 )
+      ALLOCATE( sshn(jpi,jpj)       , STAT=ierr6 )
+      ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 
+#endif
       !
       IF( lk_mpp    )   CALL mpp_sum( ierr )
@@ -469,9 +571,9 @@
       INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
       !!----------------------------------------------------------------------
-
+      !
       ierr = 0
-
+      !
       CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
-
+      !
       IF( nfact <= 1 ) THEN
          WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
@@ -515,5 +617,5 @@
       INTEGER, PARAMETER :: ntest = 14
       INTEGER :: ilfax(ntest)
-
+      !
       ! lfax contains the set of allowed factors.
       data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  &
@@ -600,16 +702,16 @@
           !loop over the other north-fold processes to find the processes
           !managing the points belonging to the sxT-dxT range
-          DO jn = jpnij - jpni +1, jpnij
-             IF ( njmppt(jn) == njmppmax ) THEN
+  
+          DO jn = 1, jpni
                 !sxT is the first point (in the global domain) of the jn
                 !process
-                sxT = nimppt(jn)
+                sxT = nfiimpp(jn, jpnj)
                 !dxT is the last point (in the global domain) of the jn
                 !process
-                dxT = nimppt(jn) + nlcit(jn) - 1
+                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
                 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
                    nsndto = nsndto + 1
-                   isendto(nsndto) = jn
-                ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN
+                     isendto(nsndto) = jn
+                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
                    nsndto = nsndto + 1
                    isendto(nsndto) = jn
@@ -618,6 +720,18 @@
                    isendto(nsndto) = jn
                 END IF
-             END IF
           END DO
+          nfsloop = 1
+          nfeloop = nlci
+          DO jn = 2,jpni-1
+           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
+              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
+                 nfsloop = nldi
+              ENDIF
+              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
+                 nfeloop = nlei
+              ENDIF
+           ENDIF
+        END DO
+
       ENDIF
       l_north_nogather = .TRUE.
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90	(revision 5682)
@@ -36,26 +36,25 @@
    PUBLIC   sbc_ssm        ! called by sbc
 
-   CHARACTER(len=100)   ::   cn_dir     = './'    !: Root directory for location of ssm files
-   LOGICAL              ::   ln_3d_uv   = .true.  !: specify whether input velocity data is 3D
-   INTEGER  , SAVE      ::   nfld_3d
-   INTEGER  , SAVE      ::   nfld_2d
-
-   INTEGER  , PARAMETER ::   jpfld_3d = 4   ! maximum number of files to read
-   INTEGER  , PARAMETER ::   jpfld_2d = 1   ! maximum number of files to read
-   INTEGER  , SAVE      ::   jf_tem         ! index of temperature
-   INTEGER  , SAVE      ::   jf_sal         ! index of salinity
-   INTEGER  , SAVE      ::   jf_usp         ! index of u velocity component
-   INTEGER  , SAVE      ::   jf_vsp         ! index of v velocity component
-   INTEGER  , SAVE      ::   jf_ssh         ! index of sea surface height
+   CHARACTER(len=100)   ::   cn_dir        !: Root directory for location of ssm files
+   LOGICAL              ::   ln_3d_uve     !: specify whether input velocity data is 3D
+   LOGICAL              ::   ln_read_frq   !: specify whether we must read frq or not
+   LOGICAL              ::   l_initdone = .false.
+   INTEGER     ::   nfld_3d
+   INTEGER     ::   nfld_2d
+
+   INTEGER     ::   jf_tem         ! index of temperature
+   INTEGER     ::   jf_sal         ! index of salinity
+   INTEGER     ::   jf_usp         ! index of u velocity component
+   INTEGER     ::   jf_vsp         ! index of v velocity component
+   INTEGER     ::   jf_ssh         ! index of sea surface height
+   INTEGER     ::   jf_e3t         ! index of first T level thickness
+   INTEGER     ::   jf_frq         ! index of fraction of qsr absorbed in the 1st T level
 
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d  ! structure of input fields (file information, fields read)
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_2d  ! structure of input fields (file information, fields read)
 
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OFF 3.3 , NEMO Consortium (2010)
-   !! $Id: sbcssm.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -86,10 +85,12 @@
       IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==!
       ! 
-      IF( ln_3d_uv ) THEN
+      IF( ln_3d_uve ) THEN
          ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
          ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
+         IF( lk_vvl )   e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity 
       ELSE
          ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
          ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
+         IF( lk_vvl )   e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity 
       ENDIF
       !
@@ -97,13 +98,14 @@
       sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1)    ! salinity
       ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height
-      !
-      tsn(:,:,1,jp_tem) = sst_m(:,:)
-      tsn(:,:,1,jp_sal) = sss_m(:,:)
+      IF( ln_read_frq )   frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height
+      !
       IF ( nn_ice == 1 ) THEN
+         tsn(:,:,1,jp_tem) = sst_m(:,:)
+         tsn(:,:,1,jp_sal) = sss_m(:,:)
          tsb(:,:,1,jp_tem) = sst_m(:,:)
          tsb(:,:,1,jp_sal) = sss_m(:,:)
       ENDIF
-      ub (:,:,1       ) = ssu_m(:,:)
-      vb (:,:,1       ) = ssv_m(:,:)
+      ub (:,:,1) = ssu_m(:,:)
+      vb (:,:,1) = ssv_m(:,:)
 
       IF(ln_ctl) THEN                  ! print control
@@ -113,4 +115,16 @@
          CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m   - : ', mask1=vmask, ovlap=1   )
          CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m   - : ', mask1=tmask, ovlap=1   )
+         IF( lk_vvl      )   CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m   - : ', mask1=tmask, ovlap=1   )
+         IF( ln_read_frq )   CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m   - : ', mask1=tmask, ovlap=1   )
+      ENDIF
+      !
+      IF( l_initdone ) THEN          !   Mean value at each nn_fsbc time-step   !
+         CALL iom_put( 'ssu_m', ssu_m )
+         CALL iom_put( 'ssv_m', ssv_m )
+         CALL iom_put( 'sst_m', sst_m )
+         CALL iom_put( 'sss_m', sss_m )
+         CALL iom_put( 'ssh_m', ssh_m )
+         IF( lk_vvl      )   CALL iom_put( 'e3t_m', e3t_m )
+         IF( ln_read_frq )   CALL iom_put( 'frq_m', frq_m )
       ENDIF
       !
@@ -138,8 +152,11 @@
       TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_2d       ! array of namelist information on the fields to read
       TYPE(FLD_N) :: sn_tem, sn_sal                     ! information about the fields to be read
-      TYPE(FLD_N) :: sn_usp, sn_vsp, sn_ssh
-      !
-      NAMELIST/namsbc_sas/cn_dir, ln_3d_uv, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh
-      !!----------------------------------------------------------------------
+      TYPE(FLD_N) :: sn_usp, sn_vsp
+      TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq
+      !
+      NAMELIST/namsbc_sas/cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq
+      !!----------------------------------------------------------------------
+      
+      IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN
       
       REWIND( numnam_ref )              ! Namelist namsbc_sas in reference namelist : Input fields
@@ -159,7 +176,8 @@
          WRITE(numout,*) '~~~~~~~~~~~ '
          WRITE(numout,*) '   Namelist namsbc_sas'
+         WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve
+         WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq
          WRITE(numout,*)
       ENDIF
-      
       !
       !! switch off stuff that isn't sensible with a standalone module
@@ -170,8 +188,4 @@
          ln_apr_dyn = .FALSE.
       ENDIF
-      IF( ln_dm2dc ) THEN
-         IF( lwp ) WRITE(numout,*) 'No diurnal cycle needed with StandAlone Surface scheme'
-         ln_dm2dc = .FALSE.
-      ENDIF
       IF( ln_rnf ) THEN
          IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme'
@@ -190,23 +204,22 @@
          nn_closea = 0
       ENDIF
-
       ! 
       !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and
       !! when we have other 3d arrays that we need to read in
       !! so if a new field is added i.e. jf_new, just give it the next integer in sequence
-      !! for the corresponding dimension (currently if ln_3d_uv is true, 4 for 2d and 3 for 3d,
-      !! alternatively if ln_3d_uv is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,
+      !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d,
+      !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,
       !! and the rest of the logic should still work
       !
-      jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3
-      !
-      IF( ln_3d_uv ) THEN
-         jf_usp = 1 ; jf_vsp = 2
-         nfld_3d  = 2
-         nfld_2d  = 3
+      jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 ; jf_frq = 4   ! default 2D fields index
+      !
+      IF( ln_3d_uve ) THEN
+         jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3      ! define 3D fields index
+         nfld_3d  = 2 + COUNT( (/lk_vvl/) )        ! number of 3D fields to read
+         nfld_2d  = 3 + COUNT( (/ln_read_frq/) )   ! number of 2D fields to read
       ELSE
-         jf_usp = 4 ; jf_vsp = 5
-         nfld_3d  = 0
-         nfld_2d  = 5
+         jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/lk_vvl/) )   ! update 2D fields index
+         nfld_3d  = 0                                                              ! no 3D fields to read
+         nfld_2d  = 5 + COUNT( (/lk_vvl/) ) + COUNT( (/ln_read_frq/) )             ! number of 2D fields to read
       ENDIF
 
@@ -216,8 +229,7 @@
             CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' )   ;   RETURN
          ENDIF
-         IF( ln_3d_uv ) THEN
-            slf_3d(jf_usp) = sn_usp
-            slf_3d(jf_vsp) = sn_vsp
-         ENDIF
+         slf_3d(jf_usp) = sn_usp
+         slf_3d(jf_vsp) = sn_vsp
+         IF( lk_vvl )   slf_3d(jf_e3t) = sn_e3t
       ENDIF
 
@@ -228,9 +240,12 @@
          ENDIF
          slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh
-         IF( .NOT. ln_3d_uv ) THEN
+         IF( ln_read_frq )   slf_2d(jf_frq) = sn_frq
+         IF( .NOT. ln_3d_uve ) THEN
             slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp
-         ENDIF
-      ENDIF
-      !
+            IF( lk_vvl )   slf_2d(jf_e3t) = sn_e3t
+         ENDIF
+      ENDIF
+      !
+      ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false. 
       IF( nfld_3d > 0 ) THEN
          ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure
@@ -265,23 +280,12 @@
       ENDIF
       !
-      ! lim code currently uses surface temperature and salinity in tsn array for initialisation
-      ! and ub, vb arrays in ice dynamics
-      ! so allocate enough of arrays to use
-      !
-      ierr3 = 0
-      jpm = MAX(jp_tem, jp_sal)
-      ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 )
-      ALLOCATE( ub(jpi,jpj,1)     , STAT=ierr1 )
-      ALLOCATE( vb(jpi,jpj,1)     , STAT=ierr2 )
-      IF ( nn_ice == 1 ) ALLOCATE( tsb(jpi,jpj,1,jpm), STAT=ierr3 )
-      ierr = ierr0 + ierr1 + ierr2 + ierr3
-      IF( ierr > 0 ) THEN
-         CALL ctl_stop('sbc_ssm_init: unable to allocate surface arrays')
-      ENDIF
-      !
       ! finally tidy up
 
       IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr )
       IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr )
+
+      CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in limistate
+      IF( .NOT. ln_read_frq )   frq_m(:,:) = 1.
+      l_initdone = .TRUE.
       !
    END SUBROUTINE sbc_ssm_init
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/step.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/step.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/step.F90	(revision 5682)
@@ -17,4 +17,6 @@
    USE dom_oce          ! ocean space and time domain variables 
    USE in_out_manager   ! I/O manager
+   USE sbc_oce
+   USE sbccpl
    USE iom              !
    USE lbclnk
@@ -36,4 +38,9 @@
    USE timing           ! Timing            
 
+   USE bdy_par          ! clem: mandatory for LIM3
+#if defined key_bdy
+   USE bdydta           ! clem: mandatory for LIM3
+#endif
+
    IMPLICIT NONE
    PRIVATE
@@ -46,5 +53,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: step.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -72,11 +79,19 @@
       kstp = nit000 + Agrif_Nb_Step()
 # if defined key_iomput
-      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( "nemo" )
+      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context )
 # endif   
 #endif   
-      IF( kstp == nit000 )   CALL iom_init( "nemo" )       ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
+      IF( kstp == nit000 )   CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
       IF( kstp /= nit000 )   CALL day( kstp )             ! Calendar (day was already called at nit000 in day_init)
-                             CALL iom_setkt( kstp, "nemo" )       ! say to iom that we are at time step kstp
+                             CALL iom_setkt( kstp - nit000 + 1, cxios_context )   ! tell iom we are at time step kstp
 
+      ! ==> clem: open boundaries is mandatory for LIM3 because ice BDY is not decoupled from  
+      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.
+      !           From SAS: ocean bdy data are wrong  (but we do not care) and ice bdy data are OK.  
+      !           This is not clean and should be changed in the future. 
+#if defined key_bdy
+      IF( lk_bdy     )       CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries
+#endif
+      ! ==>
                              CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
 
@@ -86,6 +101,13 @@
                                                           ! need to keep the same interface 
                              CALL stp_ctl( kstp, indic )
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Coupled mode
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( lk_oasis    )  CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges if OASIS-coupled ice
+
 #if defined key_iomput
-      IF( kstp == nitend )   CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF
+      IF( kstp == nitend .OR. indic < 0 ) THEN 
+                             CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
+      ENDIF
 #endif
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/stpctl.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/stpctl.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/stpctl.F90	(revision 5682)
@@ -28,5 +28,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: stpctl.F90 3294 2012-01-28 16:44:18Z rblod $
+   !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/C14b/trcice_c14b.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/C14b/trcice_c14b.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/C14b/trcice_c14b.F90	(revision 5682)
@@ -0,0 +1,47 @@
+MODULE trcice_c14b
+   !!======================================================================
+   !!                         ***  MODULE trcice_c14b  ***
+   !!======================================================================
+#if defined key_c14b
+   !!----------------------------------------------------------------------
+   !!   'key_c14b'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !! trc_ice_c14b       : 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_c14b       ! called by trcice.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcice_c14b.F90 4990 2014-12-15 16:42:49Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ice_ini_c14b
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ice_c14b  ***
+      !!
+      !!----------------------------------------------------------------------
+      !
+      !
+   END SUBROUTINE trc_ice_ini_c14b
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MY_TRC model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ice_ini_c14b             ! Empty routine
+   END SUBROUTINE trc_ice_ini_c14b
+#endif
+
+   !!======================================================================
+END MODULE trcice_c14b
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90	(revision 5682)
@@ -54,5 +54,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90	(revision 5682)
@@ -6,5 +6,5 @@
    !! History :   1.0  !  2009-05 (C. Ethe)  Original code
    !!----------------------------------------------------------------------
-#if defined key_top && key_c14b && defined key_iomput
+#if defined key_top && defined key_c14b && defined key_iomput
    !!----------------------------------------------------------------------
    !!   'key_c14b'                                           c14b model
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90	(revision 5682)
@@ -0,0 +1,53 @@
+MODULE trcice_cfc
+   !!======================================================================
+   !!                         ***  MODULE trcice_cfc  ***
+   !! TOP :   Main module of the MY_TRC tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!----------------------------------------------------------------------
+#if defined key_cfc
+   !!----------------------------------------------------------------------
+   !!   'key_cfc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !! trc_ice_cfc       : 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_cfc       ! called by trcice.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcice_cfc.F90 4990 2014-12-15 16:42:49Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ice_ini_cfc
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ice_cfc  ***
+      !!
+      !! ** Purpose :   main routine of MY_TRC model
+      !!
+      !! ** Method  : -
+      !!----------------------------------------------------------------------
+      !
+      !
+   END SUBROUTINE trc_ice_ini_cfc
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MY_TRC model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ice_ini_cfc             ! Empty routine
+   END SUBROUTINE trc_ice_ini_cfc
+#endif
+
+   !!======================================================================
+END MODULE trcice_cfc
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90	(revision 5682)
@@ -6,5 +6,5 @@
    !! History :   1.0  !  2009-05 (C. Ethe)  Original code
    !!----------------------------------------------------------------------
-#if defined key_top && key_cfc && defined key_iomput
+#if defined key_top && defined key_cfc && defined key_iomput
    !!----------------------------------------------------------------------
    !!   'key_cfc'                                           cfc model
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90	(revision 5682)
@@ -0,0 +1,46 @@
+MODULE trcice_my_trc
+   !!======================================================================
+   !!                         ***  MODULE trcice_my_trc  ***
+   !!----------------------------------------------------------------------
+#if defined key_my_trc
+   !!----------------------------------------------------------------------
+   !!   'key_my_trc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !! trc_ice_my_trc       : 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_my_trc       ! called by trcice.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcice_my_trc.F90 4990 2014-12-15 16:42:49Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ice_ini_my_trc
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ice_my_trc  ***
+      !!
+      !!----------------------------------------------------------------------
+      !
+      !
+   END SUBROUTINE trc_ice_ini_my_trc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MY_TRC model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ice_ini_my_trc             ! Empty routine
+   END SUBROUTINE trc_ice_ini_my_trc
+#endif
+
+   !!======================================================================
+END MODULE trcice_my_trc
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90	(revision 5682)
@@ -42,8 +42,12 @@
 
       IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' trc_ini_my_trc: initialisation of MY_TRC model'
+      IF(lwp) WRITE(numout,*) ' trc_ini_my_trc: passive tracer unit vector'
+      IF(lwp) WRITE(numout,*) ' To check conservation : '
+      IF(lwp) WRITE(numout,*) '   1 - No sea-ice model '
+      IF(lwp) WRITE(numout,*) '   2 - No runoff ' 
+      IF(lwp) WRITE(numout,*) '   3 - precipitation and evaporation equal to 1 : E=P=1 ' 
       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
       
-      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 0.
+      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 1.
       !
    END SUBROUTINE trc_ini_my_trc
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 5682)
@@ -46,5 +46,5 @@
       INTEGER ::   jn   ! dummy loop index
       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrmyt
-!!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('trc_sms_my_trc')
@@ -55,10 +55,4 @@
 
       IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt )
-
-      WHERE( (glamt <= 170) .AND. (glamt >= 160) .AND. (gphit <= -74) .AND. (gphit >=-75.6) )
-        trn(:,:,1,jpmyt1) = 1._wp
-        trb(:,:,1,jpmyt1) = 1._wp
-        tra(:,:,1,jpmyt1) = 0._wp
-      END WHERE
 
       IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90	(revision 5682)
@@ -6,5 +6,5 @@
    !! History :   1.0  !  2009-05 (C. Ethe)  Original code
    !!----------------------------------------------------------------------
-#if defined key_top && key_my_trc && defined key_iomput
+#if defined key_top && defined key_my_trc && defined key_iomput
    !!----------------------------------------------------------------------
    !!   'key_my_trc'                                           my_trc model
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90	(revision 5682)
@@ -63,5 +63,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p2zbio.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -599,3 +599,3 @@
 
    !!======================================================================
-END MODULE  p2zbio
+END MODULE p2zbio
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90	(revision 5682)
@@ -45,5 +45,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: trcexp.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90	(revision 5682)
@@ -44,5 +44,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: trcopt.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -89,5 +89,8 @@
 
       !                                          ! surface irradiance
-      zpar0m (:,:)   = qsr   (:,:) * 0.43        ! ------------------
+      !                                          ! ------------------
+      IF( ln_dm2dc ) THEN   ;   zpar0m(:,:) = qsr_mean(:,:) * 0.43
+      ELSE                  ;   zpar0m(:,:) = qsr     (:,:) * 0.43
+      ENDIF
       zpar100(:,:)   = zpar0m(:,:) * 0.01
       zparr  (:,:,1) = zpar0m(:,:) * 0.5
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90	(revision 5682)
@@ -38,5 +38,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p2z_sed.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90	(revision 5682)
@@ -32,5 +32,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p2zsms.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -84,3 +84,3 @@
 
    !!======================================================================
-END MODULE  p2zsms
+END MODULE p2zsms
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90	(revision 5682)
@@ -44,5 +44,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_bio ( kt, jnt )
+   SUBROUTINE p4z_bio ( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_bio  ***
@@ -54,10 +54,6 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kt, jnt
-      INTEGER  ::  ji, jj, jk, jn
-      REAL(wp) ::  ztra
-#if defined key_kriest
-      REAL(wp) ::  zcoef1, zcoef2
-#endif
+      INTEGER, INTENT(in) :: kt, knt
+      INTEGER             :: ji, jj, jk, jn
       CHARACTER (len=25) :: charout
 
@@ -80,54 +76,21 @@
 
           
-      CALL p4z_opt  ( kt, jnt )     ! Optic: PAR in the water column
-      CALL p4z_sink ( kt, jnt )     ! vertical flux of particulate organic matter
-      CALL p4z_fechem(kt, jnt )     ! Iron chemistry/scavenging
-      CALL p4z_lim  ( kt, jnt )     ! co-limitations by the various nutrients
-      CALL p4z_prod ( kt, jnt )     ! phytoplankton growth rate over the global ocean. 
+      CALL p4z_opt  ( kt, knt )     ! Optic: PAR in the water column
+      CALL p4z_sink ( kt, knt )     ! vertical flux of particulate organic matter
+      CALL p4z_fechem(kt, knt )     ! Iron chemistry/scavenging
+      CALL p4z_lim  ( kt, knt )     ! co-limitations by the various nutrients
+      CALL p4z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean. 
       !                             ! (for each element : C, Si, Fe, Chl )
       CALL p4z_mort ( kt      )     ! phytoplankton mortality
-      !                             ! zooplankton sources/sinks routines 
-      CALL p4z_micro( kt, jnt )           ! microzooplankton
-      CALL p4z_meso ( kt, jnt )           ! mesozooplankton
-      CALL p4z_rem  ( kt, jnt )     ! remineralization terms of organic matter+scavenging of Fe
+     !                             ! zooplankton sources/sinks routines 
+      CALL p4z_micro( kt, knt )           ! microzooplankton
+      CALL p4z_meso ( kt, knt )           ! mesozooplankton
+      CALL p4z_rem  ( kt, knt )     ! remineralization terms of organic matter+scavenging of Fe
       !                             ! test if tracers concentrations fall below 0.
-      xnegtr(:,:,:) = 1.e0
-      DO jn = jp_pcs0, jp_pcs1
-         DO jk = 1, jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF( ( trn(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
-                     ztra             = ABS( trn(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
-
-                     xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra )
-                  ENDIF
-              END DO
-            END DO
-         END DO
-      END DO
-      !                                ! where at least 1 tracer concentration becomes negative
-      !                                ! 
-      DO jn = jp_pcs0, jp_pcs1
-         trn(:,:,:,jn) = trn(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
-      END DO
-
-
-      tra(:,:,:,:) = 0.e0
-
-#if defined key_kriest
-      ! 
-      zcoef1 = 1.e0 / xkr_massp 
-      zcoef2 = 1.e0 / xkr_massp / 1.1
-      DO jk = 1,jpkm1
-         trn(:,:,jk,jpnum) = MAX(  trn(:,:,jk,jpnum), trn(:,:,jk,jppoc) * zcoef1 / xnumm(jk)  )
-         trn(:,:,jk,jpnum) = MIN(  trn(:,:,jk,jpnum), trn(:,:,jk,jppoc) * zcoef2              )
-      END DO
-#endif
-
-      !
+      !                                                             !
       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('bio ')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
       ENDIF
       !
@@ -146,4 +109,3 @@
 
    !!======================================================================
-END MODULE  p4zbio
-
+END MODULE p4zbio
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90	(revision 5682)
@@ -168,5 +168,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p4zche.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -396,3 +396,3 @@
 
    !!======================================================================
-END MODULE  p4zche
+END MODULE p4zche
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90	(revision 5682)
@@ -48,5 +48,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_fechem( kt, jnt )
+   SUBROUTINE p4z_fechem( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_fechem  ***
@@ -62,5 +62,5 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
       !
       INTEGER  ::   ji, jj, jk, jic
@@ -101,5 +101,5 @@
       ! -------------------------------------------------
       IF( ln_ligvar ) THEN
-         ztotlig(:,:,:) =  0.09 * trn(:,:,:,jpdoc) * 1E6 + ligand * 1E9
+         ztotlig(:,:,:) =  0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9
          ztotlig(:,:,:) =  MIN( ztotlig(:,:,:), 10. )
       ELSE
@@ -127,5 +127,5 @@
                   zionic = 19.9201 * tsn(ji,jj,jk,jp_sal) / ( 1000. - 1.00488 * tsn(ji,jj,jk,jp_sal) + rtrn )
                   zph    = -LOG10( MAX( hi(ji,jj,jk), rtrn) )
-                  zoxy   = trn(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 )
+                  zoxy   = trb(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 )
                   ! Fe2+ oxydation rate from Santana-Casiano et al. (2005)
                   zkox   = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tsn(ji,jj,jk,jp_tem) + 273.15 )  &
@@ -137,5 +137,5 @@
                   zkph1 = zkph2 / 5.
                   ! pass the dfe concentration from PISCES
-                  ztfe = trn(ji,jj,jk,jpfer) * 1e9
+                  ztfe = trb(ji,jj,jk,jpfer) * 1e9
                   ! ----------------------------------------------------------
                   ! ANALYTICAL SOLUTION OF ROOTS OF THE FE3+ EQUATION
@@ -204,5 +204,5 @@
                   zkeq           = fekeq(ji,jj,jk)
                   zfesatur       = zTL1(ji,jj,jk) * 1E-9
-                  ztfe           = trn(ji,jj,jk,jpfer) 
+                  ztfe           = trb(ji,jj,jk,jpfer) 
                   ! Fe' is the root of a 2nd order polynom
                   zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               &
@@ -210,5 +210,5 @@
                      &               + 4. * ztfe * zkeq) ) / ( 2. * zkeq )
                   zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9
-                  zFeL1(ji,jj,jk) = MAX( 0., trn(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) )
+                  zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) )
               END DO
             END DO
@@ -240,7 +240,7 @@
                ENDIF
 #if defined key_kriest
-               ztrc   = ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi) ) * 1.e6 
+               ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 
 #else
-               ztrc   = ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi) ) * 1.e6 
+               ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 
 #endif
                IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) ! dust in kg/m2/s
@@ -251,7 +251,7 @@
                ! to later allocate scavenged iron to the different organic pools
                ! ---------------------------------------------------------
-               zdenom1 = xlam1 * trn(ji,jj,jk,jppoc) / zlam1b
+               zdenom1 = xlam1 * trb(ji,jj,jk,jppoc) / zlam1b
 #if ! defined key_kriest
-               zdenom2 = xlam1 * trn(ji,jj,jk,jpgoc) / zlam1b
+               zdenom2 = xlam1 * trb(ji,jj,jk,jpgoc) / zlam1b
 #endif
 
@@ -262,6 +262,6 @@
                zlamfac = MIN( 1.  , zlamfac )
                zdep    = MIN( 1., 1000. / fsdept(ji,jj,jk) )
-               zlam1b  = xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) )
-               zcoag   = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trn(ji,jj,jk,jpfer)
+               zlam1b  = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) )
+               zcoag   = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer)
 
                !  Compute the coagulation of colloidal iron. This parameterization 
@@ -269,6 +269,6 @@
                !  It requires certainly some more work as it is very poorly constrained.
                !  ----------------------------------------------------------------
-               zlam1a  = ( 0.369  * 0.3 * trn(ji,jj,jk,jpdoc) + 102.4  * trn(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
-                   &   + ( 114.   * 0.3 * trn(ji,jj,jk,jpdoc) + 5.09E3 * trn(ji,jj,jk,jppoc) )
+               zlam1a  = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
+                   &   + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) + 5.09E3 * trb(ji,jj,jk,jppoc) )
                zaggdfea = zlam1a * zstep * zfecoll
 #if defined key_kriest
@@ -278,5 +278,5 @@
                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea + zaggdfeb
 #else
-               zlam1b = 3.53E3 *   trn(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
+               zlam1b = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
                zaggdfeb = zlam1b * zstep * zfecoll
                !
@@ -292,12 +292,12 @@
       !  ----------------------------------------
       IF( ln_fechem ) THEN
-          biron(:,:,:) = MAX( 0., trn(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 )
+          biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 )
       ELSE
-          biron(:,:,:) = trn(:,:,:,jpfer) 
+          biron(:,:,:) = trb(:,:,:,jpfer) 
       ENDIF
 
       !  Output of some diagnostics variables
       !     ---------------------------------
-      IF( lk_iomput .AND. jnt == nrdttrc ) THEN
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
          IF( iom_use("Fe3")    )  CALL iom_put("Fe3"    , zFe3   (:,:,:)       * tmask(:,:,:) )   ! Fe3+
          IF( iom_use("FeL1")   )  CALL iom_put("FeL1"   , zFeL1  (:,:,:)       * tmask(:,:,:) )   ! FeL1
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90	(revision 5682)
@@ -63,10 +63,10 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p4zflx.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE p4z_flx ( kt )
+   SUBROUTINE p4z_flx ( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_flx  ***
@@ -81,5 +81,5 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) ::   kt   !
+      INTEGER, INTENT(in) ::   kt, knt   !
       !
       INTEGER  ::   ji, jj, jm, iind, iindm1
@@ -101,5 +101,5 @@
       !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2
 
-      IF( kt /= nit000 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs
+      IF( kt /= nit000 .AND. knt == 1 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs
 
       IF( ln_co2int ) THEN 
@@ -130,7 +130,7 @@
                zbot  = borat(ji,jj,1)
                zfact = rhop(ji,jj,1) / 1000. + rtrn
-               zdic  = trn(ji,jj,1,jpdic) / zfact
+               zdic  = trb(ji,jj,1,jpdic) / zfact
                zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact
-               zalka = trn(ji,jj,1,jptal) / zfact
+               zalka = trb(ji,jj,1,jptal) / zfact
 
                ! CALCULATE [ALK]([CO3--], [HCO3-])
@@ -184,13 +184,13 @@
             zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)   ! (mol/L) * (m/s)
             zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ?
-            oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000.
+            oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000.
             ! compute the trend
-            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1)
+            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / fse3t(ji,jj,1)
 
             ! Compute O2 flux 
             zfld16 = atcox * patm(ji,jj) * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s)
-            zflu16 = trn(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj)
+            zflu16 = trb(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj)
             zoflx(ji,jj) = zfld16 - zflu16
-            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) / fse3t(ji,jj,1)
+            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / fse3t(ji,jj,1)
          END DO
       END DO
@@ -207,8 +207,8 @@
       ENDIF
 
-      IF( lk_iomput ) THEN
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
          CALL wrk_alloc( jpi, jpj, zw2d )  
          IF( iom_use( "Cflx"  ) )  THEN
-            zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) / rfact
+            zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r
             CALL iom_put( "Cflx"     , zw2d ) 
          ENDIF
@@ -226,5 +226,5 @@
          ENDIF
          IF( iom_use( "Dpo2" ) )  THEN
-           zw2d(:,:) = ( atcox * patm(:,:) - trn(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1)
+           zw2d(:,:) = ( atcox * patm(:,:) - trb(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1)
            CALL iom_put( "Dpo2"  , zw2d )
          ENDIF
@@ -235,5 +235,5 @@
       ELSE
          IF( ln_diatrc ) THEN
-            trc2d(:,:,jp_pcs0_2d    ) = oce_co2(:,:) / e1e2t(:,:) / rfact 
+            trc2d(:,:,jp_pcs0_2d    ) = oce_co2(:,:) / e1e2t(:,:) * rfact2r 
             trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1) 
             trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1) 
@@ -400,3 +400,3 @@
 
    !!======================================================================
-END MODULE  p4zflx
+END MODULE p4zflx
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90	(revision 5682)
@@ -26,5 +26,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p4zint.F90 3294 2012-01-28 16:44:18Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -56,5 +56,5 @@
       DO ji = 1, jpi
          DO jj = 1, jpj
-            zvar = trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil)
+            zvar = trb(ji,jj,1,jpsil) * trb(ji,jj,1,jpsil)
             xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 )
          END DO
@@ -81,3 +81,3 @@
 
    !!======================================================================
-END MODULE  p4zint
+END MODULE p4zint
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90	(revision 5682)
@@ -62,5 +62,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_lim( kt, jnt )
+   SUBROUTINE p4z_lim( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_lim  ***
@@ -72,10 +72,10 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in)  :: kt, jnt
+      INTEGER, INTENT(in)  :: kt, knt
       !
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zlim1, zlim2, zlim3, zlim4, zno3, zferlim
       REAL(wp) ::   zconcd, zconcd2, zconcn, zconcn2
-      REAL(wp) ::   z1_trndia, z1_trnphy, ztem1, ztem2, zetot1, zetot2
+      REAL(wp) ::   z1_trbdia, z1_trbphy, ztem1, ztem2, zetot1, zetot2
       REAL(wp) ::   zdenom, zratio, zironmin
       REAL(wp) ::   zconc1d, zconc1dnh4, zconc0n, zconc0nnh4   
@@ -90,37 +90,37 @@
                ! Tuning of the iron concentration to a minimum level that is set to the detection limit
                !-------------------------------------
-               zno3    = trn(ji,jj,jk,jpno3) / 40.e-6
+               zno3    = trb(ji,jj,jk,jpno3) / 40.e-6
                zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 )
                zferlim = MIN( zferlim, 7e-11 )
-               trn(ji,jj,jk,jpfer) = MAX( trn(ji,jj,jk,jpfer), zferlim )
+               trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim )
 
                ! Computation of a variable Ks for iron on diatoms taking into account
                ! that increasing biomass is made of generally bigger cells
                !------------------------------------------------
-               zconcd   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia )
-               zconcd2  = trn(ji,jj,jk,jpdia) - zconcd
-               zconcn   = MAX( 0.e0 , trn(ji,jj,jk,jpphy) - xsizephy )
-               zconcn2  = trn(ji,jj,jk,jpphy) - zconcn
-               z1_trnphy   = 1. / ( trn(ji,jj,jk,jpphy) + rtrn )
-               z1_trndia   = 1. / ( trn(ji,jj,jk,jpdia) + rtrn )
-
-               concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trndia )
-               zconc1d           = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trndia )
-               zconc1dnh4        = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trndia )
-
-               concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trnphy )
-               zconc0n           = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trnphy )
-               zconc0nnh4        = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trnphy )
+               zconcd   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
+               zconcd2  = trb(ji,jj,jk,jpdia) - zconcd
+               zconcn   = MAX( 0.e0 , trb(ji,jj,jk,jpphy) - xsizephy )
+               zconcn2  = trb(ji,jj,jk,jpphy) - zconcn
+               z1_trbphy   = 1. / ( trb(ji,jj,jk,jpphy) + rtrn )
+               z1_trbdia   = 1. / ( trb(ji,jj,jk,jpdia) + rtrn )
+
+               concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia )
+               zconc1d           = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia )
+               zconc1dnh4        = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia )
+
+               concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy )
+               zconc0n           = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy )
+               zconc0nnh4        = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy )
 
                ! Michaelis-Menten Limitation term for nutrients Small bacteria
                ! -------------------------------------------------------------
-               zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * trn(ji,jj,jk,jpno3) + concbno3 * trn(ji,jj,jk,jpnh4) )
-               xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concbnh4 * zdenom
-               xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * concbno3 * zdenom
+               zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * trb(ji,jj,jk,jpno3) + concbno3 * trb(ji,jj,jk,jpnh4) )
+               xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * concbnh4 * zdenom
+               xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * concbno3 * zdenom
                !
                zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk)
-               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concbnh4 )
-               zlim3    = trn(ji,jj,jk,jpfer) / ( concbfe + trn(ji,jj,jk,jpfer) )
-               zlim4    = trn(ji,jj,jk,jpdoc) / ( xkdoc   + trn(ji,jj,jk,jpdoc) )
+               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbnh4 )
+               zlim3    = trb(ji,jj,jk,jpfer) / ( concbfe + trb(ji,jj,jk,jpfer) )
+               zlim4    = trb(ji,jj,jk,jpdoc) / ( xkdoc   + trb(ji,jj,jk,jpdoc) )
                xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 )
                xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4
@@ -128,12 +128,12 @@
                ! Michaelis-Menten Limitation term for nutrients Small flagellates
                ! -----------------------------------------------
-               zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trn(ji,jj,jk,jpno3) + zconc0n * trn(ji,jj,jk,jpnh4) )
-               xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom
-               xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc0n    * zdenom
+               zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trb(ji,jj,jk,jpno3) + zconc0n * trb(ji,jj,jk,jpnh4) )
+               xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom
+               xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc0n    * zdenom
                !
                zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk)
-               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc0nnh4 )
-               zratio   = trn(ji,jj,jk,jpnfe) * z1_trnphy 
-               zironmin = xcoef1 * trn(ji,jj,jk,jpnch) * z1_trnphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk)
+               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc0nnh4 )
+               zratio   = trb(ji,jj,jk,jpnfe) * z1_trbphy 
+               zironmin = xcoef1 * trb(ji,jj,jk,jpnch) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk)
                zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim )
                xnanopo4(ji,jj,jk) = zlim2
@@ -143,13 +143,13 @@
                !   Michaelis-Menten Limitation term for nutrients Diatoms
                !   ----------------------------------------------
-               zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trn(ji,jj,jk,jpno3) + zconc1d * trn(ji,jj,jk,jpnh4) )
-               xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom
-               xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc1d    * zdenom
+               zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trb(ji,jj,jk,jpno3) + zconc1d * trb(ji,jj,jk,jpnh4) )
+               xdiatno3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom
+               xdiatnh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc1d    * zdenom
                !
                zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk)
-               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc1dnh4  )
-               zlim3    = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi(ji,jj) )
-               zratio   = trn(ji,jj,jk,jpdfe) * z1_trndia
-               zironmin = xcoef1 * trn(ji,jj,jk,jpdch) * z1_trndia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk)
+               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc1dnh4  )
+               zlim3    = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) )
+               zratio   = trb(ji,jj,jk,jpdfe) * z1_trbdia
+               zironmin = xcoef1 * trb(ji,jj,jk,jpdch) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk)
                zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim )
                xdiatpo4(ji,jj,jk) = zlim2
@@ -166,16 +166,16 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zlim1 =  ( trn(ji,jj,jk,jpno3) * concnnh4 + trn(ji,jj,jk,jpnh4) * concnno3 )    &
-                  &   / ( concnno3 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + concnno3 * trn(ji,jj,jk,jpnh4) ) 
-               zlim2  = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4 )
-               zlim3  = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) +  5.E-11   )
+               zlim1 =  ( trb(ji,jj,jk,jpno3) * concnnh4 + trb(ji,jj,jk,jpnh4) * concnno3 )    &
+                  &   / ( concnno3 * concnnh4 + concnnh4 * trb(ji,jj,jk,jpno3) + concnno3 * trb(ji,jj,jk,jpnh4) ) 
+               zlim2  = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnnh4 )
+               zlim3  = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) +  5.E-11   )
                ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) )
                ztem2  = tsn(ji,jj,jk,jp_tem) - 10.
-               zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) 
-               zetot2 = 30. / ( 30. + etot(ji,jj,jk) ) 
+               zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) ) 
+               zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) ) 
 
                xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  &
                   &                       * ztem1 / ( 0.1 + ztem1 )                     &
-                  &                       * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. )  &
+                  &                       * MAX( 1., trb(ji,jj,jk,jpphy) * 1.e6 / 2. )  &
                   &                       * zetot1 * zetot2               &
                   &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         &
@@ -188,5 +188,5 @@
       !
       !
-      IF( lk_iomput .AND. jnt == nrdttrc ) THEN        ! save output diagnostics
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN        ! save output diagnostics
         IF( iom_use( "xfracal" ) ) CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht
         IF( iom_use( "LNnut"   ) ) CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
@@ -265,3 +265,3 @@
 
    !!======================================================================
-END MODULE  p4zlim
+END MODULE p4zlim
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90	(revision 5682)
@@ -48,5 +48,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_lys( kt )
+   SUBROUTINE p4z_lys( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_lys  ***
@@ -59,10 +59,9 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) ::   kt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
       INTEGER  ::   ji, jj, jk, jn
       REAL(wp) ::   zalk, zdic, zph, zah2
       REAL(wp) ::   zdispot, zfact, zcalcon, zalka, zaldi
       REAL(wp) ::   zomegaca, zexcess, zexcess0
-      REAL(wp) ::   zrfact2
       CHARACTER (len=25) :: charout
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss   
@@ -89,6 +88,6 @@
                   zfact = rhop(ji,jj,jk) / 1000. + rtrn
                   zph  = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+]
-                  zdic  = trn(ji,jj,jk,jpdic) / zfact
-                  zalka = trn(ji,jj,jk,jptal) / zfact
+                  zdic  = trb(ji,jj,jk,jpdic) / zfact
+                  zalka = trb(ji,jj,jk,jptal) / zfact
                   ! CALCULATE [ALK]([CO3--], [HCO3-])
                   zalk  = zalka - ( akw3(ji,jj,jk) / zph - zph + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) )
@@ -130,5 +129,5 @@
                !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE
                !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION)
-               zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal)
+               zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal)
 # if defined key_degrad
                zdispot = zdispot * facvol(ji,jj,jk)
@@ -136,6 +135,6 @@
               !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3],
               !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION
-              zcaldiss(ji,jj,jk)  = zdispot / rmtss  ! calcite dissolution
-              zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) * rfact
+              zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution
+              zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk)
               !
               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk)
@@ -147,9 +146,9 @@
       !
 
-      IF( lk_iomput ) THEN
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
          IF( iom_use( "PH"     ) ) CALL iom_put( "PH"    , -1. * LOG10( hi(:,:,:) )          * tmask(:,:,:) )
          IF( iom_use( "CO3"    ) ) CALL iom_put( "CO3"   , zco3(:,:,:) * 1.e+3               * tmask(:,:,:) )
          IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", aksp(:,:,:) * 1.e+3 / calcon      * tmask(:,:,:) )
-         IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) )
+         IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r   * tmask(:,:,:) )
       ELSE
          trc3d(:,:,:,jp_pcs0_3d    ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:)
@@ -224,3 +223,3 @@
 #endif 
    !!======================================================================
-END MODULE  p4zlys
+END MODULE p4zlys
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90	(revision 5682)
@@ -60,5 +60,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_meso( kt, jnt )
+   SUBROUTINE p4z_meso( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_meso  ***
@@ -68,5 +68,5 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
       INTEGER  :: ji, jj, jk
       REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam
@@ -97,5 +97,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zcompam   = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )
+               zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )
 # if defined key_degrad
                zstep     = xstep * facvol(ji,jj,jk)
@@ -107,5 +107,5 @@
                !  Respiration rates of both zooplankton
                !  -------------------------------------
-               zrespz2   = resrat2 * zfact * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) )  &
+               zrespz2   = resrat2 * zfact * trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  &
                   &      + resrat2 * zfact * 3. * nitrfac(ji,jj,jk)
 
@@ -113,14 +113,14 @@
                !  no real reason except that it seems to be more stable and may mimic predation
                !  ---------------------------------------------------------------
-               ztortz2   = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes)
+               ztortz2   = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes)
                !
-               zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )
-               zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )
+               zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )
+               zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )
                ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone
                ! it is to predation by mesozooplankton
                ! -------------------------------------------------------------------------------
-               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) &
+               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) &
                   &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) )
-               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )
+               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )
 
                zfood     = xprefc * zcompadi + xprefz * zcompaz + xprefp * zcompaph + xprefpoc * zcompapoc 
@@ -128,5 +128,5 @@
                zdenom    = zfoodlim / ( xkgraz2 + zfoodlim )
                zdenom2   = zdenom / ( zfood + rtrn )
-               zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpmes) 
+               zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) 
 
                zgrazd    = zgraze2  * xprefc   * zcompadi  * zdenom2 
@@ -135,7 +135,7 @@
                zgrazpoc  = zgraze2  * xprefpoc * zcompapoc * zdenom2 
 
-               zgraznf   = zgrazn   * trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn)
-               zgrazf    = zgrazd   * trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn)
-               zgrazpof  = zgrazpoc * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn)
+               zgraznf   = zgrazn   * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn)
+               zgrazf    = zgrazd   * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn)
+               zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn)
 
                !  Mesozooplankton flux feeding on GOC
@@ -144,10 +144,10 @@
 # if ! defined key_kriest
                zgrazffeg = grazflux  * zstep * wsbio4(ji,jj,jk)      &
-               &           * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)
-               zgrazfffg = zgrazffeg * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)
+               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)
+               zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
 # endif
                zgrazffep = grazflux  * zstep *  wsbio3(ji,jj,jk)     &
-               &           * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)
-               zgrazfffp = zgrazffep * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)
+               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes)
+               zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
               !
 # if ! defined key_kriest
@@ -158,10 +158,10 @@
               ! diatoms based aggregates are more prone to fractionation
               ! since they are more porous (marine snow instead of fecal pellets)
-              zratio    = trn(ji,jj,jk,jpgsi) / ( trn(ji,jj,jk,jpgoc) + rtrn )
+              zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn )
               zratio2   = zratio * zratio
               zfrac     = zproport * grazflux  * zstep * wsbio4(ji,jj,jk)      &
-               &          * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)          &
+               &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          &
                &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) )
-              zfracfe   = zfrac * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)
+              zfracfe   = zfrac * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
 
               zgrazffep = zproport * zgrazffep
@@ -215,8 +215,8 @@
                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz
                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn
-               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trn(ji,jj,jk,jpnch) / ( trn(ji,jj,jk,jpphy) + rtrn )
-               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn )
+               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf
                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf
@@ -231,5 +231,5 @@
                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
 #if defined key_kriest
-              znumpoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )
+              znumpoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )
               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortzgoc - zgrazpoc - zgrazffep + zgrapoc2
               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc + zgrapoc2 * xkr_dmeso      &
@@ -248,5 +248,5 @@
       END DO
       !
-      IF( lk_iomput .AND. jnt == nrdttrc ) THEN
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
          CALL wrk_alloc( jpi, jpj, jpk, zw3d )
          IF( iom_use( "GRAZ2" ) ) THEN
@@ -340,3 +340,3 @@
 
    !!======================================================================
-END MODULE  p4zmeso
+END MODULE p4zmeso
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90	(revision 5682)
@@ -59,5 +59,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_micro( kt, jnt )
+   SUBROUTINE p4z_micro( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_micro  ***
@@ -68,5 +68,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::  kt  ! ocean time step
-      INTEGER, INTENT(in) ::  jnt 
+      INTEGER, INTENT(in) ::  knt 
       !
       INTEGER  :: ji, jj, jk
@@ -90,5 +90,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )
+               zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )
                zstep   = xstep
 # if defined key_degrad
@@ -99,5 +99,5 @@
                !  Respiration rates of both zooplankton
                !  -------------------------------------
-               zrespz = resrat * zfact * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) )  &
+               zrespz = resrat * zfact * trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) )  &
                   &   + resrat * zfact * 3. * nitrfac(ji,jj,jk)
 
@@ -105,9 +105,9 @@
                !  no real reason except that it seems to be more stable and may mimic predation.
                !  ---------------------------------------------------------------
-               ztortz = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo)
-
-               zcompadi  = MIN( MAX( ( trn(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )
-               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )
-               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 )
+               ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo)
+
+               zcompadi  = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )
+               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )
+               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 )
                
                !     Microzooplankton grazing
@@ -117,5 +117,5 @@
                zdenom    = zfoodlim / ( xkgraz + zfoodlim )
                zdenom2   = zdenom / ( zfood + rtrn )
-               zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpzoo) 
+               zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) 
 
                zgrazp    = zgraze  * xpref2p * zcompaph  * zdenom2 
@@ -123,7 +123,7 @@
                zgrazsd   = zgraze  * xpref2d * zcompadi  * zdenom2 
 
-               zgrazpf   = zgrazp  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)
-               zgrazmf   = zgrazm  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)
-               zgrazsf   = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)
+               zgrazpf   = zgrazp  * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn)
+               zgrazmf   = zgrazm  * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
+               zgrazsf   = zgrazsd * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn)
                !
                zgraztot  = zgrazp  + zgrazm  + zgrazsd 
@@ -165,8 +165,8 @@
                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp
                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd
-               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp  * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn)
-               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn)
-               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trn(ji,jj,jk,jpdsi)/(trn(ji,jj,jk,jpdia)+rtrn)
-               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trn(ji,jj,jk,jpdsi)/(trn(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp  * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
+               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf
                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf
@@ -184,5 +184,5 @@
 #if defined key_kriest
                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zmortz * xkr_dmicro &
-                                                         - zgrazm * trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )
+                                                         - zgrazm * trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )
 #endif
             END DO
@@ -190,5 +190,5 @@
       END DO
       !
-      IF( lk_iomput .AND. jnt == nrdttrc ) THEN
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
          CALL wrk_alloc( jpi, jpj, jpk, zw3d )
          IF( iom_use( "GRAZ1" ) ) THEN
@@ -273,3 +273,3 @@
 
    !!======================================================================
-END MODULE  p4zmicro
+END MODULE p4zmicro
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90	(revision 5682)
@@ -39,5 +39,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: p4zmort.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -85,5 +85,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )
+               zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )
                zstep    = xstep
 # if defined key_degrad
@@ -94,5 +94,5 @@
                !     due to turbulence is negligible. Mortality is also set
                !     to 0
-               zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trn(ji,jj,jk,jpphy)
+               zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trb(ji,jj,jk,jpphy)
                !     Squared mortality of Phyto similar to a sedimentation term during
                !     blooms (Doney et al. 1996)
@@ -102,5 +102,5 @@
                !     increased when nutrients are limiting phytoplankton growth
                !     as observed for instance in case of iron limitation.
-               ztortp = mprat * xstep * zcompaph / ( xkmort + trn(ji,jj,jk,jpphy) ) * zsizerat
+               ztortp = mprat * xstep * zcompaph / ( xkmort + trb(ji,jj,jk,jpphy) ) * zsizerat
 
                zmortp = zrespp + ztortp
@@ -108,6 +108,6 @@
                !   Update the arrays TRA which contains the biological sources and sinks
 
-               zfactfe = trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+rtrn)
-               zfactch = trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn)
+               zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn)
+               zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp
                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch
@@ -172,5 +172,5 @@
             DO ji = 1, jpi
 
-               zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1e-9), 0. )
+               zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1e-9), 0. )
 
                !    Aggregation term for diatoms is increased in case of nutrient
@@ -186,9 +186,9 @@
                zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
                zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
-               zrespp2 = 1.e6 * zstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia)
+               zrespp2 = 1.e6 * zstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia)
 
                !     Phytoplankton mortality. 
                !     ------------------------
-               ztortp2 = mprat2 * zstep * trn(ji,jj,jk,jpdia)  / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 
+               ztortp2 = mprat2 * zstep * trb(ji,jj,jk,jpdia)  / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi 
 
                zmortp2 = zrespp2 + ztortp2
@@ -196,7 +196,7 @@
                !   Update the arrays tra which contains the biological sources and sinks
                !   ---------------------------------------------------------------------
-               zfactch = trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn )
-               zfactfe = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )
-               zfactsi = trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
+               zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2 
                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch
@@ -277,3 +277,3 @@
 
    !!======================================================================
-END MODULE  p4zmort
+END MODULE p4zmort
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90	(revision 5682)
@@ -35,4 +35,5 @@
    REAL(wp) :: parlux      !: Fraction of shortwave as PAR
    REAL(wp) :: xparsw                 !: parlux/3
+   REAL(wp) :: xsi0r                 !:  1. /rn_si0
 
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_par      ! structure of input par
@@ -42,5 +43,7 @@
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat   !: PAR for phyto, nano and diat 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy      !: PAR over 24h in case of diurnal cycle
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy           !: averaged PAR in the mixed layer
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr  !: wavelength (Red-Green-Blue)
 
    INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m)
@@ -57,5 +60,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_opt( kt, jnt )
+   SUBROUTINE p4z_opt( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_opt  ***
@@ -67,12 +70,12 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) ::   kt, jnt   ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step
       !
       INTEGER  ::   ji, jj, jk
       INTEGER  ::   irgb
-      REAL(wp) ::   zchl, zxsi0r
+      REAL(wp) ::   zchl
       REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp, zetmp1, zetmp2
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zekg, zekr, zekb, ze0, ze1, ze2, ze3
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr100
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3
       !!---------------------------------------------------------------------
       !
@@ -80,15 +83,14 @@
       !
       ! Allocate temporary workspace
-      CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2 ) 
-      CALL wrk_alloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 )
-
-      IF( jnt == 1 .AND. ln_varpar ) CALL p4z_optsbc( kt )
+      CALL wrk_alloc( jpi, jpj,      zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+      CALL wrk_alloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 )
+
+      IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt )
 
       !     Initialisation of variables used to compute PAR
       !     -----------------------------------------------
-      ze1(:,:,jpk) = 0._wp
-      ze2(:,:,jpk) = 0._wp
-      ze3(:,:,jpk) = 0._wp
-
+      ze1(:,:,:) = 0._wp
+      ze2(:,:,:) = 0._wp
+      ze3(:,:,:) = 0._wp
       !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
       DO jk = 1, jpkm1                         !  --------------------------------------------------------
@@ -97,103 +99,59 @@
 !CDIR NOVERRCHK
             DO ji = 1, jpi
-               zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6
+               zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e6
                zchl = MIN(  10. , MAX( 0.05, zchl )  )
                irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn )
                !                                                         
-               zekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)
-               zekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)
-               zekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk)
+               ekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)
+               ekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)
+               ekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk)
             END DO
          END DO
       END DO
-
-
       !                                        !* Photosynthetically Available Radiation (PAR)
       !                                        !  --------------------------------------
-
-      IF( ln_varpar ) THEN
-         ze1(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekb(:,:,1) )
-         ze2(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekg(:,:,1) )
-         ze3(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekr(:,:,1) )
+      IF( l_trcdm2dc ) THEN                     !  diurnal cycle
+         ! 1% of qsr to compute euphotic layer
+         zqsr100(:,:) = 0.01 * qsr_mean(:,:)     !  daily mean qsr
+         !
+         CALL p4z_opt_par( kt, qsr_mean, ze1, ze2, ze3 ) 
+         !
+         DO jk = 1, nksrp      
+            etot_ndcy(:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk)
+            enano    (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
+            ediat    (:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
+         END DO
+         !
+         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 ) 
+         !
+         DO jk = 1, nksrp      
+            etot(:,:,jk) =  ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
+         END DO
+         !
       ELSE
-         ze1(:,:,1) = xparsw         * qsr(:,:) * EXP( -0.5 * zekb(:,:,1) )
-         ze2(:,:,1) = xparsw         * qsr(:,:) * EXP( -0.5 * zekg(:,:,1) )
-         ze3(:,:,1) = xparsw         * qsr(:,:) * EXP( -0.5 * zekr(:,:,1) )
-      ENDIF
-
-!CDIR NOVERRCHK
-      DO jj = 1, jpj
-!CDIR NOVERRCHK
-         DO ji = 1, jpi
-            zc1 = ze1(ji,jj,1)
-            zc2 = ze2(ji,jj,1) 
-            zc3 = ze3(ji,jj,1)
-            etot (ji,jj,1) = (       zc1 +        zc2 +       zc3 )
-            enano(ji,jj,1) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 )
-            ediat(ji,jj,1) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 )
-         END DO
-      END DO
-
-    
-      DO jk = 2, nksrp      
-!CDIR NOVERRCHK
-         DO jj = 1, jpj
-!CDIR NOVERRCHK
-            DO ji = 1, jpi
-               zc1 = ze1(ji,jj,jk-1) * EXP( -0.5 * ( zekb(ji,jj,jk-1) + zekb(ji,jj,jk) ) )
-               zc2 = ze2(ji,jj,jk-1) * EXP( -0.5 * ( zekg(ji,jj,jk-1) + zekg(ji,jj,jk) ) )
-               zc3 = ze3(ji,jj,jk-1) * EXP( -0.5 * ( zekr(ji,jj,jk-1) + zekr(ji,jj,jk) ) )
-               ze1  (ji,jj,jk) = zc1
-               ze2  (ji,jj,jk) = zc2
-               ze3  (ji,jj,jk) = zc3
-               etot (ji,jj,jk) = (       zc1 +        zc2 +       zc3 )
-               enano(ji,jj,jk) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 )
-               ediat(ji,jj,jk) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 )
-            END DO
-         END DO
-      END DO
+         ! 1% of qsr to compute euphotic layer
+         zqsr100(:,:) = 0.01 * qsr(:,:)
+         !
+         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 ) 
+         !
+         DO jk = 1, nksrp      
+            etot (:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk)
+            enano(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
+            ediat(:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
+         END DO
+         etot_ndcy(:,:,:) =  etot(:,:,:) 
+      ENDIF
+
 
       IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics)
          !                                     !  ------------------------
-         zxsi0r = 1.e0 / rn_si0
-         !
-         ze0(:,:,1) = rn_abs * qsr(:,:)
-         !                                                    ! surface value : separation in R-G-B + near surface
-         IF( ln_varpar ) THEN
-            ze0(:,:,1) = ( 1. - 3. * par_varsw(:,:) ) * qsr(:,:)
-            ze1(:,:,1) = par_varsw(:,:)               * qsr(:,:)         
-            ze2(:,:,1) = par_varsw(:,:)               * qsr(:,:)
-            ze3(:,:,1) = par_varsw(:,:)               * qsr(:,:)
-         ELSE
-            ze0(:,:,1) = ( 1. - 3. * xparsw )  * qsr(:,:)
-            ze1(:,:,1) = xparsw                * qsr(:,:)         
-            ze2(:,:,1) = xparsw                * qsr(:,:)
-            ze3(:,:,1) = xparsw                * qsr(:,:)
-         ENDIF
+         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 )
+         !
          etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1)
-         !
-         !
          DO jk = 2, nksrp + 1
-!CDIR NOVERRCHK
-            DO jj = 1, jpj
-!CDIR NOVERRCHK
-               DO ji = 1, jpi
-                  zc0 = ze0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * zxsi0r )
-                  zc1 = ze1(ji,jj,jk-1) * EXP( -zekb(ji,jj,jk-1 ) )
-                  zc2 = ze2(ji,jj,jk-1) * EXP( -zekg(ji,jj,jk-1 ) )
-                  zc3 = ze3(ji,jj,jk-1) * EXP( -zekr(ji,jj,jk-1 ) )
-                  ze0(ji,jj,jk) = zc0
-                  ze1(ji,jj,jk) = zc1
-                  ze2(ji,jj,jk) = zc2
-                  ze3(ji,jj,jk) = zc3
-                  etot3(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk)
-              END DO
-              !
-            END DO
-            !
-        END DO
-        !
-      ENDIF
-
+            etot3(:,:,jk) =  ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk)
+         END DO
+         !                                     !  ------------------------
+      ENDIF
       !                                        !* Euphotic depth and level
       neln(:,:) = 1                            !  ------------------------
@@ -203,7 +161,7 @@
          DO jj = 1, jpj
            DO ji = 1, jpi
-              IF( etot(ji,jj,jk) * tmask(ji,jj,jk) >= 0.0043 * qsr(ji,jj) )  THEN
+              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.43 * zqsr100(ji,jj) )  THEN
                  neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer
-                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mxl_trc_zint
+                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
                  heup(ji,jj) = fsdepw(ji,jj,jk+1)      ! Euphotic layer depth
               ENDIF
@@ -211,12 +169,12 @@
         END DO
       END DO
- 
+      !
       heup(:,:) = MIN( 300., heup(:,:) )
-
       !                                        !* mean light over the mixed layer
       zdepmoy(:,:)   = 0.e0                    !  -------------------------------
-      zetmp  (:,:)   = 0.e0
       zetmp1 (:,:)   = 0.e0
       zetmp2 (:,:)   = 0.e0
+      zetmp3 (:,:)   = 0.e0
+      zetmp4 (:,:)   = 0.e0
 
       DO jk = 1, nksrp
@@ -226,7 +184,8 @@
             DO ji = 1, jpi
                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
-                  zetmp  (ji,jj) = zetmp  (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk)
-                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk)
-                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk)
+                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * fse3t(ji,jj,jk) ! remineralisation
+                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * fse3t(ji,jj,jk) ! production
+                  zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * fse3t(ji,jj,jk) ! production
+                  zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * fse3t(ji,jj,jk) ! production
                   zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk)
                ENDIF
@@ -235,5 +194,6 @@
       END DO
       !
-      emoy(:,:,:) = etot(:,:,:)
+      emoy(:,:,:) = etot(:,:,:)       ! remineralisation
+      zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle 
       !
       DO jk = 1, nksrp
@@ -244,26 +204,28 @@
                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
                   z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
-                  emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep
-                  enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep
-                  ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep
+                  emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep
+                  zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep
+                  enano(ji,jj,jk) = zetmp3(ji,jj) * z1_dep
+                  ediat(ji,jj,jk) = zetmp4(ji,jj) * z1_dep
                ENDIF
             END DO
          END DO
       END DO
-
+      !
       IF( lk_iomput ) THEN
-        IF( jnt == nrdttrc  ) THEN
-           IF( iom_use( "Heup" ) ) CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht
-           IF( iom_use( "PAR"  ) ) CALL iom_put( "PAR" , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
+        IF( knt == nrdttrc ) THEN
+           IF( iom_use( "Heup"  ) ) CALL iom_put( "Heup" , heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht
+           IF( iom_use( "PARDM" ) ) CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
+           IF( iom_use( "PAR"   ) ) CALL iom_put( "PAR"  , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
         ENDIF
       ELSE
          IF( ln_diatrc ) THEN        ! save output diagnostics
-            trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)  
+            trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)
             trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:)
          ENDIF
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2 )
-      CALL wrk_dealloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 )
+      CALL wrk_dealloc( jpi, jpj,      zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zpar,  ze0, ze1, ze2, ze3 )
       !
       IF( nn_timing == 1 )  CALL timing_stop('p4z_opt')
@@ -271,7 +233,75 @@
    END SUBROUTINE p4z_opt
 
-   SUBROUTINE p4z_optsbc( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine p4z_optsbc  ***
+   SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0 ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  routine p4z_opt_par  ***
+      !!
+      !! ** purpose :   compute PAR of each wavelength (Red-Green-Blue)
+      !!                for a given shortwave radiation
+      !!
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT(in)                                       ::  kt            !   ocean time-step
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in)              ::  pqsr          !   shortwave
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::  pe1 , pe2 , pe3   !  PAR ( R-G-B)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL ::  pe0  
+      !! * local variables
+      INTEGER    ::   ji, jj, jk     ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj)     ::  zqsr          !   shortwave
+      !!----------------------------------------------------------------------
+
+      !  Real shortwave
+      IF( ln_varpar ) THEN  ;  zqsr(:,:) = par_varsw(:,:) * pqsr(:,:)
+      ELSE                  ;  zqsr(:,:) = xparsw         * pqsr(:,:)
+      ENDIF
+      !
+      IF( PRESENT( pe0 ) ) THEN     !  W-level
+         !
+         pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:)    !   ( 1 - 3 * alpha ) * q
+         pe1(:,:,1) = zqsr(:,:)         
+         pe2(:,:,1) = zqsr(:,:)
+         pe3(:,:,1) = zqsr(:,:)
+         !
+         DO jk = 2, nksrp + 1
+!CDIR NOVERRCHK
+            DO jj = 1, jpj
+!CDIR NOVERRCHK
+               DO ji = 1, jpi
+                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * xsi0r )
+                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) )
+                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) )
+                  pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr(ji,jj,jk-1 ) )
+               END DO
+              !
+            END DO
+            !
+         END DO
+        !
+      ELSE   ! T- level
+        !
+        pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) )
+        pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) )
+        pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) )
+        !
+        DO jk = 2, nksrp      
+!CDIR NOVERRCHK
+           DO jj = 1, jpj
+!CDIR NOVERRCHK
+              DO ji = 1, jpi
+                 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) )
+                 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) )
+                 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) )
+              END DO
+           END DO
+        END DO    
+        !
+      ENDIF
+      ! 
+   END SUBROUTINE p4z_opt_par
+
+
+   SUBROUTINE p4z_opt_sbc( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine p4z_opt_sbc  ***
       !!
       !! ** purpose :   read and interpolate the variable PAR fraction
@@ -284,5 +314,5 @@
       !!----------------------------------------------------------------------
       !! * arguments
-      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      INTEGER ,                INTENT(in) ::   kt     ! ocean time step
 
       !! * local declarations
@@ -297,5 +327,5 @@
          IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN
             CALL fld_read( kt, 1, sf_par )
-            par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) )/3.0
+            par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0
          ENDIF
       ENDIF
@@ -303,5 +333,5 @@
       IF( nn_timing == 1 )  CALL timing_stop('p4z_optsbc')
       !
-   END SUBROUTINE p4z_optsbc
+   END SUBROUTINE p4z_opt_sbc
 
    SUBROUTINE p4z_opt_init
@@ -347,4 +377,5 @@
       !
       xparsw = parlux / 3.0
+      xsi0r  = 1.e0 / rn_si0
       !
       ! Variable PAR at the surface of the ocean
@@ -372,8 +403,12 @@
       IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m'
       !
-                         etot (:,:,:) = 0._wp
-                         enano(:,:,:) = 0._wp
-                         ediat(:,:,:) = 0._wp
-      IF( ln_qsr_bio )   etot3(:,:,:) = 0._wp
+                         ekr      (:,:,:) = 0._wp
+                         ekb      (:,:,:) = 0._wp
+                         ekg      (:,:,:) = 0._wp
+                         etot     (:,:,:) = 0._wp
+                         etot_ndcy(:,:,:) = 0._wp
+                         enano    (:,:,:) = 0._wp
+                         ediat    (:,:,:) = 0._wp
+      IF( ln_qsr_bio )   etot3    (:,:,:) = 0._wp
       ! 
       IF( nn_timing == 1 )  CALL timing_stop('p4z_opt_init')
@@ -386,5 +421,7 @@
       !!                     ***  ROUTINE p4z_opt_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( enano(jpi,jpj,jpk), ediat(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 
+      ALLOCATE( ekb(jpi,jpj,jpk)      , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk),   &
+        &       enano(jpi,jpj,jpk)    , ediat(jpi,jpj,jpk), &
+        &       etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 
          !
       IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.')
@@ -402,3 +439,3 @@
 
    !!======================================================================
-END MODULE  p4zopt
+END MODULE p4zopt
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90	(revision 5682)
@@ -64,5 +64,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_prod( kt , jnt )
+   SUBROUTINE p4z_prod( kt , knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_prod  ***
@@ -74,5 +74,5 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) :: kt, jnt
+      INTEGER, INTENT(in) :: kt, knt
       !
       INTEGER  ::   ji, jj, jk
@@ -129,19 +129,17 @@
       END DO
 
-      IF( ln_newprod ) THEN
-         ! Impact of the day duration on phytoplankton growth
-         DO jk = 1, jpkm1
-            DO jj = 1 ,jpj
-               DO ji = 1, jpi
-                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
-                     zval = MAX( 1., zstrn(ji,jj) )
-                     zval = 1.5 * zval / ( 12. + zval )
-                     zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval
-                     zprdia(ji,jj,jk) = zprbio(ji,jj,jk)
-                  ENDIF
-               END DO
-            END DO
-         END DO
-      ENDIF
+      ! Impact of the day duration on phytoplankton growth
+      DO jk = 1, jpkm1
+         DO jj = 1 ,jpj
+            DO ji = 1, jpi
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                  zval = MAX( 1., zstrn(ji,jj) )
+                  zval = 1.5 * zval / ( 12. + zval )
+                  zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval
+                  zprdia(ji,jj,jk) = zprbio(ji,jj,jk)
+               ENDIF
+            END DO
+         END DO
+      END DO
 
       ! Maximum light intensity
@@ -157,17 +155,17 @@
                DO ji = 1, jpi
                   ! Computation of the P-I slope for nanos and diatoms
-                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                       ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
                       zadap       = xadap * ztn / ( 2.+ ztn )
-                      zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia )
-                      zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp
+                      zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
+                      zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp
                       znanotot    = enano(ji,jj,jk) * zstrn(ji,jj)
                       zdiattot    = ediat(ji,jj,jk) * zstrn(ji,jj)
                       !
                       zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap  * EXP( -znanotot ) )  &
-                         &                   * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn)
+                         &                   * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn)
                       !
-                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn )   &
-                         &                   * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn)
+                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )   &
+                         &                   * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn)
 
                       ! Computation of production function for Carbon
@@ -196,30 +194,32 @@
 
                   ! Computation of the P-I slope for nanos and diatoms
-                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                       ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
                       zadap       = ztn / ( 2.+ ztn )
-                      zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia )
-                      zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp
+                      zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
+                      zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp
+                      znanotot    = enano(ji,jj,jk) * zstrn(ji,jj)
+                      zdiattot    = ediat(ji,jj,jk) * zstrn(ji,jj)
                       !
-                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * EXP( -0.21 * enano(ji,jj,jk) ) )
-                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp)  / ( trn(ji,jj,jk,jpdia) + rtrn )
-
-                      zpislopen =  zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch)                &
-                        &          / ( trn(ji,jj,jk,jpphy) * 12.                  + rtrn )   &
+                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * EXP( -znanotot ) )
+                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp)  / ( trb(ji,jj,jk,jpdia) + rtrn )
+
+                      zpislopen =  zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch)                &
+                        &          / ( trb(ji,jj,jk,jpphy) * 12.                  + rtrn )   &
                         &          / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
 
-                      zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)                &
-                        &          / ( trn(ji,jj,jk,jpdia) * 12.                  + rtrn )   &
+                      zpislope2n = zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch)                &
+                        &          / ( trb(ji,jj,jk,jpdia) * 12.                  + rtrn )   &
                         &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
 
                       ! Computation of production function for Carbon
                       !  ---------------------------------------------
-                      zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) )
-                      zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) )
+                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot ) )
+                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) )
 
                       !  Computation of production function for Chlorophyll
                       !--------------------------------------------------
-                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) * zstrn(ji,jj) ) )
-                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj) ) )
+                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) )
+                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) )
                   ENDIF
                END DO
@@ -252,5 +252,5 @@
             DO ji = 1, jpi
 
-                IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                    !    Si/C of diatoms
                    !    ------------------------
@@ -258,8 +258,8 @@
                    !    Si/C is arbitrariliy increased for very high Si concentrations
                    !    to mimic the very high ratios observed in the Southern Ocean (silpot2)
-                  zlim  = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 )
+                  zlim  = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 )
                   zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
                   zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0
-                  zsiborn = trn(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil)
+                  zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil)
                   IF (gphit(ji,jj) < -30 ) THEN
                     zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
@@ -302,10 +302,10 @@
 !CDIR NOVERRCHK
             DO ji = 1, jpi
-               IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                   !  production terms for nanophyto.
-                  zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2
+                  zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2
                   zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
                   !
-                  zratio = trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn )
+                  zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn )
                   zratio = zratio / fecnm 
                   zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
@@ -313,10 +313,10 @@
                   &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    &
                   &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  &
-                  &             * zmax * trn(ji,jj,jk,jpphy) * rfact2
+                  &             * zmax * trb(ji,jj,jk,jpphy) * rfact2
                   !  production terms for diatomees
-                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2
+                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2
                   zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn )
                   !
-                  zratio = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )
+                  zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )
                   zratio = zratio / fecdm 
                   zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
@@ -324,5 +324,5 @@
                   &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    &
                   &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  &
-                  &             * zmax * trn(ji,jj,jk,jpdia) * rfact2
+                  &             * zmax * trb(ji,jj,jk,jpdia) * rfact2
                ENDIF
             END DO
@@ -341,5 +341,5 @@
                      zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj)
                   ENDIF
-                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                      !  production terms for nanophyto. ( chlorophyll )
                      znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
@@ -365,17 +365,17 @@
 !CDIR NOVERRCHK
                DO ji = 1, jpi
-                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                      !  production terms for nanophyto. ( chlorophyll )
-                     znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
-                     zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trn(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk)
+                     znanotot = enano(ji,jj,jk)
+                     zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trb(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk)
                      zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk)
                      zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 144. * zprod            &
-                     &                    / ( zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) * znanotot +rtrn )
+                     &                    / ( zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch) * znanotot +rtrn )
                      !  production terms for diatomees ( chlorophyll )
-                     zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
-                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trn(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk)
+                     zdiattot = ediat(ji,jj,jk)
+                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trb(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk)
                      zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk)
                      zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 144. * zprod             &
-                     &                    / ( zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zdiattot +rtrn )
+                     &                    / ( zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch) * zdiattot +rtrn )
                   ENDIF
                END DO
@@ -414,9 +414,9 @@
 
     ! Total primary production per year
-    IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. jnt == nrdttrc )  )  &
+    IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  &
          & tpp = glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
 
     IF( lk_iomput ) THEN
-       IF( jnt == nrdttrc ) THEN
+       IF( knt == nrdttrc ) THEN
           CALL wrk_alloc( jpi, jpj,      zw2d )
           CALL wrk_alloc( jpi, jpj, jpk, zw3d )
@@ -629,3 +629,3 @@
 
    !!======================================================================
-END MODULE  p4zprod
+END MODULE p4zprod
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90	(revision 5682)
@@ -59,5 +59,5 @@
 CONTAINS
 
-   SUBROUTINE p4z_rem( kt, jnt )
+   SUBROUTINE p4z_rem( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_rem  ***
@@ -68,5 +68,5 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
       !
       INTEGER  ::   ji, jj, jk
@@ -104,5 +104,5 @@
                zdep = MAX( hmld(ji,jj), heup(ji,jj) )
                IF( fsdept(ji,jj,jk) < zdep ) THEN
-                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trn(ji,jj,jk,jpzoo) + 2.* trn(ji,jj,jk,jpmes) ), 4.e-6 )
+                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 )
                   ztempbac(ji,jj)   = zdepbac(ji,jj,jk)
                ELSE
@@ -119,6 +119,6 @@
             DO ji = 1, jpi
                ! denitrification factor computed from O2 levels
-               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trn(ji,jj,jk,jpoxy) )    &
-                  &                                / ( oxymin + trn(ji,jj,jk,jpoxy) )  )
+               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trb(ji,jj,jk,jpoxy) )    &
+                  &                                / ( oxymin + trb(ji,jj,jk,jpoxy) )  )
                nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )
             END DO
@@ -140,10 +140,10 @@
                ! Ammonification in oxic waters with oxygen consumption
                ! -----------------------------------------------------
-               zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc) 
-               zolimi(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) 
+               zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 
+               zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) 
                ! Ammonification in suboxic waters with denitrification
                ! -------------------------------------------------------
-               denitr(ji,jj,jk)  = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   &
-                  &                     zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  )
+               denitr(ji,jj,jk)  = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit,   &
+                  &                     zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  )
                !
                zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) )
@@ -165,6 +165,6 @@
                ! below 2 umol/L. Inhibited at strong light 
                ! ----------------------------------------------------------
-               zonitr  =nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) ) 
-               denitnh4(ji,jj,jk) = nitrif * zstep * trn(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 
+               zonitr  =nitrif * zstep * trb(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) ) 
+               denitnh4(ji,jj,jk) = nitrif * zstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 
                ! Update of the tracers trends
                ! ----------------------------
@@ -192,5 +192,5 @@
                ! ----------------------------------------------------------
                zbactfer = 10.e-6 *  rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk)             &
-                  &              * trn(ji,jj,jk,jpfer) / ( 2.5E-10 + trn(ji,jj,jk,jpfer) )    &
+                  &              * trb(ji,jj,jk,jpfer) / ( 2.5E-10 + trb(ji,jj,jk,jpfer) )    &
                   &              * zdepprod(ji,jj,jk) * zdepbac(ji,jj,jk)
 #if defined key_kriest
@@ -228,11 +228,11 @@
                ! means a disaggregation constant about 0.5 the value in oxic zones
                ! -----------------------------------------------------------------
-               zorem  = zremip * trn(ji,jj,jk,jppoc)
-               zofer  = zremip * trn(ji,jj,jk,jpsfe)
+               zorem  = zremip * trb(ji,jj,jk,jppoc)
+               zofer  = zremip * trb(ji,jj,jk,jpsfe)
 #if ! defined key_kriest
-               zorem2 = zremip * trn(ji,jj,jk,jpgoc)
-               zofer2 = zremip * trn(ji,jj,jk,jpbfe)
+               zorem2 = zremip * trb(ji,jj,jk,jpgoc)
+               zofer2 = zremip * trb(ji,jj,jk,jpbfe)
 #else
-               zorem2 = zremip * trn(ji,jj,jk,jpnum)
+               zorem2 = zremip * trb(ji,jj,jk,jpnum)
 #endif
 
@@ -272,5 +272,5 @@
                ! Remineralization rate of BSi depedant on T and saturation
                ! ---------------------------------------------------------
-               zsatur   = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn )
+               zsatur   = ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn )
                zsatur   = MAX( rtrn, zsatur )
                zsatur2  = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37
@@ -287,5 +287,5 @@
                zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. )
                zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil
-               zosil    = zsiremin * trn(ji,jj,jk,jpgsi)
+               zosil    = zsiremin * trb(ji,jj,jk,jpgsi)
                !
                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil
@@ -315,5 +315,5 @@
       END DO
 
-      IF( jnt == nrdttrc ) THEN
+      IF( knt == nrdttrc ) THEN
           CALL wrk_alloc( jpi, jpj, jpk, zw3d )
           zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90	(revision 5682)
@@ -85,5 +85,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header:$ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -117,5 +117,9 @@
          IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN
             CALL fld_read( kt, 1, sf_dust )
-            dust(:,:) = sf_dust(1)%fnow(:,:,1)
+            IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN
+               dust(:,:) = sf_dust(1)%fnow(:,:,1)
+            ELSE
+               dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) )
+            ENDIF
          ENDIF
       ENDIF
@@ -136,5 +140,5 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zcoef = ryyss * cvol(ji,jj,1) 
+                  zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
                   rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    &
                      &              * 1.E3        / ( 12. * zcoef + rtrn )
@@ -187,4 +191,6 @@
       INTEGER  :: ierr, ierr1, ierr2, ierr3
       INTEGER  :: ios                 ! Local integer output status for namelist read
+      INTEGER  :: ik50                !  last level where depth less than 50 m
+      INTEGER  :: isrow             ! index for ORCA1 starting row
       REAL(wp) :: zexpide, zdenitide, zmaskt
       REAL(wp) :: ztimes_dust, ztimes_riv, ztimes_ndep 
@@ -216,4 +222,13 @@
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in configuration namelist', lwp )
       IF(lwm) WRITE ( numonp, nampissbc )
+
+      IF ( ( nn_ice_tr >= 0 ) .AND. ln_ironice ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) ' ln_ironice incompatible with nn_ice_tr = ', nn_ice_tr
+            WRITE(numout,*) ' Specify your sea ice iron concentration in nampisice instead '
+            WRITE(numout,*) ' ln_ironice is forced to .FALSE. '
+            ln_ironice = .FALSE.
+         ENDIF
+      ENDIF
 
       IF(lwp) THEN
@@ -247,4 +262,11 @@
       ENDIF
 
+      ! set the number of level over which river runoffs are applied 
+      ! online configuration : computed in sbcrnf
+      IF( lk_offline ) THEN
+        nk_rnf(:,:) = 1
+        h_rnf (:,:) = fsdept(:,:,1)
+      ENDIF
+
       ! dust input from the atmosphere
       ! ------------------------------
@@ -358,5 +380,4 @@
          rivalkinput = 0._wp
       END IF 
-
       ! nutrient input from dust
       ! ------------------------
@@ -410,5 +431,12 @@
          CALL iom_close( numiron )
          !
-         DO jk = 1, 5
+         ik50 = 5        !  last level where depth less than 50 m
+         DO jk = jpkm1, 1, -1
+            IF( gdept_1d(jk) > 50. )  ik50 = jk - 1
+         END DO
+         IF (lwp) WRITE(numout,*)
+         IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1)
+         IF (lwp) WRITE(numout,*)
+         DO jk = 1, ik50
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1
@@ -421,30 +449,7 @@
             END DO
          END DO
-         IF( cp_cfg == 'orca' .AND. jp_cfg == 2 ) THEN
-            ii0 = 176   ;   ii1 =  176        ! Southern Island : Kerguelen
-            ij0 =  37   ;   ij1 =   37  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 = 119   ;   ii1 =  119        ! South Georgia
-            ij0 =  29   ;   ij1 =   29  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 = 111   ;   ii1 =  111        ! Falklands
-            ij0 =  35   ;   ij1 =   35  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 = 168   ;   ii1 =  168        ! Crozet
-            ij0 =  40   ;   ij1 =   40  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 = 119   ;   ii1 =  119        ! South Orkney
-            ij0 =  28   ;   ij1 =   28  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 = 140   ;   ii1 =  140        ! Bouvet Island
-            ij0 =  33   ;   ij1 =   33  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 = 178   ;   ii1 =  178        ! Prince edwards
-            ij0 =  34   ;   ij1 =   34  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-            !
-            ii0 =  43   ;   ii1 =   43        ! Balleny islands
-            ij0 =  21   ;   ij1 =   21  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp  
-         ENDIF
+         !
          CALL lbc_lnk( zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
+         !
          DO jk = 1, jpk
             DO jj = 1, jpj
@@ -514,3 +519,3 @@
 
    !!======================================================================
-END MODULE  p4zsbc
+END MODULE p4zsbc
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90	(revision 5682)
@@ -21,5 +21,4 @@
    USE p4zopt          !  optical model
    USE p4zlim          !  Co-limitations of differents nutrients
-   USE p4zrem          !  Remineralisation of organic matter
    USE p4zsbc          !  External source of nutrients 
    USE p4zint          !  interpolation and computation of various fields
@@ -30,11 +29,12 @@
    PRIVATE
 
-   PUBLIC   p4z_sed   
+   PUBLIC   p4z_sed  
+   PUBLIC   p4z_sed_alloc
+ 
 
    !! * Module variables
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot    !: Nitrogen fixation 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: sdenit     !: Nitrate reduction in the sediments
    REAL(wp) :: r1_rday                  !: inverse of rday
-
-   INTEGER ::  numnit  
-
 
    !!* Substitution
@@ -42,10 +42,10 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header:$ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE p4z_sed( kt, jnt )
+   SUBROUTINE p4z_sed( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_sed  ***
@@ -58,5 +58,5 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
       INTEGER  ::   ji, jj, jk, ikt
 #if ! defined key_sed
@@ -69,25 +69,20 @@
       REAL(wp) ::  zsiloss, zcaloss, zws3, zws4, zwsc, zdep, zwstpoc
       REAL(wp) ::  ztrfer, ztrpo4, zwdust, zlight
-      REAL(wp) ::  zrdenittot, zsdenittot, znitrpottot
       !
       CHARACTER (len=25) :: charout
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpdep, zsidep, zwork1, zwork2, zwork3, zwork4
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpdep, zsidep, zwork1, zwork2, zwork3
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zdenit2d, zironice, zbureff
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zwsbio3, zwsbio4, zwscal
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: znitrpot, zirondep, zsoufer
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zirondep, zsoufer
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('p4z_sed')
       !
-      IF( kt == nittrc000 .AND. jnt == 1 )  THEN
-         r1_rday  = 1. / rday
-         IF( ln_check_mass .AND. lwp)  &
-           &  CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
-      ENDIF
+      IF( kt == nittrc000 .AND. knt == 1 )   r1_rday  = 1. / rday
       !
       ! Allocate temporary workspace
-      CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zwork4, zbureff )
+      CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
       CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
-      CALL wrk_alloc( jpi, jpj, jpk, znitrpot, zsoufer )
+      CALL wrk_alloc( jpi, jpj, jpk, zsoufer )
 
       zdenit2d(:,:) = 0.e0
@@ -96,5 +91,4 @@
       zwork2  (:,:) = 0.e0
       zwork3  (:,:) = 0.e0
-      zwork4  (:,:) = 0.e0
 
       ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al.
@@ -108,5 +102,5 @@
                zdep    = rfact2 / fse3t(ji,jj,1)
                zwflux  = fmmflx(ji,jj) / 1000._wp
-               zfminus = MIN( 0._wp, -zwflux ) * trn(ji,jj,1,jpfer) * zdep
+               zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep
                zfplus  = MAX( 0._wp, -zwflux ) * icefeinput * zdep
                zironice(ji,jj) =  zfplus + zfminus
@@ -114,7 +108,7 @@
          END DO
          !
-         trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + zironice(:,:) 
+         tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:) 
          ! 
-         IF( lk_iomput .AND. jnt == nrdttrc .AND. iom_use( "Ironice" ) )   &
+         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) )   &
             &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! iron flux from ice
          !
@@ -144,10 +138,10 @@
          END DO
          !                                              ! Iron solubilization of particles in the water column
-         trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + zpdep   (:,:)
-         trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + zsidep  (:,:)
-         trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + zirondep(:,:,:) 
+         tra(:,:,1,jppo4) = tra(:,:,1,jppo4) + zpdep   (:,:)
+         tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep  (:,:)
+         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:) 
          ! 
          IF( lk_iomput ) THEN
-            IF( jnt == nrdttrc ) THEN
+            IF( knt == nrdttrc ) THEN
                 IF( iom_use( "Irondep" ) )   &
                 &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron
@@ -167,10 +161,16 @@
       ! ----------------------------------------------------------
       IF( ln_river ) THEN
-         trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivdip(:,:) * rfact2
-         trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + rivdin(:,:) * rfact2
-         trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + rivdic(:,:) * 5.e-5 * rfact2
-         trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + rivdsi(:,:) * rfact2
-         trn(:,:,1,jpdic) = trn(:,:,1,jpdic) + rivdic(:,:) * rfact2
-         trn(:,:,1,jptal) = trn(:,:,1,jptal) + ( rivalk(:,:) - rno3 * rivdin(:,:) ) * rfact2
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, nk_rnf(ji,jj)
+                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) +  rivdip(ji,jj) * rfact2
+                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) +  rivdin(ji,jj) * rfact2
+                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) +  rivdic(ji,jj) * 5.e-5 * rfact2
+                  tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) +  rivdsi(ji,jj) * rfact2
+                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +  rivdic(ji,jj) * rfact2
+                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) +  ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2
+               ENDDO
+            ENDDO
+         ENDDO
       ENDIF
       
@@ -178,6 +178,6 @@
       ! ----------------------------------------------------------
       IF( ln_ndepo ) THEN
-         trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + nitdep(:,:) * rfact2
-         trn(:,:,1,jptal) = trn(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2
+         tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2
+         tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2
       ENDIF
 
@@ -185,7 +185,7 @@
       ! ------------------------------------------------------
       IF( ln_ironsed ) THEN
-         trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
+         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
          !
-         IF( lk_iomput .AND. jnt == nrdttrc .AND. iom_use( "Ironsed" ) )   &
+         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) )   &
             &   CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments
       ENDIF
@@ -194,7 +194,7 @@
       ! ------------------------------------------------------
       IF( ln_hydrofe ) THEN
-         trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
+         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
          !
-         IF( lk_iomput .AND. jnt == nrdttrc .AND. iom_use( "HYDR" ) )   &
+         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) )   &
             &   CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input
       ENDIF
@@ -222,12 +222,12 @@
               ikt = mbkt(ji,jj)
 # if defined key_kriest
-              zflx =    trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)    * 1E3 * 1E6 / 1E4
+              zflx =    trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)    * 1E3 * 1E6 / 1E4
 # else
-              zflx = (  trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
-                &     + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4
+              zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
+                &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4
 #endif
               zflx  = LOG10( MAX( 1E-3, zflx ) )
-              zo2   = LOG10( MAX( 10. , trn(ji,jj,ikt,jpoxy) * 1E6 ) )
-              zno3  = LOG10( MAX( 1.  , trn(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
+              zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) )
+              zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
               zdep  = LOG10( fsdepw(ji,jj,ikt+1) )
               zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    &
@@ -235,6 +235,6 @@
               zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) )
               !
-              zflx = (  trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
-                &     + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
+              zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
+                &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
               zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2
            ENDIF
@@ -251,14 +251,14 @@
                ikt = mbkt(ji,jj) 
 # if defined key_kriest
-               zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwscal (ji,jj)
-               zwork2(ji,jj) = trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)
+               zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwscal (ji,jj)
+               zwork2(ji,jj) = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)
 # else
-               zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj)
-               zwork2(ji,jj) = trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 
+               zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj)
+               zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 
 # endif
                ! For calcite, burial efficiency is made a function of saturation
                zfactcal      = MIN( excess(ji,jj,ikt), 0.2 )
                zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
-               zwork3(ji,jj) = trn(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal
+               zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal
             ENDIF
          END DO
@@ -279,23 +279,23 @@
          DO ji = 1, jpi
             ikt  = mbkt(ji,jj)
-            zdep = xstep / fse3t(ji,jj,ikt)
+            zdep = xstep / fse3t(ji,jj,ikt) 
             zws4 = zwsbio4(ji,jj) * zdep
             zwsc = zwscal (ji,jj) * zdep
 # if defined key_kriest
-            zsiloss = trn(ji,jj,ikt,jpgsi) * zws4
+            zsiloss = trb(ji,jj,ikt,jpgsi) * zws4
 # else
-            zsiloss = trn(ji,jj,ikt,jpgsi) * zwsc
+            zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc
 # endif
-            zcaloss = trn(ji,jj,ikt,jpcal) * zwsc
+            zcaloss = trb(ji,jj,ikt,jpcal) * zwsc
             !
-            trn(ji,jj,ikt,jpgsi) = trn(ji,jj,ikt,jpgsi) - zsiloss
-            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zcaloss
+            tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss
+            tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss
 #if ! defined key_sed
-            trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zsiloss * zrivsil 
+            tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil 
             zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
             zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
             zrivalk  =  1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn )
-            trn(ji,jj,ikt,jptal) =  trn(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
-            trn(ji,jj,ikt,jpdic) =  trn(ji,jj,ikt,jpdic) + zcaloss * zrivalk
+            tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
+            tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk
 #endif
          END DO
@@ -304,20 +304,20 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            ikt     = mbkt(ji,jj)
-            zdep    = xstep / fse3t(ji,jj,ikt)
+            ikt  = mbkt(ji,jj)
+            zdep = xstep / fse3t(ji,jj,ikt) 
             zws4 = zwsbio4(ji,jj) * zdep
             zws3 = zwsbio3(ji,jj) * zdep
             zrivno3 = 1. - zbureff(ji,jj)
 # if ! defined key_kriest
-            trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - trn(ji,jj,ikt,jpgoc) * zws4
-            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zws3
-            trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * zws4
-            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zws3
-            zwstpoc              =  trn(ji,jj,ikt,jpgoc) * zws4 + trn(ji,jj,ikt,jppoc) * zws3 
+            tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4 
+            tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
+            tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4
+            tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
+            zwstpoc              = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3
 # else
-            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - trn(ji,jj,ikt,jpnum) * zws4
-            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zws3
-            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zws3
-            zwstpoc = trn(ji,jj,ikt,jppoc) * zws3 
+            tra(ji,jj,ikt,jpnum) = tra(ji,jj,ikt,jpnum) - trb(ji,jj,ikt,jpnum) * zws4 
+            tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
+            tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
+            zwstpoc = trb(ji,jj,ikt,jppoc) * zws3 
 # endif
 
@@ -325,16 +325,16 @@
             ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification
             ! in the sediments and just above the sediments. Not very clever, but simpliest option.
-            zpdenit  = MIN( 0.5 * ( trn(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
+            zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
             z1pdenit = zwstpoc * zrivno3 - zpdenit
-            zolimit = MIN( ( trn(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
-            zdenitt = MIN(  0.5 * ( trn(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) )
-            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt
-            trn(ji,jj,ikt,jppo4) = trn(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt
-            trn(ji,jj,ikt,jpnh4) = trn(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt
-            trn(ji,jj,ikt,jpno3) = trn(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt)
-            trn(ji,jj,ikt,jpoxy) = trn(ji,jj,ikt,jpoxy) - zolimit * o2ut
-            trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )
-            trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt
-            zwork4(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)
+            zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
+            zdenitt = MIN(  0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) )
+            tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt
+            tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt
+            tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt
+            tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt)
+            tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut
+            tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )
+            tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt
+            sdenit(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)
 #endif
          END DO
@@ -356,7 +356,7 @@
 #endif
                ztrfer = biron(ji,jj,jk)       / ( concfediaz + biron(ji,jj,jk)       )
-               ztrpo4 = trn  (ji,jj,jk,jppo4) / ( concnnh4   + trn  (ji,jj,jk,jppo4) ) 
-               zlight =  ( 1.- EXP( -etot(ji,jj,jk) / diazolight ) ) 
-               znitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday )   &
+               ztrpo4 = trb  (ji,jj,jk,jppo4) / ( concnnh4   + trb  (ji,jj,jk,jppo4) ) 
+               zlight =  ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) 
+               nitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday )   &
                  &         *  zfact * MIN( ztrfer, ztrpo4 ) * zlight
                zsoufer(ji,jj,jk) = zlight * 2E-11 / (2E-11 + biron(ji,jj,jk))
@@ -370,39 +370,23 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zfact = znitrpot(ji,jj,jk) * nitrfix
-               trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) +             zfact
-               trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + rno3      * zfact
-               trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + o2nit     * zfact 
-               trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trn(ji,jj,jk,jppo4) ) &
-               &                     * 0.002 * trn(ji,jj,jk,jpdoc) * rfact2 / rday
-               trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday
+               zfact = nitrpot(ji,jj,jk) * nitrfix
+               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) +             zfact
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3      * zfact
+               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit     * zfact 
+               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) &
+               &                     * 0.002 * trb(ji,jj,jk,jpdoc) * xstep
+               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep
            END DO
          END DO 
       END DO
 
-      ! Global budget of N SMS : denitrification in the water column and in the sediment
-      !                          nitrogen fixation by the diazotrophs
-      ! --------------------------------------------------------------------------------
-      zrdenittot   = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
-      zsdenittot   = glob_sum ( zwork4(:,:)   * e1e2t(:,:) )
-      znitrpottot  = glob_sum ( znitrpot(:,:,:) * nitrfix              * cvol(:,:,:) )
-      zfact = 1.e+3 * rfact2r * rno3 * 14. / 1.e12 * ryyss   ! conversion molC/l/kt ----> TgN/m3/year
-      !
-      IF( ln_check_mass .AND. ( kt == nitend .AND. jnt == nrdttrc ) .AND. ( lwp )  )  &
-         &  WRITE(numnit,9100) ndastp, znitrpottot * zfact  , &
-         &                             zrdenittot  * zfact  , &
-         &                             zsdenittot  * zfact
-      !
       IF( lk_iomput ) THEN
-         IF( jnt == nrdttrc ) THEN
+         IF( knt == nrdttrc ) THEN
             zfact = 1.e+3 * rfact2r * rno3  !  conversion from molC/l/kt  to molN/m3/s
-            IF( iom_use("Nfix"   ) ) CALL iom_put( "Nfix"  , znitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) )  ! nitrogen fixation 
-            IF( iom_use("Sdenit" ) ) CALL iom_put( "Sdenit", zwork4(:,:) * zfact * tmask(:,:,1) )  ! Nitrate reduction in the sediments
-            IF( iom_use("tnfix"  ) ) CALL iom_put( "tnfix"  , znitrpottot * zfact  )               ! Global  nitrogen fixation
-            IF( iom_use("tdenit" ) ) CALL iom_put( "tdenit" , zrdenittot  * zfact  )               ! Total denitrification
+            IF( iom_use("Nfix"   ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) )  ! nitrogen fixation 
             IF( iom_use("INTNFIX") ) THEN   ! nitrogen fixation rate in ocean ( vertically integrated )
                zwork1(:,:) = 0.
                DO jk = 1, jpkm1
-                 zwork1(:,:) = zwork1(:,:) + znitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk)
+                 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk)
                ENDDO
                CALL iom_put( "INTNFIX" , zwork1 ) 
@@ -411,5 +395,5 @@
       ELSE
          IF( ln_diatrc )  &
-            &  trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
+            &  trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
       ENDIF
       !
@@ -417,10 +401,10 @@
          WRITE(charout, fmt="('sed ')")
          CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zwork4, zbureff )
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
       CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
-      CALL wrk_dealloc( jpi, jpj, jpk, znitrpot, zsoufer )
+      CALL wrk_dealloc( jpi, jpj, jpk, zsoufer )
       !
       IF( nn_timing == 1 )  CALL timing_stop('p4z_sed')
@@ -429,4 +413,16 @@
       !
    END SUBROUTINE p4z_sed
+
+
+   INTEGER FUNCTION p4z_sed_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_sed_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( nitrpot(jpi,jpj,jpk), sdenit(jpi,jpj), STAT=p4z_sed_alloc )
+      !
+      IF( p4z_sed_alloc /= 0 )   CALL ctl_warn('p4z_sed_alloc: failed to allocate arrays')
+      !
+   END FUNCTION p4z_sed_alloc
+
 
 #else
@@ -440,3 +436,3 @@
 
    !!======================================================================
-END MODULE  p4zsed
+END MODULE p4zsed
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90	(revision 5682)
@@ -79,5 +79,5 @@
    !!----------------------------------------------------------------------
 
-   SUBROUTINE p4z_sink ( kt, jnt )
+   SUBROUTINE p4z_sink ( kt, knt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_sink  ***
@@ -88,5 +88,5 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kt, jnt
+      INTEGER, INTENT(in) :: kt, knt
       INTEGER  ::   ji, jj, jk, jit
       INTEGER  ::   iiter1, iiter2
@@ -199,15 +199,15 @@
                zfact = zstep * xdiss(ji,jj,jk)
                !  Part I : Coagulation dependent on turbulence
-               zagg1 = 25.9  * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)
-               zagg2 = 4452. * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)
+               zagg1 = 25.9  * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
+               zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
 
                ! Part II : Differential settling
 
                !  Aggregation of small into large particles
-               zagg3 =  47.1 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)
-               zagg4 =  3.3  * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)
+               zagg3 =  47.1 * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
+               zagg4 =  3.3  * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
 
                zagg   = zagg1 + zagg2 + zagg3 + zagg4
-               zaggfe = zagg * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn )
+               zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn )
 
                ! Aggregation of DOC to POC : 
@@ -215,12 +215,12 @@
                ! 2nd term is shear aggregation of DOC-POC
                ! 3rd term is differential settling of DOC-POC
-               zaggdoc  = ( ( 0.369 * 0.3 * trn(ji,jj,jk,jpdoc) + 102.4 * trn(ji,jj,jk,jppoc) ) * zfact       &
-               &            + 2.4 * zstep * trn(ji,jj,jk,jppoc) ) * 0.3 * trn(ji,jj,jk,jpdoc)
+               zaggdoc  = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       &
+               &            + 2.4 * zstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc)
                ! transfer of DOC to GOC : 
                ! 1st term is shear aggregation
                ! 2nd term is differential settling 
-               zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trn(ji,jj,jk,jpgoc) * 0.3 * trn(ji,jj,jk,jpdoc)
+               zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc)
                ! tranfer of DOC to POC due to brownian motion
-               zaggdoc3 =  ( 5095. * trn(ji,jj,jk,jppoc) + 114. * 0.3 * trn(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trn(ji,jj,jk,jpdoc)
+               zaggdoc3 =  ( 5095. * trb(ji,jj,jk,jppoc) + 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trb(ji,jj,jk,jpdoc)
 
                !  Update the trends
@@ -237,9 +237,9 @@
 
      ! Total carbon export per year
-     IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. jnt == nrdttrc )  )  &
+     IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  &
         &   t_oce_co2_exp = glob_sum( ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * e1e2t(:,:) * tmask(:,:,1) )
      !
      IF( lk_iomput ) THEN
-       IF( jnt == nrdttrc ) THEN
+       IF( knt == nrdttrc ) THEN
           CALL wrk_alloc( jpi, jpj,      zw2d )
           CALL wrk_alloc( jpi, jpj, jpk, zw3d )
@@ -328,5 +328,5 @@
    !!----------------------------------------------------------------------
 
-   SUBROUTINE p4z_sink ( kt, jnt )
+   SUBROUTINE p4z_sink ( kt, knt )
       !!---------------------------------------------------------------------
       !!                ***  ROUTINE p4z_sink  ***
@@ -338,5 +338,5 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER, INTENT(in) :: kt, jnt
+      INTEGER, INTENT(in) :: kt, knt
       !
       INTEGER  :: ji, jj, jk, jit, niter1, niter2
@@ -373,5 +373,5 @@
             DO ji = 1, jpi
                IF( tmask(ji,jj,jk) /= 0.e0 ) THEN
-                  znum = trn(ji,jj,jk,jppoc) / ( trn(ji,jj,jk,jpnum) + rtrn ) / xkr_massp
+                  znum = trb(ji,jj,jk,jppoc) / ( trb(ji,jj,jk,jpnum) + rtrn ) / xkr_massp
                   ! -------------- To avoid sinking speed over 50 m/day -------
                   znum  = MIN( xnumm(jk), znum )
@@ -435,5 +435,5 @@
                IF( tmask(ji,jj,jk) /= 0.e0 ) THEN
 
-                  znum = trn(ji,jj,jk,jppoc)/(trn(ji,jj,jk,jpnum)+rtrn) / xkr_massp
+                  znum = trb(ji,jj,jk,jppoc)/(trb(ji,jj,jk,jpnum)+rtrn) / xkr_massp
                   !-------------- To avoid sinking speed over 50 m/day -------
                   znum  = min(xnumm(jk),znum)
@@ -453,10 +453,10 @@
                   !    ----------------------------------------------
 
-                  zagg1 =  0.163 * trn(ji,jj,jk,jpnum)**2               &
+                  zagg1 =  0.163 * trb(ji,jj,jk,jpnum)**2               &
                      &            * 2.*( (zfm-1.)*(zfm*xkr_mass_max**3-xkr_mass_min**3)    &
                      &            * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min)    &
                      &            * (zfm*xkr_mass_max**2-xkr_mass_min**2)                  &
                      &            * (zeps-1.)**2/(zdiv2*zdiv3)) 
-                  zagg2 =  2*0.163*trn(ji,jj,jk,jpnum)**2*zfm*                       &
+                  zagg2 =  2*0.163*trb(ji,jj,jk,jpnum)**2*zfm*                       &
                      &                   ((xkr_mass_max**3+3.*(xkr_mass_max**2          &
                      &                    *xkr_mass_min*(zeps-1.)/zdiv2                 &
@@ -466,5 +466,5 @@
                      &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))    
 
-                  zagg3 =  0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3  
+                  zagg3 =  0.163*trb(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3  
                   
                  !    Aggregation of small into large particles
@@ -472,5 +472,5 @@
                  !    ----------------------------------------------
 
-                  zagg4 =  2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       &
+                  zagg4 =  2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2*                       &
                      &                 xkr_wsbio_min*(zeps-1.)**2                         &
                      &                 *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4)      &
@@ -479,5 +479,5 @@
                      &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )   
 
-                  zagg5 =   2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2                         &
+                  zagg5 =   2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2                         &
                      &                 *(zeps-1.)*zfm*xkr_wsbio_min                        &
                      &                 *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2)         &
@@ -489,5 +489,5 @@
                   !     ------------------------------------
 
-                  zfract = 2.*3.141*0.125*trn(ji,jj,jk,jpmes)*12./0.12/0.06**3*trn(ji,jj,jk,jpnum)  &
+                  zfract = 2.*3.141*0.125*trb(ji,jj,jk,jpmes)*12./0.12/0.06**3*trb(ji,jj,jk,jpnum)  &
                     &      * (0.01/xkr_mass_min)**(1.-zeps)*0.1**2  &
                     &      * 10000.*xstep
@@ -496,8 +496,8 @@
                   !     --------------------------------------
 
-                  zaggdoc = 0.83 * trn(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc)   &
-                     &        + 0.005 * 231. * trn(ji,jj,jk,jpdoc) * xstep * trn(ji,jj,jk,jpdoc)
-                  zaggdoc1 = 271. * trn(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  &
-                     &  + 0.02 * 16706. * trn(ji,jj,jk,jppoc) * xstep * trn(ji,jj,jk,jpdoc)
+                  zaggdoc = 0.83 * trb(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc)   &
+                     &        + 0.005 * 231. * trb(ji,jj,jk,jpdoc) * xstep * trb(ji,jj,jk,jpdoc)
+                  zaggdoc1 = 271. * trb(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  &
+                     &  + 0.02 * 16706. * trb(ji,jj,jk,jppoc) * xstep * trb(ji,jj,jk,jpdoc)
 
 # if defined key_degrad
@@ -514,5 +514,5 @@
                   zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi )
                   !
-                  znumdoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )
+                  znumdoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )
                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc + zaggdoc1
                   tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zfract + zaggdoc / xkr_massp - zagg
@@ -528,5 +528,5 @@
      !
      IF( lk_iomput ) THEN
-        IF( jnt == nrdttrc ) THEN
+        IF( knt == nrdttrc ) THEN
           CALL wrk_alloc( jpi, jpj,      zw2d )
           CALL wrk_alloc( jpi, jpj, jpk, zw3d )
@@ -800,5 +800,5 @@
       ztraz(:,:,:) = 0.e0
       zakz (:,:,:) = 0.e0
-      ztrb (:,:,:) = trn(:,:,:,jp_tra)
+      ztrb (:,:,:) = trb(:,:,:,jp_tra)
 
       DO jk = 1, jpkm1
@@ -815,5 +815,5 @@
          !  first guess of the slopes interior values
          DO jk = 2, jpkm1
-            ztraz(:,:,jk) = ( trn(:,:,jk-1,jp_tra) - trn(:,:,jk,jp_tra) ) * tmask(:,:,jk)
+            ztraz(:,:,jk) = ( trb(:,:,jk-1,jp_tra) - trb(:,:,jk,jp_tra) ) * tmask(:,:,jk)
          END DO
          ztraz(:,:,1  ) = 0.0
@@ -846,5 +846,5 @@
                   zigma = zwsink2(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1)
                   zew   = zwsink2(ji,jj,jk+1)
-                  psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep
+                  psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep
                END DO
             END DO
@@ -859,5 +859,5 @@
                DO ji = 1, jpi
                   zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
-                  trn(ji,jj,jk,jp_tra) = trn(ji,jj,jk,jp_tra) + zflx
+                  trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx
                END DO
             END DO
@@ -875,5 +875,5 @@
       END DO
 
-      trn(:,:,:,jp_tra) = ztrb(:,:,:)
+      trb(:,:,:,jp_tra) = ztrb(:,:,:)
       psinkflx(:,:,:)   = 2. * psinkflx(:,:,:)
       !
@@ -913,3 +913,3 @@
 
    !!======================================================================
-END MODULE  p4zsink
+END MODULE p4zsink
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90	(revision 5682)
@@ -24,4 +24,5 @@
    USE p4zsed          !  Sedimentation
    USE p4zint          !  time interpolation
+   USE p4zrem          !  remineralisation
    USE iom             !  I/O manager
    USE trd_oce         !  Ocean trends variables
@@ -36,7 +37,14 @@
    PUBLIC   p4z_sms        ! called in p4zsms.F90
 
-   REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget
-   INTEGER ::  numco2, numnut  !: logical unit for co2 budget
-
+   REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget
+   REAL(wp) :: xfact1, xfact2, xfact3
+   INTEGER ::  numco2, numnut, numnit  !: logical unit for co2 budget
+
+   !!* Array used to indicate negative tracer values
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     !: ???
+
+
+   !! * Substitutions
+#  include "top_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -61,20 +69,17 @@
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
       !!
-      INTEGER ::   jnt, jn, jl
+      INTEGER ::   ji, jj, jk, jnt, jn, jl
+      REAL(wp) ::  ztra
+#if defined key_kriest
+      REAL(wp) ::  zcoef1, zcoef2
+#endif
       CHARACTER (len=25) :: charout
-      REAL(wp), POINTER, DIMENSION(:,:,:,:)  :: ztrdpis
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('p4z_sms')
       !
-      IF( l_trdtrc )  THEN
-         CALL wrk_alloc( jpi, jpj, jpk, jp_pisces, ztrdpis ) 
-         DO jn = 1, jp_pisces
-            jl = jn + jp_pcs0 - 1
-            ztrdpis(:,:,:,jn) = trn(:,:,:,jl)
-         ENDDO
-      ENDIF
-      !
       IF( kt == nittrc000 ) THEN
+        !
+        ALLOCATE( xnegtr(jpi,jpj,jpk) )
         !
         CALL p4z_che                              ! initialize the chemical constants
@@ -88,4 +93,26 @@
       IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers
       !
+      !                                                                    !   set time step size (Euler/Leapfrog)
+      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN   ;    rfact = rdttrc(1)     !  at nittrc000
+      ELSEIF( kt <= nittrc000 + nn_dttrc )                          THEN   ;    rfact = 2. * rdttrc(1)   ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog)
+      ENDIF
+      !
+      IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN
+         rfactr  = 1. / rfact
+         rfact2  = rfact / FLOAT( nrdttrc )
+         rfact2r = 1. / rfact2
+         xstep = rfact2 / rday         ! Time step duration for biology
+         IF(lwp) WRITE(numout,*) 
+         IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdttra(1)
+         IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN
+         DO jn = jp_pcs0, jp_pcs1              !   SMS on tracer without Asselin time-filter
+            trb(:,:,:,jn) = trn(:,:,:,jn)
+         END DO
+      ENDIF
+      !
       IF( ndayflxtr /= nday_year ) THEN      ! New days
          !
@@ -105,28 +132,57 @@
       DO jnt = 1, nrdttrc          ! Potential time splitting if requested
          !
-         CALL p4z_bio (kt, jnt)    ! Biology
-         CALL p4z_sed (kt, jnt)    ! Sedimentation
-         !
+         CALL p4z_bio( kt, jnt )   ! Biology
+         CALL p4z_sed( kt, jnt )   ! Sedimentation
+         CALL p4z_lys( kt, jnt )   ! Compute CaCO3 saturation
+         CALL p4z_flx( kt, jnt )   ! Compute surface fluxes
+         !
+         xnegtr(:,:,:) = 1.e0
          DO jn = jp_pcs0, jp_pcs1
-            trb(:,:,:,jn) = trn(:,:,:,jn)
-         ENDDO
-         !
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
+                        ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
+                        xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra )
+                     ENDIF
+                 END DO
+               END DO
+            END DO
+         END DO
+         !                                ! where at least 1 tracer concentration becomes negative
+         !                                ! 
+         DO jn = jp_pcs0, jp_pcs1
+           trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
+         END DO
+        !
+         DO jn = jp_pcs0, jp_pcs1
+            tra(:,:,:,jn) = 0._wp
+         END DO
+         !
+         IF( ln_top_euler ) THEN
+            DO jn = jp_pcs0, jp_pcs1
+               trn(:,:,:,jn) = trb(:,:,:,jn)
+            END DO
+         ENDIF
       END DO
 
-      IF( l_trdtrc )  THEN
-         DO jn = 1, jp_pisces
-            jl = jn + jp_pcs0 - 1
-            ztrdpis(:,:,:,jn) = ( ztrdpis(:,:,:,jn) - trn(:,:,:,jl) ) * rfact2r
-         ENDDO
-      ENDIF
-      CALL p4z_lys( kt )             ! Compute CaCO3 saturation
-      CALL p4z_flx( kt )             ! Compute surface fluxes
-
-      DO jn = jp_pcs0, jp_pcs1
-        CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )
-        CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
-        CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )
+#if defined key_kriest
+      ! 
+      zcoef1 = 1.e0 / xkr_massp 
+      zcoef2 = 1.e0 / xkr_massp / 1.1
+      DO jk = 1,jpkm1
+         trb(:,:,jk,jpnum) = MAX(  trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef1 / xnumm(jk)  )
+         trb(:,:,jk,jpnum) = MIN(  trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef2              )
       END DO
       !
+#endif
+      !
+      !
+      IF( l_trdtrc ) THEN
+         DO jn = jp_pcs0, jp_pcs1
+           CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
+         END DO
+      END IF
+      !
       IF( lk_sed ) THEN 
          !
@@ -134,5 +190,5 @@
          !
          DO jn = jp_pcs0, jp_pcs1
-           CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )
+           CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
          END DO
          !
@@ -141,13 +197,5 @@
       IF( lrst_trc )  CALL p4z_rst( kt, 'WRITE' )  !* Write PISCES informations in restart file 
       !
-      IF( l_trdtrc ) THEN
-         DO jn = 1, jp_pisces
-            jl = jn + jp_pcs0 - 1
-             ztrdpis(:,:,:,jn) = ztrdpis(:,:,:,jn) + tra(:,:,:,jl)
-             CALL trd_trc( ztrdpis(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
-          END DO
-          CALL wrk_dealloc( jpi, jpj, jpk, jp_pisces, ztrdpis ) 
-      END IF
-      !
+
       IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt ) ! Mass conservation checking
 
@@ -280,7 +328,7 @@
                ztmas   = tmask(ji,jj,jk)
                ztmas1  = 1. - tmask(ji,jj,jk)
-               zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  )
-               zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
-               zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk )
+               zcaralk = trb(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  )
+               zco3    = ( zcaralk - trb(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
+               zbicarb = ( 2. * trb(ji,jj,jk,jpdic) - zcaralk )
                hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
             END DO
@@ -361,5 +409,6 @@
       REAL(wp) ::  silmean = 91.51     ! mean value of silicate
       !
-      REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum
+      REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn
+      REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb
       !!---------------------------------------------------------------------
 
@@ -374,23 +423,44 @@
          zarea          = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6              
 
-         zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
-         zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r
-         zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3
-         zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
+         zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
+         zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r
+         zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3
+         zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
  
-         IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum
-         trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum
-
-         IF(lwp) WRITE(numout,*) '       PO4  mean : ', zpo4sum
-         trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum
-
-         IF(lwp) WRITE(numout,*) '       NO3  mean : ', zno3sum
-         trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum
-
-         IF(lwp) WRITE(numout,*) '       SiO3 mean : ', zsilsum
-         trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum )
-         !
-      ENDIF
-
+         IF(lwp) WRITE(numout,*) '       TALKN mean : ', zalksumn
+         trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn
+
+         IF(lwp) WRITE(numout,*) '       PO4N  mean : ', zpo4sumn
+         trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn
+
+         IF(lwp) WRITE(numout,*) '       NO3N  mean : ', zno3sumn
+         trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn
+
+         IF(lwp) WRITE(numout,*) '       SiO3N mean : ', zsilsumn
+         trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )
+         !
+         !
+         IF( .NOT. ln_top_euler ) THEN
+            zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
+            zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r
+            zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3
+            zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
+ 
+            IF(lwp) WRITE(numout,*) ' '
+            IF(lwp) WRITE(numout,*) '       TALKB mean : ', zalksumb
+            trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb
+
+            IF(lwp) WRITE(numout,*) '       PO4B  mean : ', zpo4sumb
+            trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb
+
+            IF(lwp) WRITE(numout,*) '       NO3B  mean : ', zno3sumb
+            trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb
+
+            IF(lwp) WRITE(numout,*) '       SiO3B mean : ', zsilsumb
+            trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )
+        ENDIF
+        !
+      ENDIF
+        !
    END SUBROUTINE p4z_dmp
 
@@ -404,7 +474,12 @@
       !!---------------------------------------------------------------------
       !
-      INTEGER , INTENT( in ) ::   kt      ! ocean time-step index      
-      REAL(wp)               ::  zfact       
-      !!
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot
+      CHARACTER(LEN=100)   ::   cltxt
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
+      INTEGER :: jk
+      !!----------------------------------------------------------------------
+
+      !
       !!---------------------------------------------------------------------
 
@@ -413,7 +488,15 @@
             CALL ctl_opn( numco2, 'carbon.budget'  , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
             CALL ctl_opn( numnut, 'nutrient.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+            CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+            xfact1 = rfact2r * 12. / 1.e15 * ryyss    ! conversion molC/kt --> PgC/yr
+            xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss   ! conversion molC/l/s ----> TgN/m3/yr
+            xfact3 = 1.e+3 * rfact2r * rno3   ! conversion molC/l/kt ----> molN/m3/s
+            cltxt='time-step   Alkalinity        Nitrate        Phosphorus         Silicate           Iron'
+            IF( lwp ) WRITE(numnut,*)  TRIM(cltxt)
+            IF( lwp ) WRITE(numnut,*) 
          ENDIF
       ENDIF
 
+      !
       IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
          !   Compute the budget of NO3, ALK, Si, Fer
@@ -431,5 +514,18 @@
       ENDIF
       !
-      IF( iom_use( "psiltot" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+      IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
+         po4budget = glob_sum( (   trn(:,:,:,jppo4)                     &
+            &                    + trn(:,:,:,jpphy) + trn(:,:,:,jpdia)  &
+            &                    + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  &
+            &                    + trn(:,:,:,jppoc)                     &
+#if ! defined key_kriest
+            &                    + trn(:,:,:,jpgoc)                     &
+#endif
+            &                    + trn(:,:,:,jpdoc)                     ) * cvol(:,:,:)  )
+         po4budget = po4budget / areatot
+         CALL iom_put( "ppo4tot", po4budget )
+      ENDIF
+      !
+      IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
          silbudget = glob_sum( (   trn(:,:,:,jpsil) + trn(:,:,:,jpgsi)  &
             &                    + trn(:,:,:,jpdsi)                     ) * cvol(:,:,:)  )
@@ -439,5 +535,5 @@
       ENDIF
       !
-      IF( iom_use( "palktot" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+      IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
          alkbudget = glob_sum( (   trn(:,:,:,jpno3) * rno3              &
             &                    + trn(:,:,:,jptal)                     &
@@ -448,5 +544,5 @@
       ENDIF
       !
-      IF( iom_use( "pfertot" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+      IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
          ferbudget = glob_sum( (   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe)  &
             &                    + trn(:,:,:,jpdfe)                     &
@@ -462,19 +558,45 @@
       ENDIF
       !
+
+      ! Global budget of N SMS : denitrification in the water column and in the sediment
+      !                          nitrogen fixation by the diazotrophs
+      ! --------------------------------------------------------------------------------
+      IF( iom_use( "tnfix" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+         znitrpottot  = glob_sum ( nitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
+         CALL iom_put( "tnfix"  , znitrpottot * 1.e+3 * rno3 )  ! Global  nitrogen fixation molC/l  to molN/m3 
+      ENDIF
+      !
+      IF( iom_use( "tdenit" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+         zrdenittot   = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
+         CALL iom_put( "tdenit"  , zrdenittot * 1.e+3 * rno3 )  ! Total denitrification molC/l to molN/m3 
+      ENDIF
+      !
+      IF( iom_use( "Sdenit" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+         zsdenittot   = glob_sum ( sdenit(:,:) * e1e2t(:,:) )
+         CALL iom_put( "Sdenit", sdenit(:,:) * xfact3 * tmask(:,:,1) )  ! Nitrate reduction in the sediments
+      ENDIF
+
       IF( ln_check_mass .AND. kt == nitend ) THEN   ! Compute the budget of NO3, ALK, Si, Fer
-         zfact = rfact2r * 12. / 1.e15 * ryyss    ! conversion molC/kt --> PgC/year
          t_atm_co2_flx  = t_atm_co2_flx / glob_sum( e1e2t(:,:) )
-         t_oce_co2_flx  = t_oce_co2_flx         * zfact * (-1 )
-         tpp            = tpp           * 1000. * zfact
-         t_oce_co2_exp  = t_oce_co2_exp * 1000. * zfact
+         t_oce_co2_flx  = t_oce_co2_flx         * xfact1 * (-1 )
+         tpp            = tpp           * 1000. * xfact1
+         t_oce_co2_exp  = t_oce_co2_exp * 1000. * xfact1
          IF( lwp ) WRITE(numco2,9000) ndastp, t_atm_co2_flx, t_oce_co2_flx, tpp, t_oce_co2_exp
-         IF( lwp ) WRITE(numnut,9500) ndastp, alkbudget        * 1.e+06, &
+         IF( lwp ) WRITE(numnut,9100) ndastp, alkbudget        * 1.e+06, &
              &                                no3budget * rno3 * 1.e+06, &
+             &                                po4budget * po4r * 1.e+06, &
              &                                silbudget        * 1.e+06, &
              &                                ferbudget        * 1.e+09
+         !
+         IF( lwp ) WRITE(numnit,9200) ndastp, znitrpottot * xfact2  , &
+         &                             zrdenittot  * xfact2  , &
+         &                             zsdenittot  * xfact2
+
       ENDIF
       !
  9000  FORMAT(i8,f10.5,e18.10,f10.5,f10.5)
- 9500  FORMAT(i8,4e18.10)
+ 9100  FORMAT(i8,5e18.10)
+ 9200  FORMAT(i8,3f10.5)
+
        !
    END SUBROUTINE p4z_chk_mass
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90	(revision 5682)
@@ -7,4 +7,5 @@
    !!        !  06-12  (C. Ethe)  Orignal
    !!----------------------------------------------------------------------
+   !! $Id$
 #if defined key_sed
    !! Domain characteristics
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90	(revision 5682)
@@ -160,4 +160,5 @@
    INTEGER, PUBLIC ::  numsed = 27    ! units
 
+   !! $Id$
 CONTAINS
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90	(revision 5682)
@@ -23,4 +23,5 @@
    REAL(wp) :: eps = 1.e-13
 
+   !! $Id$
 CONTAINS
 
@@ -438,4 +439,5 @@
    !! MODULE sedbtb  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_adv( kt )         ! Empty routine
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90	(revision 5682)
@@ -29,5 +29,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limtab.F90,v 1.2 2005/03/27 18:34:42 opalod Exp $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90	(revision 5682)
@@ -12,4 +12,5 @@
 
 
+   !! $Id$
 CONTAINS
    
@@ -77,4 +78,5 @@
    !! MODULE sedbtb  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_btb( kt )         ! Empty routine
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90	(revision 5682)
@@ -163,4 +163,5 @@
    DATA Ddsw / 999.842594 , 6.793952E-2 , -9.095290E-3, 1.001685E-4, -1.120083E-6, 6.536332E-9/
 
+   !! $Id$
 CONTAINS
 
@@ -559,4 +560,5 @@
    !! MODULE sedchem  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_chem( kt )         ! Empty routine
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90	(revision 5682)
@@ -23,4 +23,5 @@
    !!----------------------------------------------------------------------
 
+   !! $Id$
 CONTAINS
 
@@ -188,4 +189,5 @@
    !! MODULE sedco3  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_co3( kt )         ! Empty routine
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90	(revision 5682)
@@ -20,4 +20,5 @@
    REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC ::  dens_mol_wgt  ! molecular density 
 
+   !! $Id$
 CONTAINS
    
@@ -530,4 +531,5 @@
    !! MODULE seddsr  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_dsr ( kt )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90	(revision 5682)
@@ -28,4 +28,5 @@
 #endif
 
+   !! $Id$
 CONTAINS
 
@@ -268,4 +269,5 @@
    !! MODULE seddta  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_dta ( kt )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90	(revision 5682)
@@ -55,4 +55,5 @@
    PUBLIC sed_init          ! routine called by opa.F90
 
+   !! $Id$
 CONTAINS
 
@@ -856,4 +857,5 @@
    !!   Dummy module :                      NO Sediment model
    !!----------------------------------------------------------------------
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_ini              ! Empty routine
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90	(revision 5682)
@@ -22,4 +22,5 @@
 
 
+   !! $Id$
  CONTAINS
 
@@ -257,4 +258,5 @@
    !! MODULE sedmat  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_mat         ! Empty routine
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90	(revision 5682)
@@ -36,4 +36,5 @@
    REAL(wp)  :: src13ca  
 
+   !! $Id$
 CONTAINS
 
@@ -311,4 +312,5 @@
    !! MODULE sedmbc :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_mbc( kt )         ! Empty routine
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90	(revision 5682)
@@ -17,4 +17,5 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .TRUE.     !: sediment flag
 
+   !! $Id$
 CONTAINS
 
@@ -47,4 +48,5 @@
    !!======================================================================
    LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .FALSE.     !: sediment flag
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_model( kt )         ! Empty routine
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90	(revision 5682)
@@ -25,4 +25,5 @@
    
    
+   !! $Id$
 CONTAINS
 
@@ -270,4 +271,5 @@
    !! MODULE sedrst :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_rst_read                      ! Empty routines
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90	(revision 5682)
@@ -12,4 +12,5 @@
    PUBLIC sed_sfc
 
+   !! $Id$
 CONTAINS
 
@@ -67,4 +68,5 @@
    !! MODULE sedsfc  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_sfc ( kt )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90	(revision 5682)
@@ -23,4 +23,5 @@
    PUBLIC sed_stp  ! called by step.F90
 
+   !! $Id$
 CONTAINS
 
@@ -69,4 +70,5 @@
    !! MODULE sedstp  :   Dummy module 
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_stp( kt )         ! Empty routine
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90	(revision 5682)
@@ -25,4 +25,5 @@
    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext51
 
+   !! $Id$
 CONTAINS
 
@@ -264,4 +265,5 @@
    !! MODULE sedwri  :   Dummy module
    !!======================================================================
+   !! $Id$
 CONTAINS
    SUBROUTINE sed_wri( kt )         ! Empty routine
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90	(revision 5682)
@@ -63,10 +63,10 @@
    INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: (big) Silicate Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: Diatoms Silicate Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpnum = 15    !: Big iron particles Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpsfe = 16    !: number of particulate organic phosphate concentration
    INTEGER, PUBLIC, PARAMETER ::   jpdfe = 17    !: Diatoms iron Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 18    !: Diatoms Silicate Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 18    !: (big) Silicate Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpnfe = 19    !: Nano iron Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpnch = 20    !: Nano Chlorophyll Concentration
@@ -102,5 +102,5 @@
    INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: (big) Silicate Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: Diatoms Silicate Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpbfe = 15    !: Big iron particles Concentration
@@ -108,5 +108,5 @@
    INTEGER, PUBLIC, PARAMETER ::   jpsfe = 17    !: Small iron particles Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpdfe = 18    !: Diatoms iron Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 19    !: Diatoms Silicate Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 19    !: (big) Silicate Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpnfe = 20    !: Nano iron Concentration
    INTEGER, PUBLIC, PARAMETER ::   jpnch = 21    !: Nano Chlorophyll Concentration
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90	(revision 5682)
@@ -106,7 +106,4 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates
 
-   !!* Array used to indicate negative tracer values
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     !: ???
-
 #if defined key_kriest
    !!*  Kriest parameter for aggregation
@@ -131,5 +128,5 @@
       !!----------------------------------------------------------------------
       USE lib_mpp , ONLY: ctl_warn
-      INTEGER ::   ierr(6)        ! Local variables
+      INTEGER ::   ierr(5)        ! Local variables
       !!----------------------------------------------------------------------
       ierr(:) = 0
@@ -162,6 +159,4 @@
       ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk) ,    STAT=ierr(5) )
          !
-      !* Array used to indicate negative tracer values  
-      ALLOCATE( xnegtr(jpi,jpj,jpk)  ,                           STAT=ierr(6) )
 #endif
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90	(revision 5682)
@@ -0,0 +1,277 @@
+MODULE trcice_pisces
+   !!======================================================================
+   !!                         ***  MODULE trcice_pisces  ***
+   !! TOP :   initialisation of the PISCES biochemical model
+   !!======================================================================
+   !! History :  3.5  ! 2013    (M. Vancoppenolle, O. Aumont, G. Madec), original code
+   !! Comment ! probably not properly done when the second particle export
+   !! scheme (kriest) is used
+   !!----------------------------------------------------------------------
+#if defined key_pisces || defined key_pisces_reduced
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !! trc_ice_pisces   : PISCES fake sea ice model setting
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE par_pisces      ! PISCES parameters
+   USE oce_trc         ! Shared variables between ocean and passive tracers
+   USE trc             ! Passive tracers common variables 
+   USE phycst          ! Ocean physics parameters
+   USE sms_pisces      ! PISCES Source Minus Sink variables
+   USE in_out_manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ice_ini_pisces ! called by trcini.F90 module
+
+CONTAINS
+
+   SUBROUTINE trc_ice_ini_pisces
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_ice_ini_pisces ***
+      !!
+      !! ** Purpose :   PISCES fake sea ice model setting
+      !!    Method  :   Assign prescribe values to tracer concentrations in sea ice
+      !!
+      !! For levitating sea ice, constant ocean tracer concentrations also have to be defined. 
+      !! This is done specifically for Global, Arctic, Antarctic and Baltic regions
+      !! 
+      !! Sea ice concentrations are by default prescribed as follows
+      !!  trc_i = zratio * trc_o
+      !!
+      !! This formulation is modulated by the namelist parameter trc_ice_ratio
+      !!
+      !! trc_ice_ratio  * betw 0 and 1: prescribed ice/ocean tracer concentration ratio
+      !!                * -1 => the ice-ocean tracer concentration ratio follows the
+      !!                         ice-ocean salinity ratio
+      !!                * -2 => no ice-ocean tracer concentration is used
+      !!                        instead, the tracer concentration in sea ice 
+      !!                        is prescribed to trc_ice_prescr
+      !! 
+      !! cn_trc_o  specifies which disinctions are made for prescribed tracer concentration
+      !!                * 'GL' use global ocean values making distinction for Baltic Sea only
+      !!                * 'AA' use Arctic/Antarctic contrasted values, + Baltic
+      !!
+      !!----------------------------------------------------------------------
+
+                                        !--- Dummy variables
+      REAL(wp), DIMENSION(jp_pisces,2)  :: zratio  ! effective ice-ocean tracer cc ratio
+      REAL(wp), DIMENSION(jp_pisces,4)  :: zpisc   ! prescribes concentration 
+      !                                            !  1:global, 2:Arctic, 3:Antarctic, 4:Baltic
+
+      REAL(wp), DIMENSION(2) :: zrs  ! ice-ocean salinity ratio, 1 - global, 2- Baltic
+      REAL(wp) :: zsice_bal          ! prescribed ice salinity in the Baltic
+      REAL(wp) :: zsoce_bal          ! prescribed ocean salinity in the Baltic
+      REAL(wp) :: zfeoce_glo         ! prescribed iron concentration in the global ocean
+      REAL(wp) :: zfeoce_bal         ! prescribed iron concentration in the global ocean
+      INTEGER  :: jn                 ! dummy loop index
+
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ice_ini_pisces: Prescribed sea ice biogeochemistry '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~'
+
+      !--------------------------------------------
+      ! Initialize ocean prescribed concentrations
+      !--------------------------------------------
+      ! values taken from a 500 yr equilibrium run
+      ! used only in the levitating sea ice case with virtual salt / tracer
+      ! fluxes
+
+      !--- Global values
+      zpisc(jpdic,1) =  1.99e-3_wp 
+      zpisc(jpdoc,1) =  2.04e-5_wp 
+      zpisc(jptal,1) =  2.31e-3_wp 
+      zpisc(jpoxy,1) =  2.47e-4_wp
+      zpisc(jpcal,1) =  1.04e-8_wp
+      zpisc(jppo4,1) =  5.77e-7_wp / po4r 
+      zpisc(jppoc,1) =  1.27e-6_wp  
+#  if ! defined key_kriest
+      zpisc(jpgoc,1) =  5.23e-8_wp  
+      zpisc(jpbfe,1) =  9.84e-13_wp 
+#  else
+      zpisc(jpnum,1) = 0. ! could not get this value since did not use it
+#  endif
+      zpisc(jpsil,1) =  7.36e-6_wp  
+      zpisc(jpdsi,1) =  1.07e-7_wp 
+      zpisc(jpgsi,1) =  1.53e-8_wp
+      zpisc(jpphy,1) =  9.57e-8_wp
+      zpisc(jpdia,1) =  4.24e-7_wp
+      zpisc(jpzoo,1) =  6.07e-7_wp
+      zpisc(jpmes,1) =  3.44e-7_wp
+      zpisc(jpfer,1) =  4.06e-10_wp
+      zpisc(jpsfe,1) =  2.51e-11_wp
+      zpisc(jpdfe,1) =  6.57e-12_wp
+      zpisc(jpnfe,1) =  1.76e-11_wp
+      zpisc(jpnch,1) =  1.67e-7_wp
+      zpisc(jpdch,1) =  1.02e-7_wp
+      zpisc(jpno3,1) =  5.79e-6_wp / rno3 
+      zpisc(jpnh4,1) =  3.22e-7_wp / rno3
+
+      !--- Arctic specificities (dissolved inorganic & DOM)
+      zpisc(jpdic,2) =  1.98e-3_wp 
+      zpisc(jpdoc,2) =  6.00e-6_wp 
+      zpisc(jptal,2) =  2.13e-3_wp 
+      zpisc(jpoxy,2) =  3.65e-4_wp  
+      zpisc(jpcal,2) =  1.50e-9_wp  
+      zpisc(jppo4,2) =  4.09e-7_wp / po4r 
+      zpisc(jppoc,2) =  4.05e-7_wp  
+#  if ! defined key_kriest
+      zpisc(jpgoc,2) =  2.84e-8_wp  
+      zpisc(jpbfe,2) =  7.03e-13_wp 
+#  else
+      zpisc(jpnum,2) =  0.00e-00_wp 
+#  endif
+      zpisc(jpsil,2) =  6.87e-6_wp  
+      zpisc(jpdsi,2) =  1.73e-7_wp 
+      zpisc(jpgsi,2) =  7.93e-9_wp
+      zpisc(jpphy,2) =  5.25e-7_wp  
+      zpisc(jpdia,2) =  7.75e-7_wp 
+      zpisc(jpzoo,2) =  3.34e-7_wp
+      zpisc(jpmes,2) =  2.49e-7_wp  
+      zpisc(jpfer,2) =  1.43e-9_wp 
+      zpisc(jpsfe,2) =  2.21e-11_wp 
+      zpisc(jpdfe,2) =  2.04e-11_wp 
+      zpisc(jpnfe,2) =  1.75e-11_wp 
+      zpisc(jpnch,2) =  1.46e-07_wp 
+      zpisc(jpdch,2) =  2.36e-07_wp 
+      zpisc(jpno3,2) =  3.51e-06_wp / rno3 
+      zpisc(jpnh4,2) =  6.15e-08_wp / rno3 
+
+      !--- Antarctic specificities (dissolved inorganic & DOM)
+      zpisc(jpdic,3) =  2.20e-3_wp  
+      zpisc(jpdoc,3) =  7.02e-6_wp  
+      zpisc(jptal,3) =  2.37e-3_wp  
+      zpisc(jpoxy,3) =  3.42e-4_wp  
+      zpisc(jpcal,3) =  3.17e-9_wp  
+      zpisc(jppo4,3) =  1.88e-6_wp / po4r  
+      zpisc(jppoc,3) =  1.13e-6_wp  
+#  if ! defined key_kriest
+      zpisc(jpgoc,3) =  2.89e-8_wp  
+      zpisc(jpbfe,3) =  5.63e-13_wp 
+#  else
+      zpisc(jpnum,3) =  0.00e-00_wp 
+#  endif
+      zpisc(jpsil,3) =  4.96e-5_wp  
+      zpisc(jpdsi,3) =  5.63e-7_wp 
+      zpisc(jpgsi,3) =  5.35e-8_wp
+      zpisc(jpphy,3) =  8.10e-7_wp  
+      zpisc(jpdia,3) =  5.77e-7_wp 
+      zpisc(jpzoo,3) =  6.68e-7_wp
+      zpisc(jpmes,3) =  3.55e-7_wp  
+      zpisc(jpfer,3) =  1.62e-10_wp
+      zpisc(jpsfe,3) =  2.29e-11_wp 
+      zpisc(jpdfe,3) =  8.75e-12_wp
+      zpisc(jpnfe,3) =  1.48e-11_wp 
+      zpisc(jpnch,3) =  2.02e-7_wp  
+      zpisc(jpdch,3) =  1.60e-7_wp  
+      zpisc(jpno3,3) =  2.64e-5_wp / rno3  
+      zpisc(jpnh4,3) =  3.39e-7_wp / rno3  
+
+      !--- Baltic Sea particular case for ORCA configurations
+      zpisc(jpdic,4) = 1.14e-3_wp
+      zpisc(jpdoc,4) = 1.06e-5_wp
+      zpisc(jptal,4) = 1.16e-3_wp
+      zpisc(jpoxy,4) = 3.71e-4_wp
+      zpisc(jpcal,4) = 1.51e-9_wp
+      zpisc(jppo4,4) = 2.85e-9_wp / po4r
+      zpisc(jppoc,4) = 4.84e-7_wp
+#  if ! defined key_kriest
+      zpisc(jpgoc,4) = 1.05e-8_wp
+      zpisc(jpbfe,4) = 4.97e-13_wp
+#  else
+      zpisc(jpnum,4) = 0. ! could not get this value
+#  endif
+      zpisc(jpsil,4) = 4.91e-5_wp
+      zpisc(jpdsi,4) = 3.25e-7_wp
+      zpisc(jpgsi,4) = 1.93e-8_wp
+      zpisc(jpphy,4) = 6.64e-7_wp
+      zpisc(jpdia,4) = 3.41e-7_wp
+      zpisc(jpzoo,4) = 3.83e-7_wp
+      zpisc(jpmes,4) = 0.225e-6_wp
+      zpisc(jpfer,4) = 2.45e-9_wp
+      zpisc(jpsfe,4) = 3.89e-11_wp
+      zpisc(jpdfe,4) = 1.33e-11_wp
+      zpisc(jpnfe,4) = 2.62e-11_wp
+      zpisc(jpnch,4) = 1.17e-7_wp
+      zpisc(jpdch,4) = 9.69e-8_wp
+      zpisc(jpno3,4) = 5.36e-5_wp / rno3
+      zpisc(jpnh4,4) = 7.18e-7_wp / rno3
+ 
+      DO jn = jp_pcs0, jp_pcs1
+         IF( cn_trc_o(jn) == 'GL ' ) trc_o(:,:,jn) = zpisc(jn,1)  ! Global case
+         IF( cn_trc_o(jn) == 'AA ' ) THEN 
+            WHERE( gphit(:,:) >= 0._wp ) ; trc_o(:,:,jn) = zpisc(jn,2) ; END WHERE ! Arctic 
+            WHERE( gphit(:,:) <  0._wp ) ; trc_o(:,:,jn) = zpisc(jn,3) ; END WHERE ! Antarctic 
+         ENDIF
+         IF( cp_cfg == "orca" ) THEN     !  Baltic Sea particular case for ORCA configurations
+             WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    &
+                    54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
+                    trc_o(:,:,jn) = zpisc(jn,4)
+            END WHERE
+         ENDIF 
+      ENDDO
+
+
+
+      !-----------------------------
+      ! Assign ice-ocean cc ratios 
+      !-----------------------------
+      ! 0 means zero concentration in sea ice
+      ! 1 means same concentration in the sea ice as in the ocean
+
+      ! Ice ocean salinity ratio
+      zsoce_bal   = 4. ; zsice_bal   = 2. !! Baltic ocean and sea ice salinities
+      zrs(1) = sice / soce                !! ice-ocean salinity ratio, global case
+      zrs(2) = zsice_bal / zsoce_bal      !! ice-ocean salinity ratio, Baltic case
+
+      DO jn = jp_pcs0, jp_pcs1
+         IF( trc_ice_ratio(jn) >= 0._wp )  zratio(jn,:) = trc_ice_ratio(jn)
+         IF( trc_ice_ratio(jn) == -1._wp ) zratio(jn,:) = zrs(:)
+         IF( trc_ice_ratio(jn) == -2._wp ) zratio(jn,:) = -9999.99_wp
+      END DO
+
+      !-------------------------------
+      ! Sea ice tracer concentrations
+      !-------------------------------
+      DO jn = jp_pcs0, jp_pcs1
+         !-- Everywhere but in the Baltic
+         IF ( trc_ice_ratio(jn) >= -1._wp ) THEN ! no prescribed conc. ; typically everything but iron) 
+            trc_i(:,:,jn) = zratio(jn,1) * trc_o(:,:,jn) 
+         ELSE                                    ! prescribed concentration
+            trc_i(:,:,jn) = trc_ice_prescr(jn)
+         ENDIF
+       
+         !-- Baltic
+         IF( cp_cfg == "orca" ) THEN  ! Baltic treated seperately for ORCA configs
+            IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN ! no prescribed conc. ; typically everything but iron) 
+               WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    &
+                      54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
+                     trc_i(:,:,jn) = zratio(jn,2) * trc_o(:,:,jn) 
+               END WHERE
+            ELSE                                 ! prescribed tracer concentration in ice
+               WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    &
+                   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
+                     trc_i(:,:,jn) = trc_ice_prescr(jn)
+               END WHERE
+            ENDIF ! trc_ice_ratio
+         ENDIF
+      !
+      END DO ! jn
+
+   END SUBROUTINE trc_ice_ini_pisces
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                            No PISCES biochemical model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ice_ini_pisces         ! Empty routine
+   END SUBROUTINE trc_ice_ini_pisces
+#endif
+
+   !!======================================================================
+END MODULE trcice_pisces
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 5682)
@@ -71,12 +71,13 @@
       USE p4zmort         !  Mortality terms for phytoplankton
       USE p4zlys          !  Calcite saturation
+      USE p4zsed          !  Sedimentation & burial
       !
       REAL(wp), SAVE :: sco2   =  2.312e-3_wp
-      REAL(wp), SAVE :: alka0  =  2.423e-3_wp
+      REAL(wp), SAVE :: alka0  =  2.426e-3_wp
       REAL(wp), SAVE :: oxyg0  =  177.6e-6_wp 
-      REAL(wp), SAVE :: po4    =  2.174e-6_wp 
+      REAL(wp), SAVE :: po4    =  2.165e-6_wp 
       REAL(wp), SAVE :: bioma0 =  1.000e-8_wp  
-      REAL(wp), SAVE :: silic1 =  91.65e-6_wp  
-      REAL(wp), SAVE :: no3    =  31.04e-6_wp * 7.625_wp
+      REAL(wp), SAVE :: silic1 =  91.51e-6_wp  
+      REAL(wp), SAVE :: no3    =  30.9e-6_wp * 7.625_wp
       !
       INTEGER  ::  ji, jj, jk, ierr
@@ -97,4 +98,5 @@
       ierr = ierr +  p4z_rem_alloc()
       ierr = ierr +  p4z_flx_alloc()
+      ierr = ierr +  p4z_sed_alloc()
       !
       IF( lk_mpp    )   CALL mpp_sum( ierr )
@@ -107,13 +109,4 @@
       CALL p4z_sms_init       !  Maint routine
       !                                            ! Time-step
-      rfact   = rdttrc(1)                          ! ---------
-      rfactr  = 1. / rfact
-      rfact2  = rfact / FLOAT( nrdttrc )
-      rfact2r = 1. / rfact2
-
-      IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdttra(1)
-      IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2
-
-
 
       ! Set biological ratios
@@ -165,6 +158,4 @@
       END IF
 
-      ! Time step duration for biology
-      xstep = rfact2 / rday
 
       CALL p4z_sink_init      !  vertical flux of particulate organic matter
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 5682)
@@ -83,14 +83,9 @@
       IF( kt == nittrc000 )   CALL trc_adv_ctl          ! initialisation & control of options
 
-      IF( ln_top_euler) THEN
-         r2dt(:) =  rdttrc(:)              ! = rdttrc (use Euler time stepping)
-      ELSE
-         IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000
-            r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping)
-         ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1
-            r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
-         ENDIF
+      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000
+         r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping)
+      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1
+         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
       ENDIF
-
       !                                                   ! effective transport
       DO jk = 1, jpkm1
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 5682)
@@ -24,4 +24,5 @@
    USE trdtra
    USE trd_oce
+   USE iom
 
    IMPLICIT NONE
@@ -42,5 +43,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -125,5 +126,5 @@
                      DO jj = 2, jpjm1
                         DO ji = fs_2, fs_jpim1   ! vector opt.
-                           IF( avt(ji,jj,jk) <= 5.e-4 )  THEN 
+                           IF( avt(ji,jj,jk) <= 5.e-4_wp )  THEN 
                               ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
                               tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
@@ -184,5 +185,6 @@
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
       !
-      INTEGER :: ji, jj, jk, jn, jl, jc                     ! dummy loop indicesa
+      INTEGER :: ji , jj, jk, jn, jl, jc                     ! dummy loop indicesa
+      INTEGER :: isrow                                      ! local index
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace
 
@@ -200,4 +202,13 @@
             !
             SELECT CASE ( jp_cfg )
+            !                                           ! =======================
+            CASE ( 1 )                                  ! eORCA_R1 configuration
+            !                                           ! =======================
+            isrow = 332 - jpjglo
+            !
+                                                        ! Caspian Sea
+            nctsi1(1)   = 332  ; nctsj1(1)   = 243 - isrow
+            nctsi2(1)   = 344  ; nctsj2(1)   = 275 - isrow
+            !                                        
             !                                           ! =======================
             CASE ( 2 )                                  !  ORCA_R2 configuration
@@ -302,13 +313,8 @@
       !!----------------------------------------------------------------------
       !
+      INTEGER :: imask  !local file handle
+
       IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init')
       !
-      SELECT CASE ( nn_hdmp_tr )
-      CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only'
-      CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp_tr, ' degrees'
-      CASE DEFAULT
-         WRITE(ctmp1,*) '          bad flag value for nn_hdmp_tr = ', nn_hdmp_tr
-         CALL ctl_stop(ctmp1)
-      END SELECT
 
       IF( lzoom )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries
@@ -325,9 +331,9 @@
          &   CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' )
       !
-      !                          ! Damping coefficients initialization
-      IF( lzoom ) THEN   ;   CALL dtacof_zoom( restotr )
-      ELSE               ;   CALL dtacof( nn_hdmp_tr, rn_surf_tr, rn_bot_tr, rn_dep_tr,  &
-                             &            nn_file_tr, 'TRC'     , restotr                )
-      ENDIF
+      !                          ! Read damping coefficients from file
+      !Read in mask from file
+      CALL iom_open ( cn_resto_tr, imask)
+      CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr)
+      CALL iom_close( imask )
       !
       IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init')
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 5682)
@@ -217,9 +217,4 @@
       ENDIF
 
-      IF( .NOT. ln_trcldf_diff ) THEN
-         IF(lwp) WRITE(numout,*) '          No lateral diffusion on passive tracers'
-         nldf = -2
-      ENDIF
-
       IF(lwp) THEN
          WRITE(numout,*)
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90	(revision 5682)
@@ -33,5 +33,4 @@
 
    !                                        !!: ** lateral mixing namelist (nam_trcldf) **
-   LOGICAL , PUBLIC ::   ln_trcldf_diff      !: flag of perform or not the lateral diff.
    LOGICAL , PUBLIC ::   ln_trcldf_lap       !: laplacian operator
    LOGICAL , PUBLIC ::   ln_trcldf_bilap     !: bilaplacian operator
@@ -51,10 +50,6 @@
    !                                                 !!: ** newtonian damping namelist (nam_trcdmp) **
    !                          !!* Namelist namtrc_dmp : passive tracer newtonian damping *
-   INTEGER , PUBLIC ::   nn_hdmp_tr    ! = 0/-1/'latitude' for damping over passive tracer
    INTEGER , PUBLIC ::   nn_zdmp_tr    ! = 0/1/2 flag for damping in the mixed layer
-   REAL(wp), PUBLIC ::   rn_surf_tr    ! surface time scale for internal damping        [days]
-   REAL(wp), PUBLIC ::   rn_bot_tr     ! bottom time scale for internal damping         [days]
-   REAL(wp), PUBLIC ::   rn_dep_tr     ! depth of transition between rn_surf and rn_bot [meters]
-   INTEGER , PUBLIC ::   nn_file_tr    ! = 1 create a damping.coeff NetCDF file
+   CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr    !File containing restoration coefficient
 
    !!----------------------------------------------------------------------
@@ -77,11 +72,10 @@
          &                 ln_trcadv_ubs  , ln_trcadv_qck, ln_trcadv_msc_ups
 
-      NAMELIST/namtrc_ldf/ ln_trcldf_diff , ln_trcldf_lap  ,     &
+      NAMELIST/namtrc_ldf/ ln_trcldf_lap  ,     &
          &                 ln_trcldf_bilap, ln_trcldf_level,     &
          &                 ln_trcldf_hor  , ln_trcldf_iso  , rn_ahtrc_0, rn_ahtrb_0
       NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp
       NAMELIST/namtrc_rad/ ln_trcrad
-      NAMELIST/namtrc_dmp/ nn_hdmp_tr, nn_zdmp_tr, rn_surf_tr, &
-        &                  rn_bot_tr , rn_dep_tr , nn_file_tr
+      NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr
       !!----------------------------------------------------------------------
 
@@ -126,5 +120,4 @@
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)'
-         WRITE(numout,*) '      perform lateral diffusion or not                   ln_trcldf_diff  = ', ln_trcldf_diff
          WRITE(numout,*) '      laplacian operator                                 ln_trcldf_lap   = ', ln_trcldf_lap
          WRITE(numout,*) '      bilaplacian operator                               ln_trcldf_bilap = ', ln_trcldf_bilap
@@ -184,10 +177,6 @@
          WRITE(numout,*) '~~~~~~~'
          WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter'
-         WRITE(numout,*) '      tracer damping option          nn_hdmp_tr = ', nn_hdmp_tr
          WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)'
-         WRITE(numout,*) '      surface time scale (days)      rn_surf_tr = ', rn_surf_tr
-         WRITE(numout,*) '      bottom time scale (days)       rn_bot_tr  = ', rn_bot_tr
-         WRITE(numout,*) '      depth of transition (meters)   rn_dep_tr  = ', rn_dep_tr
-         WRITE(numout,*) '      create a damping.coeff file    nn_file_tr = ', nn_file_tr
+         WRITE(numout,*) '      Restoration coeff file    cn_resto_tr = ', cn_resto_tr
       ENDIF
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 5682)
@@ -102,4 +102,7 @@
       ENDIF
 
+#if defined key_agrif
+      CALL Agrif_trc                   ! AGRIF zoom boundaries
+#endif
       ! Update after tracer on domain lateral boundaries
       DO jn = 1, jptra
@@ -111,12 +114,9 @@
 !!      CALL bdy_trc( kt )               ! BDY open boundaries
 #endif
-#if defined key_agrif
-      CALL Agrif_trc                   ! AGRIF zoom boundaries
-#endif
 
 
       ! set time step size (Euler/Leapfrog)
       IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nittrc000             (Euler)
-      ELSEIF( kt <= nittrc000 + 1 )            THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog)
+      ELSEIF( kt <= nittrc000 + nn_dttrc )     THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog)
       ENDIF
 
@@ -137,6 +137,7 @@
       ELSE
          ! Leap-Frog + Asselin filter time stepping
-         IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! variable volume level (vvl) 
-         ELSE                ;   CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! fixed    volume level 
+         IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      &
+           &                                                                sbc_trc, sbc_trc_b, jptra )      ! variable volume level (vvl) 
+         ELSE                ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )      ! fixed    volume level 
          ENDIF
       ENDIF
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 5682)
@@ -19,4 +19,5 @@
    USE trc             ! ocean  passive tracers variables
    USE prtctl_trc      ! Print control for debbuging
+   USE iom
    USE trd_oce
    USE trdtra
@@ -26,4 +27,6 @@
 
    PUBLIC   trc_sbc   ! routine called by step.F90
+
+   REAL(wp) ::   r2dt  !  time-step at surface
 
    !! * Substitutions
@@ -60,9 +63,11 @@
       INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
       !
-      INTEGER  ::   ji, jj, jn           ! dummy loop indices
-      REAL(wp) ::   zsrau, zse3t   ! temporary scalars
+      INTEGER  ::   ji, jj, jn                                     ! dummy loop indices
+      REAL(wp) ::   zse3t, zrtrn, zratio, zfact                    ! temporary scalars
+      REAL(wp) ::   zswitch, zftra, zcd, zdtra, ztfx, ztra         ! temporary scalars
       CHARACTER (len=22) :: charout
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zsfx
       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd
+
       !!---------------------------------------------------------------------
       !
@@ -72,4 +77,23 @@
                       CALL wrk_alloc( jpi, jpj,      zsfx   )
       IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )
+      !
+      zrtrn = 1.e-15_wp
+
+      SELECT CASE( nn_ice_embd )         ! levitating or embedded sea-ice option
+         CASE( 0    )   ;   zswitch = 1  ! (0) standard levitating sea-ice : salt exchange only
+         CASE( 1, 2 )   ;   zswitch = 0  ! (1) levitating sea-ice: salt and volume exchange but no pressure effect                                
+                                         ! (2) embedded sea-ice : salt and volume fluxes and pressure
+      END SELECT
+
+      IF( ln_top_euler) THEN
+         r2dt =  rdttrc(1)              ! = rdttrc (use Euler time stepping)
+      ELSE
+         IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000
+            r2dt = rdttrc(1)           ! = rdttrc (restarting with Euler time stepping)
+         ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1
+            r2dt = 2. * rdttrc(1)       ! = 2 rdttrc (leapfrog)
+         ENDIF
+      ENDIF
+
 
       IF( kt == nittrc000 ) THEN
@@ -77,4 +101,25 @@
          IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition'
          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
+           zfact = 1._wp
+           sbc_trc_b(:,:,:) = 0._wp
+         ENDIF
+      ELSE                                         ! Swap of forcing fields
+         IF( ln_top_euler ) THEN
+            zfact = 1._wp
+            sbc_trc_b(:,:,:) = 0._wp
+         ELSE
+            zfact = 0.5_wp
+            sbc_trc_b(:,:,:) = sbc_trc(:,:,:)
+         ENDIF
+         !
       ENDIF
 
@@ -90,16 +135,47 @@
 
       ! 0. initialization
-      zsrau = 1. / rau0
       DO jn = 1, jptra
          !
          IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends
          !                                             ! add the trend to the general tracer trend
+
+         IF ( nn_ice_tr == -1 ) THEN  ! No tracers in sea ice (null concentration in sea ice)
+
+            DO jj = 2, jpj
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn)
+               END DO
+            END DO
+
+         ELSE
+
+            DO jj = 2, jpj
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zse3t = 1. / fse3t(ji,jj,1)
+                  ! tracer flux at the ice/ocean interface (tracer/m2/s)
+                  zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice
+                  zcd   =   trc_o(ji,jj,jn) * fmmflx(ji,jj) ! concentration dilution due to freezing-melting,
+                                                               ! only used in the levitating sea ice case
+                  ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux
+                  ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux
+                  ztfx  = zftra + zswitch * zcd                ! net tracer flux (+C/D if no ice/ocean mass exchange)
+   
+                  zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) 
+                  IF ( zdtra < 0. ) THEN
+                     zratio = -zdtra * zse3t * r2dt / ( trn(ji,jj,1,jn) + zrtrn )
+                     zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise
+                  ENDIF
+                  sbc_trc(ji,jj,jn) =  zdtra 
+               END DO
+            END DO
+         ENDIF
+         !                                       Concentration dilution effect on tracers due to evaporation & precipitation 
          DO jj = 2, jpj
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zse3t = 1. / fse3t(ji,jj,1)
-               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) *  zsrau * trn(ji,jj,1,jn) * zse3t
+               zse3t = zfact / fse3t(ji,jj,1)
+               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t
             END DO
          END DO
-         
+         !
          IF( l_trdtrc ) THEN
             ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
@@ -109,4 +185,17 @@
       END DO                                                     ! tracer loop
       !                                                          ! ===========
+
+      !                                           Write in the tracer restar  file
+      !                                          *******************************
+      IF( lrst_trc ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in tracer restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         DO jn = 1, jptra
+            CALL iom_rstput( kt, nitrst, numrtw, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc(:,:,jn) )
+         END DO
+      ENDIF
+      !
       IF( ln_ctl )   THEN
          WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout)
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 5682)
@@ -82,5 +82,9 @@
       IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )   ! Update tracer at AGRIF zoom boundaries : children only
 #endif
-         IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )  ! Partial steps: now horizontal gradient of passive
+
+         IF( ln_zps  .AND. .NOT. ln_isfcav)        &
+            &            CALL zps_hde    ( kstp, jptra, trn, gtru, gtrv )   ! Partial steps: now horizontal gradient of passive
+         IF( ln_zps .AND.        ln_isfcav)        &
+            &            CALL zps_hde_isf( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! Partial steps: now horizontal gradient of passive
                                                                 ! tracers at the bottom ocean level
          !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90	(revision 5682)
@@ -73,12 +73,8 @@
       IF( kt == nittrc000 )   CALL zdf_ctl          ! initialisation & control of options
 
-      IF( ln_top_euler) THEN
-         r2dt(:) =  rdttrc(:)              ! = rdttrc (use Euler time stepping)
-      ELSE
-         IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000
-            r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping)
-         ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1
-            r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
-         ENDIF
+      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000
+         r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping)
+      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1
+         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
       ENDIF
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90	(revision 5682)
@@ -71,5 +71,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header:  $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90	(revision 5682)
@@ -23,5 +23,5 @@
    !!---------------------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmxl_rst.F90,v 1.6 2006/11/14 09:46:13 opalod Exp $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!---------------------------------------------------------------------------------
@@ -39,5 +39,6 @@
       !
       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
-      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name
+      CHARACTER(LEN=50)   ::   clname   ! output restart file name
+      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file
       CHARACTER (len=35) :: charout
       INTEGER :: jl,  jk, jn               ! loop indice
@@ -51,6 +52,8 @@
          ENDIF
          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_trc_out)
-         IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  '//clname
-         CALL iom_open( clname, nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib )
+         clpath = TRIM(cn_trcrst_outdir)
+         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+         IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  'TRIM(clpath)//TRIM(clname)
+         CALL iom_open( TRIM(clpath)//TRIM(clname), nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib )
       ENDIF
 
@@ -133,4 +136,5 @@
       INTEGER ::  jlibalt = jprstlib
       LOGICAL ::  llok
+      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file
       !!-----------------------------------------------------------------------------
       
@@ -141,12 +145,15 @@
       ENDIF
       
+      clpath = TRIM(cn_trcrst_indir)
+      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+
       IF ( jprstlib == jprstdimg ) THEN
         ! eventually read netcdf file (monobloc)  for restarting on different number of processors
         ! if {cn_trdrst_trc_in}.nc exists, then set jlibalt to jpnf90
-        INQUIRE( FILE = TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok )
+        INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok )
         IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
       ENDIF
 
-      CALL iom_open( cn_trdrst_trc_in, inum, kiolib = jlibalt ) 
+      CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum, kiolib = jlibalt ) 
       
       IF( ln_trdmxl_trc_instant ) THEN 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90	(revision 5682)
@@ -33,5 +33,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header:  $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90	(revision 5682)
@@ -118,5 +118,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmxl_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 5682)
@@ -87,7 +87,9 @@
    USE sbc_oce , ONLY :   fmmflx     =>    fmmflx     !: freshwater budget: volume flux               [Kg/m2/s]
    USE sbc_oce , ONLY :   rnf        =>    rnf        !: river runoff   [Kg/m2/s]
-   USE sbc_oce , ONLY :   ln_dm2dc   =>    ln_dm2dc   !: Daily mean to Diurnal Cycle short wave (qsr) 
+   USE sbc_oce , ONLY :   ln_dm2dc   =>    ln_dm2dc   !: Diurnal Cycle 
+   USE sbc_oce , ONLY :   ncpl_qsr_freq   =>   ncpl_qsr_freq   !: qsr coupling frequency per days from atmospher
    USE sbc_oce , ONLY :   ln_rnf     =>    ln_rnf     !: runoffs / runoff mouths
    USE sbc_oce , ONLY :   fr_i       =>    fr_i       !: ice fraction (between 0 to 1)
+   USE sbc_oce , ONLY :   nn_ice_embd => nn_ice_embd  !: flag for  levitating/embedding sea-ice in the ocean
    USE traqsr  , ONLY :   rn_abs     =>    rn_abs     !: fraction absorbed in the very near surface
    USE traqsr  , ONLY :   rn_si0     =>    rn_si0     !: very near surface depth of extinction
@@ -96,4 +98,5 @@
    USE sbcrnf  , ONLY :   rnfmsk_z   =>    rnfmsk_z   !: mixed adv scheme in runoffs vicinity (vert.)
    USE sbcrnf  , ONLY :   h_rnf      =>    h_rnf      !: river runoff   [Kg/m2/s]
+   USE sbcrnf  , ONLY :   nk_rnf     =>    nk_rnf     !: depth of runoff in model level
 
    USE trc_oce
@@ -135,4 +138,5 @@
 # endif
 
+   USE diaar5 , ONLY :   lk_diaar5  =>   lk_diaar5
 #else
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 5682)
@@ -34,7 +34,13 @@
    REAL(wp), PUBLIC                                                ::  areatot        !: total volume 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  cvol           !: volume correction -degrad option- 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: traceur concentration for now time step
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: traceur concentration for next time step
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: traceur concentration for before time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: tracer concentration for now time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: tracer concentration for next time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: tracer concentration for before time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc_b      !: Before sbc fluxes for tracers
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc        !: Now sbc fluxes for tracers
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_i          !: prescribed tracer concentration in sea ice for SBC
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_o          !: prescribed tracer concentration in ocean for SBC
+   INTEGER             , PUBLIC                                    ::  nn_ice_tr      !: handling of sea ice tracers
 
    !! interpolated gradient
@@ -44,4 +50,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrui          !: hor. gradient at u-points at top    ocean level
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrvi          !: hor. gradient at v-points at top    ocean level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)             ::  qsr_mean        !: daily mean qsr
    
    !! passive tracers  (input and output)
@@ -54,5 +61,7 @@
    INTEGER             , PUBLIC                                    ::  nn_rsttr       !: control of the time step ( 0 or 1 ) for pass. tr.
    CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_in   !: suffix of pass. tracer restart name (input)
+   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_indir  !: restart input directory
    CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output)
+   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_outdir  !: restart output directory
    REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step
    LOGICAL             , PUBLIC                                    ::  ln_top_euler  !: boolean term for euler integration 
@@ -61,4 +70,17 @@
    LOGICAL             , PUBLIC                                    ::  ln_trcdmp_clo  !: internal damping flag on closed seas
    INTEGER             , PUBLIC                                    ::  nittrc000       !: first time step of passive tracers model
+   LOGICAL             , PUBLIC                                    ::  l_trcdm2dc     !: Diurnal cycle for TOP
+
+   !! Information for the ice module for tracers
+   !! ------------------------------------------
+   TYPE TRC_I_NML                    !--- Ice tracer namelist structure
+         REAL(wp)         :: trc_ratio  ! ice-ocean trc ratio
+         REAL(wp)         :: trc_prescr ! prescribed ice trc cc
+         CHARACTER(len=2) :: ctrc_o     ! choice of ocean trc cc
+   END TYPE
+
+   REAL(wp), DIMENSION(jptra), PUBLIC         :: trc_ice_ratio, & ! ice-ocean tracer ratio
+                                                 trc_ice_prescr   ! prescribed ice trc cc
+   CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc
 
    !! information for outputs
@@ -172,5 +194,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3.1 , NEMO Consortium (2010)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -185,9 +207,11 @@
       !
       ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &  
+         &      trc_i(jpi,jpj,jptra)  , trc_o(jpi,jpj,jptra)                          ,       &
          &      gtru (jpi,jpj,jptra)  , gtrv (jpi,jpj,jptra)                          ,       &
          &      gtrui(jpi,jpj,jptra)  , gtrvi(jpi,jpj,jptra)                          ,       &
+         &      sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra)                      ,       &  
          &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       &
          &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       & 
-         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)                             ,  STAT = trc_alloc  )  
+         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)     , qsr_mean(jpi,jpj)     ,  STAT = trc_alloc  )  
 
       IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays')
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcbc.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcbc.F90	(revision 5682)
@@ -44,5 +44,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id: trcdta.F90 2977 2011-10-22 13:46:41Z cetlod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 5682)
@@ -223,4 +223,9 @@
                            sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1)
                         ENDIF
+                        ik = mikt(ji,jj)
+                        IF( ik > 1 ) THEN
+                           zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
+                           sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik+1)
+                        ENDIF
                      END DO
                   END DO
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcice.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcice.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcice.F90	(revision 5682)
@@ -0,0 +1,73 @@
+MODULE trcice
+   !!======================================================================
+   !!                         ***  MODULE trcice  ***
+   !! TOP :   Manage the communication between TOP and sea ice
+   !!======================================================================
+   !! History :  3.5  ! 2013    (M. Vancoppenolle, O. Aumont, G. Madec), original code
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_ice   :  Call the appropriate sea ice tracer subroutine
+   !!----------------------------------------------------------------------
+
+   USE oce_trc         ! shared variables between ocean and passive tracers
+   USE trc             ! passive tracers common variables
+   USE trcice_cfc      ! CFC      initialisation
+   USE trcice_pisces   ! PISCES   initialisation
+   USE trcice_c14b     ! C14 bomb initialisation
+   USE trcice_my_trc   ! MY_TRC   initialisation
+   
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   trc_ice_ini ! called by trc_nam
+
+CONTAINS
+   
+   SUBROUTINE trc_ice_ini
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ice_ini ***
+      !!
+      !! ** Purpose :   Initialization of the ice module for tracers
+      !!
+      !! ** Method  : - 
+      !!            
+      !!---------------------------------------------------------------------
+      ! --- Variable declarations --- !
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_ice_ini : Initialize sea ice tracer boundary condition'
+         WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+
+      IF( nn_timing == 1 )  CALL timing_start('trc_ice_ini')
+
+      !
+      trc_i(:,:,:) = 0.0d0 ! by default
+      trc_o(:,:,:) = 0.0d0 ! by default
+
+      IF ( nn_ice_tr == 1 ) THEN
+         IF( lk_pisces  )    CALL trc_ice_ini_pisces       ! PISCES  bio-model
+         IF( lk_cfc     )    CALL trc_ice_ini_cfc          ! CFC     tracers
+         IF( lk_c14b    )    CALL trc_ice_ini_c14b         ! C14 bomb  tracer
+         IF( lk_my_trc  )    CALL trc_ice_ini_my_trc       ! MY_TRC  tracers
+      ENDIF
+
+      IF( nn_timing == 1 )   CALL timing_stop('trc_ice_ini')
+      !
+   END SUBROUTINE trc_ice_ini
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ice_ini                   ! Dummy routine   
+   END SUBROUTINE trc_ice_ini
+#endif
+
+   !!======================================================================
+END MODULE trcice
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcini.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 5682)
@@ -31,4 +31,5 @@
    USE lib_mpp         ! distribued memory computing library
    USE sbc_oce
+   USE trcice          ! tracers in sea ice
  
    IMPLICIT NONE
@@ -71,9 +72,9 @@
       CALL top_alloc()              ! allocate TOP arrays
 
-#if defined key_offline
-      ltrcdm2dc = .FALSE.
-#endif
-
-      IF( ltrcdm2dc )CALL ctl_warn( ' Diurnal cycle on physics but not in PISCES or LOBSTER ' )
+      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 )
+      l_trcdm2dc = l_trcdm2dc  .AND. .NOT. lk_offline
+      IF( l_trcdm2dc .AND. lwp ) &
+         &   CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. &
+         & Computation of a daily mean shortwave for some biogeochemical models) ')
 
       IF( nn_cla == 1 )   &
@@ -100,4 +101,6 @@
       IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer
       IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers
+
+      CALL trc_ice_ini                                 ! Tracers in sea ice
 
       IF( lwp ) THEN
@@ -143,6 +146,9 @@
  
       tra(:,:,:,:) = 0._wp
-      IF( ln_zps .AND. .NOT. lk_c1d )   &              ! Partial steps: before horizontal gradient of passive
-        &    CALL zps_hde( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )       ! tracers at the bottom ocean level
+      IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav )   &              ! Partial steps: before horizontal gradient of passive
+        &    CALL zps_hde    ( nit000, jptra, trn, gtru, gtrv  )  ! Partial steps: before horizontal gradient
+      IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav )   &
+        &    CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )       ! tracers at the bottom ocean level
+
 
       !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 5682)
@@ -39,5 +39,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -147,4 +147,8 @@
 
 
+      ! Call the ice module for tracers
+      ! -------------------------------
+      CALL trc_nam_ice
+
       ! namelist of SMS
       ! ---------------      
@@ -175,5 +179,6 @@
       !!---------------------------------------------------------------------
       NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, &
-        &                  cn_trcrst_in, cn_trcrst_out
+        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out
+
 
       INTEGER  ::   ios                 ! Local integer output status for namelist read
@@ -215,4 +220,54 @@
     END SUBROUTINE trc_nam_run
 
+   SUBROUTINE trc_nam_ice
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_nam_ice ***
+      !!
+      !! ** Purpose :   Read the namelist for the ice effect on tracers
+      !!
+      !! ** Method  : -
+      !!
+      !!---------------------------------------------------------------------
+      ! --- Variable declarations --- !
+      INTEGER :: jn      ! dummy loop indices
+      INTEGER :: ios     ! Local integer output status for namelist read
+
+      ! --- Namelist declarations --- !
+      TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer
+      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      ENDIF
+
+      IF( nn_timing == 1 )  CALL timing_start('trc_nam_ice')
+
+      !
+      REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data
+      READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901)
+ 901  IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp )
+
+      REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients
+      READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 )
+ 902  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp )
+
+      IF( lwp ) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr
+         WRITE(numout,*) ' '
+      ENDIF
+
+      ! Assign namelist stuff
+      DO jn = 1, jptra
+         trc_ice_ratio(jn)  = sn_tri_tracer(jn)%trc_ratio
+         trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr
+         cn_trc_o      (jn) = sn_tri_tracer(jn)%ctrc_o
+      END DO
+
+      IF( nn_timing == 1 )   CALL timing_stop('trc_nam_ice')
+      !
+   END SUBROUTINE trc_nam_ice
 
    SUBROUTINE trc_nam_trc
@@ -339,6 +394,6 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
-END MODULE  trcnam
+END MODULE trcnam
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 5682)
@@ -51,4 +51,5 @@
       CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
       CHARACTER(LEN=50)   ::   clname   ! trc output restart file name
+      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file
       !!----------------------------------------------------------------------
       !
@@ -56,8 +57,13 @@
          IF( kt == nittrc000 ) THEN
             lrst_trc = .FALSE.
-            nitrst = nitend
-         ENDIF
-
-         IF( MOD( kt - 1, nstock ) == 0 ) THEN
+            IF( ln_rst_list ) THEN
+               nrst_lst = 1
+               nitrst = nstocklist( nrst_lst )
+            ELSE
+               nitrst = nitend
+            ENDIF
+         ENDIF
+
+         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
             ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
             nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
@@ -79,6 +85,9 @@
          IF(lwp) WRITE(numout,*)
          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
-         IF(lwp) WRITE(numout,*) '             open trc restart.output NetCDF file: '//clname
-         CALL iom_open( clname, numrtw, ldwrt = .TRUE., kiolib = jprstlib )
+         clpath = TRIM(cn_trcrst_outdir)
+         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+         IF(lwp) WRITE(numout,*) &
+             '             open trc restart.output NetCDF file: ',TRIM(clpath)//clname
+         CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib )
          lrst_trc = .TRUE.
       ENDIF
@@ -140,4 +149,8 @@
           lrst_trc = .FALSE.
 #endif
+          IF( lk_offline .AND. ln_rst_list ) THEN
+             nrst_lst = nrst_lst + 1
+             nitrst = nstocklist( nrst_lst )
+          ENDIF
       ENDIF
       !
@@ -190,39 +203,36 @@
            ! eventually read netcdf file (monobloc)  for restarting on different number of processors
            ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 
-           INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
+           INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
            IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
          ENDIF
 
-         CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt )
-
-         CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
-
-         IF(lwp) THEN
-            WRITE(numout,*) ' *** Info read in restart : '
-            WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
-            WRITE(numout,*) ' *** restart option'
-            SELECT CASE ( nn_rsttr )
-            CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
-            CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
-            CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
-            END SELECT
-            WRITE(numout,*)
-         ENDIF
-         ! Control of date 
-         IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  &
-            &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
-            &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
-         IF( lk_offline ) THEN      ! set the date in offline mode
-            ! Check dynamics and tracer time-step consistency and force Euler restart if changed
-            IF( iom_varid( numrtr, 'rdttrc1', ldstop = .FALSE. ) > 0 )   THEN
-               CALL iom_get( numrtr, 'rdttrc1', zrdttrc1 )
-               IF( zrdttrc1 /= rdt * nn_dttrc )   neuler = 0
-            ENDIF
-            !                          ! define ndastp and adatrj
-            IF( nn_rsttr == 2 ) THEN
+         IF( ln_rsttr ) THEN
+            CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt )
+            CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
+
+            IF(lwp) THEN
+               WRITE(numout,*) ' *** Info read in restart : '
+               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
+               WRITE(numout,*) ' *** restart option'
+               SELECT CASE ( nn_rsttr )
+               CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
+               CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
+               CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
+               END SELECT
+               WRITE(numout,*)
+            ENDIF
+            ! Control of date 
+            IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  &
+               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
+               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
+         ENDIF
+         !
+         IF( lk_offline ) THEN    
+            !                                          ! set the date in offline mode
+            IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN
                CALL iom_get( numrtr, 'ndastp', zndastp ) 
                ndastp = NINT( zndastp )
                CALL iom_get( numrtr, 'adatrj', adatrj  )
-            ELSE
+             ELSE
                ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
                adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
@@ -235,4 +245,8 @@
               WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
               WRITE(numout,*)
+            ENDIF
+            !
+            IF( ln_rsttr )  THEN   ;    neuler = 1
+            ELSE                   ;    neuler = 0
             ENDIF
             !
@@ -265,4 +279,5 @@
       INTEGER  :: jk, jn
       REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
       !!----------------------------------------------------------------------
 
@@ -273,6 +288,10 @@
       ENDIF
       !
-      DO jn = 1, jptra
-         ztraf = glob_sum( trn(:,:,:,jn) * cvol(:,:,:) )
+      DO jk = 1, jpk
+         zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
+      END DO
+      !
+      DO jn = 1, jptra
+         ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) )
          zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
          zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
@@ -306,5 +325,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 5682)
@@ -75,3 +75,3 @@
 
    !!======================================================================
-END MODULE  trcsms
+END MODULE trcsms
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 5682)
@@ -30,4 +30,10 @@
    PUBLIC   trc_stp    ! called by step
 
+   REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr ! save qsr during TOP time-step
+   REAL(wp) :: rdt_sampl
+   INTEGER  :: nb_rec_per_days
+   INTEGER  :: isecfst, iseclast
+   LOGICAL  :: llnew
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -54,5 +60,4 @@
       CHARACTER (len=25)    ::  charout 
 
-      REAL(wp), DIMENSION(:,:), POINTER ::   zqsr_tmp ! save qsr during TOP time-step
       !!-------------------------------------------------------------------
       !
@@ -68,12 +73,6 @@
          areatot         = glob_sum( cvol(:,:,:) )
       ENDIF
-      !    
-      IF( ltrcdm2dc ) THEN
-         ! When Diurnal cycle, core bulk and LIM2  are activated, put daily mean qsr in qsr for TOP/biogeochemistery time-step
-         ! and save qsr with diurnal cycle in qsr_tmp
-         CALL wrk_alloc( jpi,jpj, zqsr_tmp )
-         zqsr_tmp(:,:) = qsr     (:,:)
-         qsr     (:,:) = qsr_mean(:,:)    
-      ENDIF
+      !
+      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt )
       !    
       IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping
@@ -106,10 +105,4 @@
       ENDIF
       !
-      IF( ltrcdm2dc ) THEN
-         ! put back qsr with diurnal cycle in qsr
-         qsr(:,:) = zqsr_tmp(:,:)
-         CALL wrk_dealloc( jpi,jpj, zqsr_tmp )
-      ENDIF
-      !
       ztrai = 0._wp                                                   !  content of all tracers
       DO jn = 1, jptra
@@ -122,4 +115,60 @@
       !
    END SUBROUTINE trc_stp
+
+   SUBROUTINE trc_mean_qsr( kt )
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE trc_mean_qsr  ***
+      !!
+      !! ** Purpose :  Compute daily mean qsr for biogeochemical model in case
+      !!               of diurnal cycle
+      !!
+      !! ** Method  : store in TOP the qsr every hour ( or every time-step the latter 
+      !!              is greater than 1 hour ) and then, compute the  mean with 
+      !!              a moving average over 24 hours. 
+      !!              In coupled mode, the sampling is done at every coupling frequency 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt
+      INTEGER  :: jn
+
+      IF( kt == nittrc000 ) THEN
+         IF( ln_cpl )  THEN  
+            rdt_sampl = 86400. / ncpl_qsr_freq
+            nb_rec_per_days = ncpl_qsr_freq
+         ELSE  
+            rdt_sampl = MAX( 3600., rdt * nn_dttrc )
+            nb_rec_per_days = INT( 86400 / rdt_sampl )
+         ENDIF
+         !
+         IF( lwp ) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_days
+            WRITE(numout,*) 
+         ENDIF
+         !
+         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) )
+         DO jn = 1, nb_rec_per_days
+            qsr_arr(:,:,jn) = qsr(:,:)
+         ENDDO
+         qsr_mean(:,:) = qsr(:,:)
+         !
+         isecfst  = nsec_year + nsec1jan000   !   number of seconds between Jan. 1st 00h of nit000 year and the middle of time step
+         iseclast = isecfst
+         !
+      ENDIF
+      !
+      iseclast = nsec_year + nsec1jan000
+      llnew   = ( iseclast - isecfst )  > INT( rdt_sampl )   !   new shortwave to store
+      IF( kt /= nittrc000 .AND. llnew ) THEN
+          IF( lwp ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', kt, &
+             &                      ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours '
+          isecfst = iseclast
+          DO jn = 1, nb_rec_per_days - 1
+             qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
+          ENDDO
+          qsr_arr (:,:,nb_rec_per_days) = qsr(:,:)
+          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days
+      ENDIF
+      !
+   END SUBROUTINE trc_mean_qsr
 
 #else
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 5682)
@@ -48,5 +48,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
-   !! $Id: trcstp.F90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! $Id$ 
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-IBM_EKMAN_INGV
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-IBM_EKMAN_INGV	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-IBM_EKMAN_INGV	(revision 5682)
@@ -2,5 +2,5 @@
 #!
 #BSUB -q long
-#BSUB -n NPROCS
+#BSUB -n TOTAL_NPROCS
 #BSUB -J MPI_config
 #BSUB -o stdout.%J
@@ -14,4 +14,5 @@
 #
   OCEANCORES=NPROCS
+  XIOS_NUMPROCS=NXIOPROCS
   export SETTE_DIR=DEF_SETTE_DIR
 
@@ -23,7 +24,11 @@
 #
 
+ MPIPROGINF=detail
+ export MPIPROGINF
+ export LSF_PJL_TYPE="intelmpi"
+ export MP_PGMMODEL=mpmd
+ export MP_SHARED_MEMORY=yes
  export MPIRUN="mpirun -n $OCEANCORES"
-
-#export MPIRUN="mpirun -np"
+ export MPIRUN_MPMD="mpirun -np $OCEANCORES ./opa : -np $XIOS_NUMPROCS /home/delrosso/XIOS_1.0/xios-1.0/bin/xios_server.exe"
 
 #
@@ -67,7 +72,11 @@
 
   if [ MPI_FLAG == "yes" ]; then
-     time ${MPIRUN} ./opa
+     if [ $XIOS_NUMPROCS -eq 0 ]; then
+       time ${MPIRUN} ./opa
+     else
+       time ${MPIRUN_MPMD}
+     fi
   else
-     time ./opa
+       time ./opa
   fi
 #
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_CURIE
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_CURIE	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_CURIE	(revision 5682)
@@ -8,5 +8,5 @@
 #MSUB -n NPROCS              # Total number of mpi task to use
 ####  #MSUB -N 2                   # number of nodes to use
-#MSUB -A gen0826             # project name
+#MSUB -ra2286             # project name
 #MSUB -q standard            # (queue name) only for thin nodes
 ##########################################################################
@@ -33,6 +33,6 @@
 module unload netcdf
 module unload hdf5
-module load netcdf/4.2_hdf5_parallel
-module load hdf5/1.8.9_parallel
+module load netcdf/4.3.3.1_hdf5_parallel
+module load hdf5/1.8.12_parallel
 
 # Don't remove neither change the following line
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC40_METO
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC40_METO	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC40_METO	(revision 5682)
@@ -0,0 +1,95 @@
+#/bin/bash 
+#!
+#PBS -N nemo_sette
+#PBS -l walltime=00:30:00
+#PBS -j oe
+#PBS -q QUEUE
+#PBS -l SELECT
+
+  export PBS_O_WORKDIR=$(readlink -f $PBS_O_WORKDIR)
+  export OMP_NUM_THREADS=1
+  cd $PBS_O_WORKDIR
+  export XIO_HOME=/projects/ocean/nemo/xios/xios_1.0_r618_20150619/XIOS
+#
+  echo " ";
+  export OMP_NUM_THREADS=1
+  O_PER_NODE=32
+  X_PER_NODE=4
+  OCORES=NPROCS
+  XCORES=NXIOPROCS
+  if [ $OCORES -le 32 ] ; then O_PER_NODE=$OCORES; fi
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+###############################################################
+#
+# Don't remove neither change the following line
+# BODY
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). Note that the number of compute nodes required
+# is also set by the fcm_job.sh on the PBS select header line above.
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+  export EXE_DIR=DEF_EXE_DIR
+  ulimit -c unlimited
+  ulimit -s unlimited
+  export FORT_FMT_RECL=132
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+  cd $EXE_DIR
+  echo Directory is `pwd`
+  
+  if [ $XCORES -gt 0 ]; then
+#
+#  Run MPMD case
+#
+     #XIOS will run on a separate node so will run in parallel queue
+     if [ ! -f ./xios_server.exe ] && [ -f ${XIO_HOME}/bin/xios_server.exe ]; then
+        cp ${XIO_HOME}/bin/xios_server.exe .
+     fi
+     if [ ! -f ./xios_server.exe ]; then
+        echo "./xios_server.exe not found"
+        echo "run aborted"
+        exit
+     fi
+       echo time aprun -b -n $XCORES -N $X_PER_NODE ./xios_server.exe : -n $OCORES -N $O_PER_NODE ./opa
+            time aprun -b -n $XCORES -N $X_PER_NODE ./xios_server.exe : -n $OCORES -N $O_PER_NODE ./opa
+#
+  else
+#
+# Run SPMD case
+#
+    if [ $OCORES -gt 32 ] ; then
+        #Still more than one node so run in parallel queue
+        echo time aprun -b  -n $OCORES -N $O_PER_NODE ./opa
+             time aprun -b  -n $OCORES -N $O_PER_NODE ./opa
+    else
+       echo time mpiexec -n $OCORES ./opa
+            time mpiexec -n $OCORES ./opa
+    fi
+  fi
+#
+
+#
+  post_test_tidyup
+# END_BODY
+# Don't remove neither change the previous line
+  exit
+
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_MERCATOR_CLUSTER
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_MERCATOR_CLUSTER	(revision 5659)
+++ 	(revision )
@@ -1,74 +1,0 @@
-#!/bin/bash 
-#!
-#PBS -N sette
-#PBS -e sette.$PBS_JOBID.err
-#PBS -o sette.$PBS_JOBID.out
-#PBS -l nodes=NODES:ppn=NPROC_NODE
-#PBS -q QUEUE
-#PBS -l walltime=03:00:00
-#PBS -l pvmem=5gb
-
-#
-# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
-# (via sed operating on this template job file). 
-#
-  OCEANCORES=NPROCS
-  export SETTE_DIR=DEF_SETTE_DIR
-
-###############################################################
-#
-# set up mpp computing environment
-#
-# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
-#
-#cbr export MPIRUN="mpiexec -n $OCEANCORES"
-export MPIRUN="mpirun -np $OCEANCORES"
-
-#
-# load sette functions (only post_test_tidyup needed)
-#
-  . ${SETTE_DIR}/all_functions.sh
-#
-
-# Don't remove neither change the following line
-# BODY
-
-#
-# These variables are needed by post_test_tidyup function in all_functions.sh
-#
-  export EXE_DIR=DEF_EXE_DIR
-  export INPUT_DIR=DEF_INPUT_DIR
-  export CONFIG_DIR=DEF_CONFIG_DIR
-  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
-  export NEW_CONF=DEF_NEW_CONF
-  export CMP_NAM=DEF_CMP_NAM
-  export TEST_NAME=DEF_TEST_NAME
-#
-# end of set up
-###############################################################
-#
-# change to the working directory 
-#
-cd ${EXE_DIR}
-  echo Running on host `hostname`
-  echo Time is `date`
-  echo Directory is `pwd`
-# 
-#  Run the parallel MPI executable 
-#
-  echo "Running time ${MPIRUN} ./opa"
-#
-  if [ MPI_FLAG == "yes" ]; then
-     mpirun -np $OCEANCORES ./opa
-  else
-     time ./opa
-  fi
-
-#
-  post_test_tidyup
-
-# END_BODY
-# Don't remove neither change the previous line
-
-
-  exit
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR	(revision 5682)
@@ -0,0 +1,74 @@
+#!/bin/bash 
+#!
+#PBS -N sette
+#PBS -e sette.$PBS_JOBID.err
+#PBS -o sette.$PBS_JOBID.out
+#PBS -l nodes=NODES:ppn=NPROC_NODE
+#PBS -q QUEUE
+#PBS -l walltime=03:00:00
+#PBS -l pmem=3gb
+
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
+#
+#cbr export MPIRUN="mpiexec -n $OCEANCORES"
+export MPIRUN="mpirun -np $OCEANCORES"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+#
+
+# Don't remove neither change the following line
+# BODY
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+  echo "Running time ${MPIRUN} ./opa"
+#
+  if [ MPI_FLAG == "yes" ]; then
+     mpirun -np $OCEANCORES ./opa
+  else
+     time ./opa
+  fi
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line
+
+
+  exit
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/prepare_exe_dir.sh
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/prepare_exe_dir.sh	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/prepare_exe_dir.sh	(revision 5682)
@@ -70,5 +70,5 @@
 export EXE_DIR=${CONFIG_DIR}/${NEW_CONF}/${TEST_NAME}
 
-cp -r ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/.
+cp -rL ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/.
 cp -r ${SETTE_DIR}/iodef_sette.xml ${EXE_DIR}/iodef.xml
 cd ${EXE_DIR}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/prepare_job.sh
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/prepare_job.sh	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/prepare_job.sh	(revision 5682)
@@ -226,8 +226,59 @@
                                         # round up the number of nodes required.
                                         #
-                                        NB_NODES=$( echo $NB_NODES $NXIO_PROC | awk '{print ($1 + ( $2 / 4 ) + 1)}')                    
+                                        NB_NODES=$( echo $NB_NODES $NXIO_PROC | awk '{print ($1 + ( $2 / 4 ) + 1)}') 
                                 fi
                                 ;;
-                        ifort_MERCATOR_CLUSTER)
+                        XC40_METO*) #Setup for Met Office XC40 with any compiler
+                                # ocean cores are packed 32 to a node
+                                # If we need more than one node then have to use parallel queue and XIOS must have a node to itself
+                                NB_REM=$( echo $NB_PROC | awk '{print ( $1 % 32 ) }')
+                                if [ ${NB_REM} == 0 ] ; then
+                                        # number of processes required is an integer multiple of 32
+                                        #
+                                        NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{print ($1) / 32}')
+                                else
+                                        #
+                                        # number of processes required is not an integer multiple of 32
+                                        # round up the number of nodes required.
+                                        #
+                                        NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{printf("%d",($1) / 32 + 1 )}')
+                                fi
+                                # xios cores are sparsely packed at 4 to a node
+                                if [ $NXIO_PROC == 0 ] ; then
+                                    NB_XNODES=0
+                                else
+                                    NB_REM=$( echo $NXIO_PROC | awk '{print ( $1 % 4 ) }')
+                                    if [ ${NB_REM} == 0 ] ; then
+                                            # number of processes required is an integer multiple of 4                           
+                                            #
+                                            NB_XNODES=$( echo $NXIO_PROC | awk '{print (( $1 / 4 ) + 1)}') 
+                                    else
+                                            #
+                                            # number of processes required is not an integer multiple of 4                             
+                                            # round up the number of nodes required.
+                                            #
+                                            NB_XNODES=$( echo $NXIO_PROC | awk '{printf("%d",($1) / 4 + 1) }')                    
+                                    fi
+                                fi
+                                if [ ${NB_XNODES} -ge 1 ] ; then
+                                   NB_NODES=$((NB_NODES+NB_XNODES))
+                                fi
+                                echo NB_XNODES=${NB_XNODES} 
+                                echo Total NB_NODES=${NB_NODES}
+                                if [ ${NB_NODES} -eq 1 ] ; then
+                                   QUEUE=shared
+                                   #Not using XIOS in detatched mode and using less than one node so should be ok on shared node
+                                   #Load snplauncher module to allow use of mpiexec
+                                   SELECT="select=1:ncpus=$((NXIO_PROC + NB_PROC))":mem=15GB
+                                   module load cray-snplauncher
+                                   echo 'Shared Queue'
+                                else
+                                   QUEUE=normal
+                                   SELECT="select=$NB_NODES"
+                                   module unload cray-snplauncher #Make sure snplauncher module is not loaded
+                                   echo 'Normal Queue'
+                                fi
+                                ;;
+                        openmpi_NAVITI_MERCATOR)
                                 echo NB_PROCS ${NB_PROC}
                                 echo NB_NODES ${NB_NODES}
@@ -238,12 +289,12 @@
                                    NB_PROC_NODE=${NB_PROC}
                                 else
-                                   if [ ${NB_PROC} -le 8 ] ; then
+                                   if [ ${NB_PROC} -le 16 ] ; then
                                       NB_NODES=1
                                       QUEUE=mono
                                       NB_PROC_NODE=${NB_PROC}
                                    else
-                                      NB_NODES=$( echo $NB_PROC | awk '{print $1 - $1 % 8}'  | awk '{print $1 / 8 }')
+                                      NB_NODES=$( echo $NB_PROC | awk '{print $1 - $1 % 16}'  | awk '{print $1 / 16 }')
                                       QUEUE=multi
-                                      NB_PROC_NODE=8
+                                      NB_PROC_NODE=16
                                   fi
                                 fi
@@ -273,10 +324,12 @@
 
         case ${COMPILER} in
-              ifort_MERCATOR_CLUSTER)
-                    #cat run_sette_test.job | sed -e"s:QUEUE:${QUEUE}:" > run_sette_test1.job 
-                    #cat run_sette_test.job | sed -e"s/NPROC_NODE/${NB_PROC_NODE}/" > run_sette_test1.job 
-                                                 #-e"s/NPROC_NODE/${NB_PROC_NODE}/" > run_sette_test1.job
+              openmpi_NAVITI_MERCATOR)
                     cat run_sette_test.job | sed -e"s/NPROC_NODE/${NB_PROC_NODE}/" \
                                                  -e"s:QUEUE:${QUEUE}:" > run_sette_test1.job
+                    mv run_sette_test1.job run_sette_test.job
+                    ;;
+              XC40_METO*)
+                    cat run_sette_test.job | sed -e"s/QUEUE/${QUEUE}/" \
+                                                 -e"s/SELECT/${SELECT}/" > run_sette_test1.job
                     mv run_sette_test1.job run_sette_test.job
                     ;;
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/sette.sh
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/sette.sh	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/sette.sh	(revision 5682)
@@ -140,6 +140,7 @@
 # SAS             :11 & 12
 # ISOMIP          :13 & 14
-# ORCA2_LIM_OBS:   15
-# ORCA2_AGRIF_LIM :16
+# ORCA2_LIM_OBS   :15
+# ORCA2_AGRIF_LIM :16 & 17 
+#                  18 & 19 
 for config in  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
 
@@ -857,4 +858,6 @@
     export TEST_NAME="REPRO_4_8"
     . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
     cd ${EXE_DIR}
     set_namelist namelist_cfg nn_it000 1
@@ -1000,5 +1003,5 @@
     export TEST_NAME="LONG"
     cd ${CONFIG_DIR}
-    . ./makenemo -m ${CMP_NAM} -n ISOMIP_LONG -r ISOMIP -j 8 del_key ${DEL_KEYS}
+    . ./makenemo -m ${CMP_NAM} -n ISOMIP_LONG -u ISOMIP -j 8 del_key ${DEL_KEYS}
     cd ${SETTE_DIR}
     . ./param.cfg
@@ -1068,5 +1071,5 @@
     export TEST_NAME="REPRO_1_4"
     cd ${CONFIG_DIR}
-    . ./makenemo -m ${CMP_NAM} -n ISOMIP_4 -r ISOMIP -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS}
+    . ./makenemo -m ${CMP_NAM} -n ISOMIP_4 -u ISOMIP -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS}
     cd ${SETTE_DIR}
     . ./param.cfg
@@ -1133,5 +1136,5 @@
     export TEST_NAME="REPRO_4_4"
     cd ${CONFIG_DIR}
-    . ./makenemo -m ${CMP_NAM} -n ORCA2_LIM_OBS -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_diaobs key_asminc" del_key ${DEL_KEYS}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2_LIM_OBS -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_asminc" del_key ${DEL_KEYS}
     cd ${SETTE_DIR}
     . ./param.cfg
@@ -1150,13 +1153,10 @@
     set_namelist namelist_cfg jpnj 4
     set_namelist namelist_cfg jpnij 16
-    set_namelist namelist_cfg nn_solv 2   
+    set_namelist namelist_cfg nn_solv 2
+    set_namelist namelist_cfg ln_diaobs .true.
     set_namelist namelist_cfg ln_t3d .true.
     set_namelist namelist_cfg ln_s3d .true.
-    set_namelist namelist_cfg ln_profb .true.
     set_namelist namelist_cfg ln_sst .true.
-    set_namelist namelist_cfg ln_sstfb .true.
     set_namelist namelist_cfg ln_sla .true.
-    set_namelist namelist_cfg ln_slafb .true.
-    set_namelist namelist_cfg ln_seaice .false.
     set_namelist namelist_cfg ln_bkgwri .true.
     set_namelist namelist_cfg ln_trainc .true.
@@ -1190,12 +1190,9 @@
     set_namelist namelist_cfg jpnij 16
     set_namelist namelist_cfg nn_solv 2
+    set_namelist namelist_cfg ln_diaobs .true.
     set_namelist namelist_cfg ln_t3d .true.
     set_namelist namelist_cfg ln_s3d .true.
-    set_namelist namelist_cfg ln_profb .true.
     set_namelist namelist_cfg ln_sst .true.
-    set_namelist namelist_cfg ln_sstfb .true.
     set_namelist namelist_cfg ln_sla .true.
-    set_namelist namelist_cfg ln_slafb .true.
-    set_namelist namelist_cfg ln_seaice .false.
     set_namelist namelist_cfg ln_bkgwri .true.
     set_namelist namelist_cfg ln_trainc .true.
@@ -1235,8 +1232,10 @@
     set_namelist namelist_cfg jpnj 2
     set_namelist namelist_cfg jpnij 2
+#
     set_namelist 1_namelist_cfg nn_it000 1
     set_namelist 1_namelist_cfg nn_itend 150
     set_namelist 1_namelist_cfg ln_ctl .false.
     set_namelist 1_namelist_cfg ln_clobber .true.
+
     if [ ${USING_MPMD} == "yes" ] ; then
        set_xio_using_server iodef.xml true
@@ -1250,3 +1249,229 @@
 fi
 
+# test code corruption with AGRIF
+# Compile and run with or without AGRIF ORCA2_LIM
+if [ ${config} -eq 17 ] ;  then
+    # First run same as 16 but without zoom
+    export TEST_NAME="SHORT_NOZOOM"
+    cd ${CONFIG_DIR}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_2_2 -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_agrif" del_key "key_zdftmx" del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=4
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 75
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 2
+    set_namelist namelist_cfg jpnj 2
+    set_namelist namelist_cfg jpnij 4
+# 
+#   Set the number of fine grids to zero:    
+    sed -i "1s/.*/0/" ${EXE_DIR}/AGRIF_FixedGrids.in
+
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+    export TEST_NAME="SHORT_NOAGRIF"
+    cd ${CONFIG_DIR}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_2_2_NAG -r ORCA2_LIM -j 8 add_key "key_mpp_rep" del_key "key_zdftmx" del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=4
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 75
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 2
+    set_namelist namelist_cfg jpnj 2
+    set_namelist namelist_cfg jpnij 4
+#
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+fi
+
+## Restartability tests for ORCA2_LIM_AGRIF 
+if [ ${config} -eq 18 ] ;  then
+    export TEST_NAME="LONG"
+    cd ${CONFIG_DIR}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_LONG -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_agrif" del_key "key_zdftmx" del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=4
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"O2LP_LONG\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 150
+    set_namelist namelist_cfg nn_stock 75
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 2
+    set_namelist namelist_cfg jpnj 2
+    set_namelist namelist_cfg jpnij 4
+    set_namelist namelist_cfg nn_solv 2
+#
+    set_namelist 1_namelist_cfg cn_exp \"O2LP_LONG\"
+    set_namelist 1_namelist_cfg nn_it000 1
+    set_namelist 1_namelist_cfg nn_itend 300
+    set_namelist 1_namelist_cfg nn_stock 150
+    set_namelist 1_namelist_cfg ln_ctl .false.
+    set_namelist 1_namelist_cfg ln_clobber .true.
+#
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . ./prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"O2LP_SHORT\"
+    set_namelist namelist_cfg nn_it000 76
+    set_namelist namelist_cfg nn_itend 150
+    set_namelist namelist_cfg nn_stock 75
+    set_namelist namelist_cfg ln_rstart .true.
+    set_namelist namelist_cfg nn_rstctl 2
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 2
+    set_namelist namelist_cfg jpnj 2
+
+    set_namelist namelist_cfg jpnij 4
+    set_namelist namelist_cfg nn_solv 2
+    set_namelist 1_namelist_cfg cn_exp \"O2LP_SHORT\"
+    set_namelist 1_namelist_cfg nn_it000 151
+    set_namelist 1_namelist_cfg nn_itend 300
+    set_namelist 1_namelist_cfg nn_stock 150
+    set_namelist 1_namelist_cfg ln_rstart .true.
+    set_namelist 1_namelist_cfg nn_rstctl 2
+    set_namelist 1_namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg cn_ocerst_in \"O2LP_LONG_00000075_restart\"
+    set_namelist namelist_ice_cfg cn_icerst_in \"O2LP_LONG_00000075_restart_ice\"
+
+    set_namelist 1_namelist_cfg cn_ocerst_in \"O2LP_LONG_00000150_restart\"
+
+    for (( i=1; i<=$NPROC; i++)) ; do
+        L_NPROC=$(( $i - 1 ))
+        L_NPROC=`printf "%04d\n" ${L_NPROC}`
+        ln -sf ../LONG/O2LP_LONG_00000075_restart_${L_NPROC}.nc .
+        ln -sf ../LONG/O2LP_LONG_00000075_restart_ice_${L_NPROC}.nc .
+        ln -sf ../LONG/1_O2LP_LONG_00000150_restart_${L_NPROC}.nc .
+    done
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+
+## Reproducibility tests for ORCA2_LIM_AGRIF
+if [ ${config} -eq 19 ] ;  then
+    export TEST_NAME="REPRO_4_4"
+    cd ${CONFIG_DIR}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_16 -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_agrif" del_key "key_zdftmx" del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=16
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 75
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 4
+    set_namelist namelist_cfg jpnij 16
+    set_namelist namelist_cfg nn_solv 2
+#
+    set_namelist 1_namelist_cfg nn_it000 1
+    set_namelist 1_namelist_cfg nn_itend 150
+    set_namelist 1_namelist_cfg ln_ctl .false.
+    set_namelist 1_namelist_cfg ln_clobber .true.
+
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="REPRO_2_8"
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=16
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 75
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 2
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 16
+    set_namelist namelist_cfg nn_solv 2
+#
+    set_namelist 1_namelist_cfg nn_it000 1
+    set_namelist 1_namelist_cfg nn_itend 150
+    set_namelist 1_namelist_cfg ln_ctl .false.
+    set_namelist 1_namelist_cfg ln_clobber .true.
+
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+
 done
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/sette_rpt
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/sette_rpt	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/sette_rpt	(revision 5682)
@@ -440,4 +440,88 @@
   endif
 
+
+  if ( -d ./WORCA2AGUL_LONG ) then
+    set dorv = `ls -1rtd ./WORCA2AGUL_LONG/{$mach}/* | tail -1l `
+    set dorv = $dorv:t
+    set f1o = ./WORCA2AGUL_LONG/{$mach}/{$dorv}/LONG/ocean.output
+    set f1s = ./WORCA2AGUL_LONG/{$mach}/{$dorv}/LONG/solver.stat
+    set f2o = ./WORCA2AGUL_LONG/{$mach}/{$dorv}/SHORT/ocean.output
+    set f2s = ./WORCA2AGUL_LONG/{$mach}/{$dorv}/SHORT/solver.stat
+  
+    set nl = `wc -l $f2s`
+    tail -$nl[1] $f1s > f1.tmp$$
+    cmp -s f1.tmp$$ $f2s
+    if ( $status == 0 ) then
+      echo "ORCA2_LIM_AGRIF restartability  passed"
+    else
+      echo "ORCA2_LIM_AGRIF restartability  FAILED"
+      if ( $pass == 1 ) then
+        echo "<return> to view solver.stat differences"
+        set y = $<
+        sdiff f1.tmp$$ $f2s
+        echo "<return> to view ocean.output differences"
+        set y = $<
+        sdiff $f1o $f2o | grep "|"
+        echo "<return> to continue"
+        set y = $<
+      endif
+    endif
+    rm f1.tmp$$
+  endif
+
+  if ( -d ./WORCA2AGUL_16 ) then
+    set dorv = `ls -1rtd ./WORCA2AGUL_16/{$mach}/* | tail -1l `
+    set dorv = $dorv:t
+    set f1o = ./WORCA2AGUL_16/{$mach}/{$dorv}/REPRO_2_8/ocean.output
+    set f1s = ./WORCA2AGUL_16/{$mach}/{$dorv}/REPRO_2_8/solver.stat
+    set f2o = ./WORCA2AGUL_16/{$mach}/{$dorv}/REPRO_4_4/ocean.output
+    set f2s = ./WORCA2AGUL_16/{$mach}/{$dorv}/REPRO_4_4/solver.stat
+  
+    cmp -s $f1s $f2s
+    if ( $status == 0 ) then
+      echo "ORCA2_LIM_AGRIF reproducibility passed"
+    else
+      echo "ORCA2_LIM_AGRIF reproducibility FAILED"
+      if ( $pass == 1 ) then
+        echo "<return> to view solver.stat differences"
+        set y = $<
+        sdiff $f1s $f2s
+        echo "<return> to view ocean.output differences"
+        set y = $<
+        sdiff $f1o $f2o | grep "|"
+        echo "<return> to continue"
+        set y = $<
+      endif
+    endif
+  endif
+
+  if ( -d ./WORCA2AGUL_2_2_NAG ) then
+    set dorv = `ls -1rtd ./WORCA2AGUL_2_2_NAG/{$mach}/* | tail -1l `
+    set dorv = $dorv:t
+    set f1o = ./WORCA2AGUL_2_2_NAG/{$mach}/{$dorv}/SHORT_NOAGRIF/ocean.output
+    set f1s = ./WORCA2AGUL_2_2_NAG/{$mach}/{$dorv}/SHORT_NOAGRIF/solver.stat
+    set dorv = `ls -1rtd ./WORCA2AGUL_2_2/{$mach}/* | tail -1l `
+    set dorv = $dorv:t
+    set f2o = ./WORCA2AGUL_2_2/{$mach}/{$dorv}/SHORT_NOZOOM/ocean.output
+    set f2s = ./WORCA2AGUL_2_2/{$mach}/{$dorv}/SHORT_NOZOOM/solver.stat
+  
+    cmp -s $f1s $f2s
+    if ( $status == 0 ) then
+      echo "ORCA2_LIM_AGRIF code corruption test passed"
+    else
+      echo "ORCA2_LIM_AGRIF code corruption test FAILED"
+      if ( $pass == 1 ) then
+        echo "<return> to view solver.stat differences"
+        set y = $<
+        sdiff $f1s $f2s
+        echo "<return> to view ocean.output differences"
+        set y = $<
+        sdiff $f1o $f2o | grep "|"
+        echo "<return> to continue"
+        set y = $<
+      endif
+    endif
+  endif
+
   echo "<return> for second (more detailed) pass (y/n)"
   set y = $<
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 5682)
@@ -57,8 +57,15 @@
 #- AGRIF conv
 if [ "$AGRIFUSE" == 1 ]; then
+#-MPI for AGRIF
+if [ ! -f ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h ];then
+   echo '#if defined key_mpp_mpi' > ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h
+   echo '#define AGRIF_MPI'      >> ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h
+   echo '#endif'                 >> ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h
+fi
 
-#- CONV
-#fcm build ${TOOLS_DIR}/conv.cfg || exit 1
-gmake -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB
+ #- CONV
+fcm build ${COMPIL_DIR}/conv.cfg || exit 1
+#C_COMPILER=${CC-cc}
+#gmake CC=${C_COMPILER} -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB
 
 #- AGRIF sources
@@ -67,5 +74,6 @@
 [ ! -d $2/$1/OPAFILES/AGRIF_MODELFILES ] && mkdir  $2/$1/OPAFILES/AGRIF_MODELFILES
 cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/agrif_opa.in  $2/$1/OPAFILES/
-cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/conv  $2/$1/OPAFILES/
+#cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/conv  $2/$1/OPAFILES/
+cp -f -r $2/$1/AGRIFLIB/bin/conv  $2/$1/OPAFILES/
 
 fi
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/bash-font-lock.el
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/bash-font-lock.el	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/bash-font-lock.el	(revision 5682)
@@ -0,0 +1,81 @@
+; Bash syntax highlighting
+
+(defvar bash-builtins  ;; Unrecognized UNIX commands
+  '("awk" "basename" "cat" "cp" "cut" "date" "diff" "dirname" "env" "find"
+    "grep" "head" "ls" "make" "mkdir" "mv" "rm" "sed" "sort" "svn" "tail" "tee"
+    "touch" "uniq" "xargs"                                                     ))
+
+(defvar bash-keywords  ;; Bash keywords (consistency with 'return' command fontification)
+  '("declare" "let" "local" "readonly" "typeset" "set" "unset"                 ))
+
+(defvar bash-functions ;; Sourced or declared fonctions
+  '("fake_func"                                                                   ;; 
+    "em" "ev" "ge" "heil" "mkcd" "ok"                                             ;; Common
+    "nemch" "nemde" "nemid" "nemtr" "nemst"                                       ;; NEMO branchs
+    "cmpcf" "if90" "gf90"                                                         ;; NEMO cmp
+    "nemo_help" "nemo_cfg"                                                        ;; NEMO cfg
+    "append_output_file" "appech_output_file" "super_grep" "check_args_count"     ;; NEMO SETTE
+    "set_namelist" "set_xio" "post_test_tidyup"                                )) ;; Id
+
+(defvar bash-font-lock ;; Be careful with order
+  '(;; Variables
+    ;;; GLOBALS variables|arrays
+    ("\\(?:export +\\)?\\$?{?\\(#?[A-Z][A-Z_0-9]+\\)\\(?:\\[\\(?2:[@*]\\)\\]\\)?"
+     (1 font-lock-constant-face     ) (2 font-lock-constant-face      nil t))
+    ;;; Locals arrays
+    ("\\(?1:#?[a-z][a-z_0-9]+\\)\\[\\([@*]\\)?"
+     (1 font-lock-variable-name-face) (2 font-lock-variable-name-face nil t))
+    ;;; Shell specials variables
+    ("\\${?\\([#@?!_-]?[a-z]?[a-z_0-9]*\\)}?" 1 font-lock-variable-name-face)
+
+    ;; Tests  '[ ... ]' '[[ ... ]]' '(( ... ))'
+    ("\\((\\{2\\}\\) \\(?:.*\\) \\()\\{2\\}\\)"            
+     (1 font-lock-builtin-face) (2 font-lock-builtin-face))
+    ("\\(\\[\\{1,2\\}\\) \\(?:[^]]+\\) \\(\\]\\{1,2\\}\\)"
+     (1 font-lock-builtin-face) (2 font-lock-builtin-face))
+
+    ;; Operators  ' ! ' ' != ' ' ~= '  ' && ' ' || '
+    (" \\!=? \\| ~= " 0 font-lock-negation-char-face)
+    (" && \\| || "    0 font-lock-keyword-face      )
+
+    ;; Compound commands
+    ("\\\\$"                0 font-lock-warning-face) ; '\'
+    ("\\(?:[^;]\\)\\(;\\) " 1 font-lock-keyword-face) ; '; '
+     ;;; Function
+    ("^\\(?:function +\\)?\\(\\sw+\\)(?)? +\\({\\)"
+     (1 font-lock-function-name-face) (2 font-lock-warning-face      ))
+    ("^}$"                             0 font-lock-warning-face       )
+     ;;; Commands block ' { ...; }'
+    ("\\({\\) \\(?:[^}]*\\); +\\(}\\)?" (1 font-lock-warning-face) (2 font-lock-warning-face nil t))
+    ("\\(?:.*\\); +\\(}\\)$"          1 font-lock-warning-face                                  )
+     ;;; Sub-shell      '( ...  )'
+    ("\\((\\) \\(?:[^)]*\\) \\()\\)" (1 font-lock-warning-face) (2 font-lock-warning-face))
+
+    ;; 'case ... in ...) ...;; esac'
+    ("\\()\\)\\(?:[^)]*\\)\\(;;\\)" (1 font-lock-keyword-face) (2 font-lock-keyword-face))
+    ("^[^(]*\\()\\)$"                1 font-lock-keyword-face) ; Regular syntax
+    ("^\\s-+;;$"                     0 font-lock-keyword-face) ;    "      ""
+    )
+  )
+
+; Configuration loading
+(font-lock-add-keywords 'sh-mode `((,(regexp-opt bash-builtins  'words) 0 font-lock-builtin-face      )))
+(font-lock-add-keywords 'sh-mode `((,(regexp-opt bash-keywords  'words) 0 font-lock-keyword-face      )))
+(font-lock-add-keywords 'sh-mode `((,(regexp-opt bash-functions 'words) 0 font-lock-function-name-face)))
+(font-lock-add-keywords 'sh-mode bash-font-lock                                                         )
+
+; Highlighting example for font lock faces
+(font-lock-add-keywords 'sh-mode '(
+  ("font-lock-warning-face"           . font-lock-warning-face          )
+  ("font-lock-function-name-face"     . font-lock-function-name-face    )
+  ("font-lock-variable-name-face"     . font-lock-variable-name-face    )
+  ("font-lock-keyword-face"           . font-lock-keyword-face          )
+  ("font-lock-comment-face"           . font-lock-comment-face          )
+  ("font-lock-comment-delimiter-face" . font-lock-comment-delimiter-face)
+  ("font-lock-type-face"              . font-lock-type-face             )
+  ("font-lock-constant-face"          . font-lock-constant-face         )
+  ("font-lock-builtin-face"           . font-lock-builtin-face          )
+  ("font-lock-preprocessor-face"      . font-lock-preprocessor-face     )
+  ("font-lock-string-face"            . font-lock-string-face           )
+  ("font-lock-doc-face"               . font-lock-doc-face              )
+  ("font-lock-negation-char-face"     . font-lock-negation-char-face    )))
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/bld.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 5682)
@@ -41,5 +41,5 @@
 bld::tool::fppflags::nemo      %FPPFLAGS -I$CONFIG_DIR/$NEW_CONF/OPAFILES/inc
 bld::tool::fppflags::ioipsl    %FPPFLAGS
-bld::tool::fppflags::agrif     %FPPFLAGS
+bld::tool::fppflags::agrif     %FPPFLAGS -include ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h
 
 # Ignore the following dependencies
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg	(revision 5682)
@@ -52,4 +52,5 @@
 bld::excl_dep	     use::ioipsl
 bld::excl_dep	     use::xios
+bld::excl_dep        use::agrif_grids
 bld::excl_dep	     use::agrif_types
 bld::excl_dep	     use::agrif_util
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/conv.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 5682)
@@ -8,6 +8,8 @@
 # Build information
 # ------------------------------------------------------------------------------
-inc $COMPIL_DIR/arch.fcm
+inc $COMPIL_DIR/arch_nemo.fcm
 
+bld::tool::cc        %CC
+bld::tool::cflags    %CFLAGS
 bld::tool::make      %MK
 
@@ -19,8 +21,8 @@
 dir::root            $NEMO_TDIR/$NEW_CONF/AGRIFLIB
 
-bld::tool::cflags::convsrc  -O0  
-bld::tool::ld::convsrc   cc
-bld::tool::ldflags::convsrc -O  ../obj/fortran.o ../obj/fortran.o 
-bld::pp 1
+#bld::tool::cflags::convsrc  -O0  
+#bld::tool::ld::convsrc   cc
+#bld::tool::ldflags::convsrc -O  ../obj/fortran.o ../obj/fortran.o 
+#bld::pp 1
 
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/template.sh
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/template.sh	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/COMPILE/template.sh	(revision 5682)
@@ -0,0 +1,186 @@
+#!/bin/bash
+
+
+#§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
+#
+# This template for Bash coding pair with Emacs Lisp package 'bash-font-lock.el'
+# to enhance default shell syntax fontification. This package is based on regexs
+# to match examples of concsyntax showed below.
+# All this is not mandatory and probably not optimized with other correct rules
+# Feel free to add your tips, modify it at your convenience or give your feedback
+# to improve it.
+#
+#§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
+
+
+# To automatically use it with a bash script, copy it to your ~/.emacs.d and 
+# add '(load "~/.emacs.d/bash-font-lock.el")' in your .emacs configuration file
+#--------------------------------------------------------------------------------
+ # If a command  is not highlighted, add its name to 'bash-builtins'  list
+ # "  " function ""  "       "     ,  "   "   ""  "" 'bash-functions'  "" 
+
+# UNIX built-in commands sample
+#-------------------------------
+.; alias; bg; bind; builtin; caller; compgen; complete; declare; dirs; disown
+enable; fc; fg; help; history; jobs; kill; let; local; popd; printf; pushd
+shopt; source; suspend; typeset; unalias; eval; export; getopts; newgrp; pwd
+read; readonly; times; ulimit; command; hash; test; type; cd; echo; eval; set
+shift; umask; unset; wait
+
+# Common bash built-in commands already added to 'bash-builtins' list
+#---------------------------------------------------------------------
+awk basename cat cp cut date diff dirname env find grep head ls make mkdir mv rm
+sed sort svn tail tee touch uniq xargs
+
+# Variables
+#-----------
+ # Specials    parameters (see Bash manual for details, `man bash`)
+$0 $# $* $@ $? $! $_ $$ $-
+ # Positionnal parameters (ordered arguments given to run script "$0")
+$1 $2 $3 ...                
+$* ==  "$1${IFS}$2${IFS}$3..." #   Single word , recommended use for string
+$@ ==  "$1"    "$2"    "$3"...  # Separate words, recommended use for array
+ # Identify locals against GLOBALS or ENVIRONMENT variables with case sensitive
+TEMP=${temp_0123}; temp=${TEMP_0123}; export TEMP=${TEMP_0123}
+ # Possibles variable assignation syntax
+temp='temp'; temp=$1 # Simple
+length_temp=${#temp} # Length of string
+temp=$(( 1 + 1 ))    # Integer arithmetic evaluation
+temp=${........}     # String operations
+temp=$(test ....)    # Regular syntax
+temp=$( test ... )   # Highlight sub-shell '( ... )' & command or function call
+temp=`test .....`    # Backquotes not recommended to avoid complete highlighting
+
+# Arrays
+#--------
+ # Initialisation
+declare -a array                 # Explicit
+array=([0]='zero' [1]='one' ...) # Implicit with index assignement
+array[0]='zero'; array[9]='ten'  # Implicit or add element to array at an index
+ # Curly brackets are essential to work with arrays
+ # Last index of an array
+IDX=${#temp_0123[@]}; idx=${#TEMP_0123[@]}
+ # Get last element of an array (${#array[@]})
+LAST_ELMNT=array[${#array[@]}]; last_elmnt=ARRAY[${#ARRAY[@]}]
+ # Remove an element or entire array
+unset array[9]; unset array[@]
+
+# Strings
+#---------
+ # Single quotes are recommended to identified entire characters string instead
+ # of doubles quotes or initialize variable
+echo 'The name of the script is '$0' with following arguments '$*
+ # Doubles quotes should only be used when it's necessary to interpret escaping
+ # character or to perform parameter substitution
+printf "The value of PI is %8.6f.\n" $PI; sed "s/3.1415/$PI/" temp.txt
+
+# Function
+#----------
+ # 'function' word is not not mandatory at declaration if you have double
+ # brackets '()' right after name. A function has to be declared before its call
+ # so should be placed at the beginning of the main script. A clever solution is
+ # to gather similar functions in kind of a 'module' file which will be sourced
+ # from main script.
+ # 2 possibles syntax:
+function fake_func { local temp=''; ...; return ...; }
+fake_func() {
+    local temp='' # Declare variable as local, if not his attribute is global
+    ...
+    return ...   # Function can only return an integer (stderr by default)
+                  # export result by a global variable to bypass it 
+}
+ # Function call (with or without argument)
+temp=$( fake_func $1 $2 ); fake_func $1 $2; fake_func
+
+# Tests operators differs with type of test (arithmetic or string comparison
+# for number/characters, file attributs), see manual for test with `man test`
+#----------------------------------------------------------------------------
+ # Possible syntax : literal 'test' or compact syntax with brackets/parenthesis
+ # at the ends
+ # '[ ... ]' & '[[ ... ]]' are almost identical (simple and extended test)
+ # With ' != ' & ' == ' operators, right string is considered as          regex
+ #  ""             '~='     "    ,   "     ""   "      ""     "  extended   "
+[ $temp ~= "..." ] && [[ ! -e temp.txt ]] || (( $temp >= 0 ))
+
+# For compound commands, prefer the use of command block '{ ...; }' instead of
+# a sub-shell '( ... )', keep in mind that despite sub-shell inherit from its
+# run script all variables declared as locals are lost at the end of execution
+
+# To cut a long sequence, put the escape character '\' at the end of line and
+# continue on next line (possible on several lines)
+printf "This is a very very very long sentence that I have to cut in order to  \
+        be less than 80 characters for a line of code but I don't have to call \
+        the same command several times.\n                                       "
+# A pipe ' | ' cannot be put at the end of a line, even if you have a '\'
+cat temp.txt | cut -d' ' -f-5 | sort -kr3n | uniq -c | sort | head -n25 \
+| awk '$3 >= 1024 {print $4}'                                           \
+| xargs -t -i() mv () $HOST@$HOSTNAME:${REP_STORAGE}
+
+# 'if ...; then ...; fi'
+#------------------------
+ # Very short syntax with commands block '{ ...; }'
+[ ... ] && { ...; ...; }
+ #      Short syntax with commands block '{ ...; }'
+[ ... ] && { ...; \
+             ...;  }
+ #    Regular syntax
+if [ ... ]; then
+    ...  
+fi
+
+# 'if ...; then ...;  else ...; fi'
+#----------------------------------
+ #   Short syntax with commands block '{ ... }'
+{ [ ... ] && ...; } || { ...; ...; }
+ # Regular syntax
+if [ ... ]; then
+    ...
+else
+    ...
+fi
+
+# 'case ... in ...) ... ;; ... esac'
+#-----------------------------------
+case ... in
+ # Very short syntax
+    ...) ...;;     ...) ...;;    ...) ...;;
+ #      Short syntax
+    ...) ...; ...; ...;;
+ #    Regular syntax
+    ...)
+	...
+	;;
+esac
+
+# List font lock faces with effective highlighting (can be customized)
+#---------------------------------------------------------------------
+ font-lock-warning-face
+ # for a construct that is peculiar, or that greatly changes the meaning of
+  #other text
+ font-lock-function-name-face
+ # for the name of a function being defined or declared
+ font-lock-variable-name-face
+ # for the name of a variable being defined or declared
+ font-lock-keyword-face
+ # for a keyword with special syntactic significance, like ‘for’ and ‘if’ in C.
+ font-lock-comment-face
+ # for comments
+ font-lock-comment-delimiter-face
+ # for comments delimiters, like ‘/*’ and ‘*/’ in C. On most terminals, this
+  #inherits from font-lock-comment-face
+ font-lock-type-face
+ # for the names of user-defined data types
+ font-lock-constant-face
+ # for the names of constants, like ‘NULL’ in C
+ font-lock-builtin-face
+ # for the names of built-in functions
+ font-lock-preprocessor-face
+ # for preprocessor commands. This inherits, by default, from
+  #font-lock-builtin-face
+ font-lock-string-face
+ # for string constants
+ font-lock-doc-face
+ # for documentation strings in the code. This inherits, by default, from
+  #font-lock-string-face
+ font-lock-negation-char-face
+ # for easily-overlooked negation characters
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/README
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/README	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/README	(revision 5682)
@@ -0,0 +1,5 @@
+DMP_TOOLS should be used to create a netcdf file called resto.nc containing restoration coefficients for use with the tra_dmp module in NEMO. Further instructions for it's use are available in the NEMO users guide.
+
+The tool can be compiled using the maketools script in the NEMOGCM/TOOLS directory as follows:
+./maketools -m $ARCH -n DMP_TOOLS
+where $ARCH indicates the arch file to be used from the directory NEMOGCM/ARCH. For example to use NEMOGCM/ARCH/arch-PW7_MONSOON.fcm, $ARCH would be PW7_MONSOON.
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/namelist
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/namelist	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/namelist	(revision 5682)
@@ -0,0 +1,24 @@
+&nam_dmp_create
+    cp_cfg = 'orca'            ! Name of model grid (orca and C1D have special options - otherwise ignored)
+    cp_cfz = 'antarctic'       ! Name of zoom configuration (arctic and antarctic have some special treatment if lzoom=.true.)
+    jp_cfg = 2                 ! Resolution of the model (used for med_red_seas damping)
+    lzoom = .false.            ! Zoom configuration or not
+    ln_full_field = .false.    ! Calculate coefficient over whole of domain 
+    ln_med_red_seas = .true.   ! Damping in Med/Red Seas (or local modifications here if ln_full_field=.true.)
+    ln_old_31_lev_code = .true.   ! Replicate behaviour of old online code for 31 level model (Med/Red seas damping based on level number instead of depth)
+    ln_coast = .true.          ! Reduce near to coastlines 
+    ln_zero_top_layer = .true. ! No damping in top layer
+    ln_custom = .false.        ! Call "custom" module to apply user modifications to the damping coefficient field
+    nn_hdmp = 10               ! Damp poleward of this latitude (smooth transition up to maximum damping)
+    pn_surf = 0.25             ! Surface Relaxation timescale (days) 
+    pn_bot = 0.25              ! Bottom relaxation timescale (days)
+    pn_dep = 1000              ! Transition depth from upper to deep ocean
+    jperio = 2                 ! Lateral boundary condition (as specified in namelist_cfg for model run).
+/
+
+&nam_zoom_dmp
+    lzoom_n = .false.     ! Open boundary had northern edge?
+    lzoom_e = .false.     ! Open boundary at eastern edge?
+    lzoom_w = .false.     ! Open boundary at western edge?
+    lzoom_s = .false.     ! Open boundary at southern edge?
+/
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/coast_dist.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/coast_dist.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/coast_dist.F90	(revision 5682)
@@ -0,0 +1,220 @@
+MODULE coastdist
+
+   USE utils
+   USE netcdf
+
+   IMPLICIT NONE
+   PUBLIC 
+
+   CONTAINS
+
+   SUBROUTINE coast_dist_weight( presto ) 
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE coast_dist_weight ***
+      !!
+      !! ** Purpose: Weight restoration coefficient by distance to coast
+      !!
+      !! ** Method: 1) Calculate distance to coast
+      !!            2) Reduce resto with 1000km of coast
+      !!
+      IMPLICIT NONE
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: presto
+      REAL(wp), DIMENSION(jpi,jpj) :: zdct
+      REAL(wp) :: zinfl = 1000.e3_wp  ! Distance of influence of coast line (could be
+                                  ! a namelist setting)
+      INTEGER :: jj, ji           ! dummy loop indices
+      
+
+      CALL cofdis( zdct )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zdct(ji,jj) = MIN( zinfl, zdct(ji,jj) )
+            presto(ji,jj) = presto(ji, jj) * 0.5_wp * (  1._wp - COS( rpi*zdct(ji,jj)/zinfl) )
+         END DO
+      END DO
+
+   END SUBROUTINE coast_dist_weight
+
+
+   SUBROUTINE cofdis( pdct )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE cofdis  ***
+      !!
+      !! ** Purpose :   Compute the distance between ocean T-points and the
+      !!      ocean model coastlines.
+      !!
+      !! ** Method  :   For each model level, the distance-to-coast is 
+      !!      computed as follows : 
+      !!       - The coastline is defined as the serie of U-,V-,F-points
+      !!      that are at the ocean-land bound.
+      !!       - For each ocean T-point, the distance-to-coast is then 
+      !!      computed as the smallest distance (on the sphere) between the 
+      !!      T-point and all the coastline points.
+      !!       - For land T-points, the distance-to-coast is set to zero.
+      !!
+      !! ** Action  : - pdct, distance to the coastline (argument)
+      !!              - NetCDF file 'dist.coast.nc' 
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::   pdct   ! distance to the coastline
+      !!
+      INTEGER ::   ji, jj, jl   ! dummy loop indices
+      INTEGER ::   iju, ijt, icoast, itime, ierr, icot   ! local integers
+      CHARACTER (len=32) ::   clname                     ! local name
+      REAL(wp) ::   zdate0                               ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zxt, zyt, zzt, zmask
+      REAL(wp), POINTER, DIMENSION(:  ) ::  zxc, zyc, zzc, zdis    ! temporary workspace
+      LOGICAL , ALLOCATABLE, DIMENSION(:,:) ::  llcotu, llcotv, llcotf   ! 2D logical workspace
+
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zxt(jpi,jpj) , zyt(jpi,jpj) , zzt(jpi,jpj) , zmask(jpi,jpj)    )
+      ALLOCATE(zxc(3*jpi*jpj), zyc(3*jpi*jpj), zzc(3*jpi*jpj), zdis(3*jpi*jpj)     )
+      ALLOCATE( llcotu(jpi,jpj), llcotv(jpi,jpj), llcotf(jpi,jpj)  )
+      ALLOCATE( gphiu(jpi,jpj), gphiv(jpi,jpj), gphif(jpi,jpj)  )
+      ALLOCATE( glamu(jpi,jpj), glamv(jpi,jpj), glamf(jpi,jpj), glamt(jpi,jpj)  )
+      ALLOCATE( umask(jpi,jpj), vmask(jpi,jpj), fmask(jpi,jpj)  )
+      !
+
+      CALL check_nf90( nf90_get_var( ncin, gphit_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, gphiu_id, gphiu, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, gphiv_id, gphiv, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, gphif_id, gphif, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, glamt_id, glamt, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, glamu_id, glamu, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, glamv_id, glamv, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, glamf_id, glamf, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, tmask_id, tmask, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, umask_id, umask, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, vmask_id, vmask, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, fmask_id, fmask, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+      pdct(:,:) = 0._wp
+      zxt(:,:) = COS( rad * gphit(:,:) ) * COS( rad * glamt(:,:) )
+      zyt(:,:) = COS( rad * gphit(:,:) ) * SIN( rad * glamt(:,:) )
+      zzt(:,:) = SIN( rad * gphit(:,:) )
+
+
+         ! Define the coastline points (U, V and F)
+         DO jj = 2, jpj-1
+            DO ji = 2, jpi-1
+               zmask(ji,jj) =  ( tmask(ji,jj+1) + tmask(ji+1,jj+1) &
+                   &           + tmask(ji,jj  ) + tmask(ji+1,jj  ) )
+               llcotu(ji,jj) = ( tmask(ji,jj ) + tmask(ji+1,jj  ) == 1._wp ) 
+               llcotv(ji,jj) = ( tmask(ji,jj  ) + tmask(ji  ,jj+1) == 1._wp ) 
+               llcotf(ji,jj) = ( zmask(ji,jj) > 0._wp ) .AND. ( zmask(ji,jj) < 4._wp )
+            END DO
+         END DO
+
+         ! Lateral boundaries conditions
+         llcotu(:, 1 ) = umask(:,  2  ) == 1
+         llcotu(:,jpj) = umask(:,jpj-1) == 1
+         llcotv(:, 1 ) = vmask(:,  2  ) == 1
+         llcotv(:,jpj) = vmask(:,jpj-1) == 1
+         llcotf(:, 1 ) = fmask(:,  2  ) == 1
+         llcotf(:,jpj) = fmask(:,jpj-1) == 1
+
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+            llcotu( 1 ,:) = llcotu(jpi-1,:)
+            llcotu(jpi,:) = llcotu(  2  ,:)
+            llcotv( 1 ,:) = llcotv(jpi-1,:)
+            llcotv(jpi,:) = llcotv(  2  ,:)
+            llcotf( 1 ,:) = llcotf(jpi-1,:)
+            llcotf(jpi,:) = llcotf(  2  ,:)
+         ELSE
+            llcotu( 1 ,:) = umask(  2  ,:) == 1
+            llcotu(jpi,:) = umask(jpi-1,:) == 1
+            llcotv( 1 ,:) = vmask(  2  ,:) == 1
+            llcotv(jpi,:) = vmask(jpi-1,:) == 1
+            llcotf( 1 ,:) = fmask(  2  ,:) == 1
+            llcotf(jpi,:) = fmask(jpi-1,:) == 1
+         ENDIF
+         IF( jperio == 3 .OR. jperio == 4 ) THEN
+            DO ji = 1, jpi-1
+               iju = jpi - ji + 1
+               llcotu(ji,jpj  ) = llcotu(iju,jpj-2)
+               llcotf(ji,jpj-1) = llcotf(iju,jpj-2)
+               llcotf(ji,jpj  ) = llcotf(iju,jpj-3)
+            END DO
+            DO ji = jpi/2, jpi-1
+               iju = jpi - ji + 1
+               llcotu(ji,jpj-1) = llcotu(iju,jpj-1)
+            END DO
+            DO ji = 2, jpi
+               ijt = jpi - ji + 2
+               llcotv(ji,jpj-1) = llcotv(ijt,jpj-2)
+               llcotv(ji,jpj  ) = llcotv(ijt,jpj-3)
+            END DO
+         ENDIF
+         IF( jperio == 5 .OR. jperio == 6 ) THEN
+            DO ji = 1, jpi-1
+               iju = jpi - ji
+               llcotu(ji,jpj  ) = llcotu(iju,jpj-1)
+               llcotf(ji,jpj  ) = llcotf(iju,jpj-2)
+            END DO
+            DO ji = jpi/2, jpi-1
+               iju = jpi - ji
+               llcotf(ji,jpj-1) = llcotf(iju,jpj-1)
+            END DO
+            DO ji = 1, jpi
+               ijt = jpi - ji + 1
+               llcotv(ji,jpj  ) = llcotv(ijt,jpj-1)
+            END DO
+            DO ji = jpi/2+1, jpi
+               ijt = jpi - ji + 1
+               llcotv(ji,jpj-1) = llcotv(ijt,jpj-1)
+            END DO
+         ENDIF
+
+         ! Compute cartesian coordinates of coastline points
+         ! and the number of coastline points
+         icoast = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( llcotf(ji,jj) ) THEN
+                  icoast = icoast + 1
+                  zxc(icoast) = COS( rad*gphif(ji,jj) ) * COS( rad*glamf(ji,jj) )
+                  zyc(icoast) = COS( rad*gphif(ji,jj) ) * SIN( rad*glamf(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphif(ji,jj) )
+               ENDIF
+               IF( llcotu(ji,jj) ) THEN
+                  icoast = icoast+1
+                  zxc(icoast) = COS( rad*gphiu(ji,jj) ) * COS( rad*glamu(ji,jj) )
+                  zyc(icoast) = COS( rad*gphiu(ji,jj) ) * SIN( rad*glamu(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphiu(ji,jj) )
+               ENDIF
+               IF( llcotv(ji,jj) ) THEN
+                  icoast = icoast+1
+                  zxc(icoast) = COS( rad*gphiv(ji,jj) ) * COS( rad*glamv(ji,jj) )
+                  zyc(icoast) = COS( rad*gphiv(ji,jj) ) * SIN( rad*glamv(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphiv(ji,jj) )
+               ENDIF
+            END DO
+         END DO
+
+         ! Distance for the T-points
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tmask(ji,jj) == 0._wp ) THEN
+                  pdct(ji,jj) = 0._wp
+               ELSE
+                  DO jl = 1, icoast
+                     zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2   &
+                        &     + ( zyt(ji,jj) - zyc(jl) )**2   &
+                        &     + ( zzt(ji,jj) - zzc(jl) )**2
+                  END DO
+                  pdct(ji,jj) = ra * SQRT( MINVAL( zdis(1:icoast) ) )
+               ENDIF
+            END DO
+         END DO
+
+      DEALLOCATE( zxt , zyt , zzt , zmask    )
+      DEALLOCATE(zxc, zyc, zzc, zdis    )
+      DEALLOCATE( llcotu, llcotv, llcotf  )
+      DEALLOCATE( gphiu, gphiv, gphif  )
+      DEALLOCATE( glamu, glamv, glamf, glamt  )
+      DEALLOCATE( umask, vmask, fmask  )
+
+   END SUBROUTINE cofdis
+
+END MODULE coastdist
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/custom.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/custom.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/custom.F90	(revision 5682)
@@ -0,0 +1,22 @@
+MODULE custom
+
+   USE utils
+
+   IMPLICIT NONE
+   PUBLIC
+
+   CONTAINS
+
+   SUBROUTINE custom_resto( presto )
+      !!---------------------------------
+      !!     **ROUTINE: custom_resto
+      !!
+      !!  ** Purpose: Module to be edited by users to create custom restoration
+      !!              coefficient files (e.g. regional damping).
+      !!
+      !!-------------------------------------
+      REAL(wp), DIMENSION(jpi,jpk), INTENT(inout) :: presto
+
+   END SUBROUTINE custom_resto
+
+END MODULE custom
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/make_dmp_file.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/make_dmp_file.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/make_dmp_file.F90	(revision 5682)
@@ -0,0 +1,123 @@
+PROGRAM make_dmp_file
+  !================================================================================
+  !               *** PROGRAM make_dmp_file ****
+  !================================================================================
+  !
+  !  Purpose: Create a file containing a spacially varying
+  !           restoration coefficient to be used by TRADMP
+  !
+  !  Method:  1) Read in tmask from mesh_mask file to use as a template
+  !           2) Calculate restoration coefficients according to options
+  !           specified in the namelist. The user may modify custom.F90 to
+  !           specify specific damping options e.g. to mask certain regions only).
+  !           3) Write the array to output file
+  !
+  !  History: Original code: Tim Graham (Jul 2014) - some code moved from
+  !                            old tradmp.F90 module to this tool (as part of NEMO
+  !                            simplification process).
+  !-------------------------------------------------------------------------------
+
+  ! Declare variables
+  USE netcdf 
+  USE utils
+  USE coastdist
+  USE med_red_seas
+  USE zoom
+  USE custom
+
+  IMPLICIT NONE
+  INTEGER  :: ji, jj, jk                         ! dummpy loop variables
+  REAL(wp) :: zsdmp, zbdmp                     ! Surface and bottom damping coeff
+  CHARACTER(LEN=200) :: meshfile = 'mesh_mask.nc'   ! mesh file
+  CHARACTER(LEN=200) :: outfile = 'resto.nc'     ! output file
+  REAL(wp) :: zlat, zlat2, zlat0
+
+  ! Read namelist
+  OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
+  READ( numnam, nam_dmp_create )
+  CLOSE( numnam )
+  
+  IF ( ln_full_field .AND. lzoom ) THEN
+    WRITE(numerr,*) 'Only one of ln_full_field and lzoom can be .true.'
+    STOP
+  ENDIF
+
+  CALL grid_info(meshfile)
+  WRITE(numout, *) 'jpi = ',jpi
+  WRITE(numout, *) 'jpj = ',jpj
+  WRITE(numout, *) 'jpk = ',jpk
+
+  ALLOCATE( resto(jpi, jpj) )
+
+  !Create output file
+  CALL make_outfile( outfile )
+  
+  CALL check_nf90( nf90_get_var( ncin, gphit_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+  !Calculate surface and bottom damping coefficients
+  zsdmp = 1._wp / ( pn_surf * rday )
+  zbdmp = 1._wp / ( pn_bot  * rday )
+
+  !Loop through levels and read in tmask for each level as starting point for
+  !coefficient array
+  DO jk = 1, jpk-1
+     resto(:,:) = 0._wp
+     
+     IF (.NOT. (jk == 1 .AND. ln_zero_top_layer) ) THEN 
+        !Read in tmask depth for this level
+        CALL check_nf90( nf90_get_var( ncin, tmask_id, tmask, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
+        CALL check_nf90( nf90_get_var( ncin, gdept_id, gdept, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
+     
+
+        IF ( ln_full_field ) THEN
+           !Set basic value of resto
+           DO jj = 1, jpj
+              DO ji = 1, jpi
+                 resto(ji,jj) = tmask(ji, jj) * (zbdmp + (zsdmp-zbdmp) * EXP(-gdept(ji,jj)/pn_dep))
+              END DO
+           END DO
+           IF ((nn_hdmp > 0)) THEN
+              zlat0 = 10. !width of latitude strip where resto decreases
+              zlat2 = nn_hdmp + zlat0
+              DO jj = 1, jpj
+                 DO ji = 1, jpi
+                    zlat = ABS(gphit(ji,jj))
+                    IF ( nn_hdmp <= zlat .AND. zlat <= zlat2 ) THEN
+                       resto(ji,jj) = resto(ji,jj) * 0.5_wp * (  1._wp - COS( rpi*(zlat-nn_hdmp)/zlat0 ) )
+                    ELSE IF ( zlat < nn_hdmp ) THEN
+                       resto(ji,jj) = 0._wp
+                    ENDIF
+                 END DO
+              END DO
+           ENDIF
+    
+           IF (ln_coast) THEN
+              ! Reduce damping in vicinity of coastlines
+              CALL coast_dist_weight(resto)
+           ENDIF
+        ENDIF
+
+        ! Damping in Med/Red Seas (or local modifications if full field is set)
+        IF (ln_med_red_seas .AND. (cp_cfg == 'orca') .AND. (.NOT. lzoom)) THEN
+           CALL med_red_dmp(resto, jk, ln_old_31_lev_code)
+        ENDIF
+
+        IF ( lzoom ) THEN
+              CALL dtacof_zoom(resto, tmask)
+        ENDIF
+        
+        !Any user modifications can be added in the custom module
+        IF ( ln_custom ) THEN
+              CALL custom_resto( resto )
+        ENDIF
+     ENDIF
+
+     ! Write out resto for this level
+     CALL check_nf90( nf90_put_var( ncout, resto_id, resto, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
+
+  END DO
+  
+  ! Close the output file
+  CALL check_nf90( nf90_close(ncout) )
+
+END PROGRAM make_dmp_file
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90	(revision 5682)
@@ -0,0 +1,135 @@
+MODULE med_red_seas
+
+   USE utils
+   
+   IMPLICIT NONE
+   PUBLIC
+
+   CONTAINS  
+
+   SUBROUTINE med_red_dmp(presto, jk, ln_31_lev)
+      !!------------------------------------
+      !!    **ROUTINE: med_red_dmp
+      !! 
+      !! **Purpose: Apply specific modifications to damping coefficients on ORCA
+      !!            grids in Med and Red Seas
+      !!
+      !!-----------------------------------
+      INTEGER :: ij0,ij1,ii0,ii1,ji,jj     
+      INTEGER, INTENT(in) :: jk
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zmrs
+      REAL(wp) :: zhfac, zsdmp, zbdmp
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: presto
+      LOGICAL, INTENT(in), OPTIONAL :: ln_31_lev
+      LOGICAL :: l_31_lev
+
+      WRITE(numout,*) 'ORCA Med and Red Seas Damping'
+      
+      IF ( PRESENT(ln_31_lev)) THEN
+         l_31_lev = ln_31_lev
+      ELSE
+         l_31_lev = .false.
+      ENDIF
+      
+      ALLOCATE( zmrs(jpi, jpj) )
+         !
+         zmrs(:,:) = 0._wp
+         !
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration 
+            !                                        ! =======================
+            ij0 =  50   ;   ij1 =  56                    ! Mediterranean Sea
+
+            ii0 =  81   ;   ii1 =  91   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1.
+            ij0 =  50   ;   ij1 =  55
+            ii0 =  75   ;   ii1 =  80   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1.
+            ij0 =  52   ;   ij1 =  53
+            ii0 =  70   ;   ii1 =  74   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1.
+           !
+           !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration 
+            !                                        ! =======================
+            ij0 =  96   ;   ij1 = 110                    ! Mediterranean Sea
+            ii0 = 157   ;   ii1 = 181   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            ij0 = 100   ;   ij1 = 110
+            ii0 = 144   ;   ii1 = 156   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            ij0 = 100   ;   ij1 = 103
+            ii0 = 139   ;   ii1 = 143   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ij0 = 101   ;   ij1 = 102                    ! Decrease before Gibraltar Strait
+            ii0 = 139   ;   ii1 = 141   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0._wp
+            ii0 = 142   ;   ii1 = 142   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp
+            ii0 = 143   ;   ii1 = 143   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp
+            ii0 = 144   ;   ii1 = 144   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.75_wp
+            !
+            ij0 =  87   ;   ij1 =  96                    ! Red Sea
+            ii0 = 147   ;   ii1 = 163   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ij0 =  91   ;   ij1 =  91                    ! Decrease before Bab el Mandeb Strait
+            ii0 = 153   ;   ii1 = 160   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.80_wp
+            ij0 =  90   ;   ij1 =  90
+            ii0 = 153   ;   ii1 = 160   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp
+            ij0 =  89   ;   ij1 =  89
+            ii0 = 158   ;   ii1 = 160   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp
+            ij0 =  88   ;   ij1 =  88
+            ii0 = 160   ;   ii1 = 163   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0._wp
+            !
+            !                                        ! =======================
+         CASE ( 05 )                                 !  ORCA_R05 configuration
+            !                                        ! =======================
+            ii0 = 568   ;   ii1 = 574                    ! Mediterranean Sea
+            ij0 = 324   ;   ij1 = 333   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            ii0 = 575   ;   ii1 = 658
+            ij0 = 314   ;   ij1 = 366   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ii0 = 641   ;   ii1 = 651                    ! Black Sea (remaining part
+            ij0 = 367   ;   ij1 = 372   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ij0 = 324   ;   ij1 = 333                    ! Decrease before Gibraltar Strait
+            ii0 = 565   ;   ii1 = 565   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp
+            ii0 = 566   ;   ii1 = 566   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp
+            ii0 = 567   ;   ii1 = 567   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.75_wp
+            !
+            ii0 = 641   ;   ii1 = 665                    ! Red Sea
+            ij0 = 270   ;   ij1 = 310   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ii0 = 666   ;   ii1 = 675                    ! Decrease before Bab el Mandeb Strait
+            ij0 = 270   ;   ij1 = 290   
+            DO ji = ii0, ii1
+               zmrs( ji , ij0:ij1 ) = 0.1_wp * ABS( FLOAT(ji - ii1) )
+            END DO 
+            !                                       ! ========================
+         CASE ( 025 )                               !  ORCA_R025 configuration 
+            !                                       ! ========================
+            WRITE(numerr,*) ' Mediterranean and Red Sea damping option not implemented for ORCA_R025'
+            WRITE(numerr,*) ' Set ln_med_red = .false.'
+            STOP
+            !
+         END SELECT
+
+         zsdmp = 1._wp / ( pn_surf * rday )
+         zbdmp = 1._wp / ( pn_bot  * rday )
+
+         ! The l_31_lev option is used to reproduce the old behaviour of
+         ! defining the restoration coefficient based on the level number.
+         ! This is included to allow damping coefficients for reference
+         ! configurations to be kept the same.
+         IF (l_31_lev) THEN
+            IF (jk <= 17) THEN
+               zhfac = 0.5_wp * (  1. - COS( rpi * REAL(jk-1,wp) / 16._wp )  ) / rday
+            ELSE
+               zhfac = 1._wp / rday
+            ENDIF
+         ELSE
+            zhfac = (  zbdmp + (zsdmp-zbdmp) * EXP( -gdept(1,1)/pn_dep )  )
+         ENDIF
+
+         presto(:,:) = zmrs(:,:) * zhfac + ( 1._wp - zmrs(:,:) ) * presto(:,:)
+
+         DEALLOCATE( zmrs )         
+
+   END SUBROUTINE med_red_dmp
+
+
+END MODULE med_red_seas
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/utils.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/utils.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/utils.F90	(revision 5682)
@@ -0,0 +1,130 @@
+MODULE utils
+
+  USE netcdf
+
+  IMPLICIT NONE
+  PUBLIC
+  
+  INTEGER, PUBLIC, PARAMETER   :: dp=8 , sp=4, wp=dp
+  INTEGER :: tmask_id, umask_id, vmask_id, fmask_id
+  INTEGER :: gdept_id
+  INTEGER :: gphit_id, gphiv_id, gphiu_id, gphif_id        ! Variable ids
+  INTEGER :: glamt_id, glamv_id, glamu_id, glamf_id        ! Variable ids
+  INTEGER :: resto_id                           ! Variable ID for output
+  INTEGER :: jpi, jpj, jpk                      ! Size of domain
+  INTEGER  :: ncin, ncout                              ! File handles for netCDF files
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphit, glamt
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiu, glamu
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiv, glamv
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphif, glamf
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: tmask, umask, vmask, fmask
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gdept
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: resto
+
+  INTEGER,PARAMETER :: numout = 6
+  INTEGER,PARAMETER :: numerr = 0
+  INTEGER,PARAMETER :: numnam = 11
+  REAL(wp),PARAMETER :: rday = 86400           ! seconds in a day
+  REAL(wp),PARAMETER ::   rpi = 3.141592653589793
+  REAL(wp),PARAMETER ::   rad = 3.141592653589793/180.
+  REAL(wp),PARAMETER ::   ra =  6371229.
+
+  ! Namelist variables
+  CHARACTER(LEN=30) :: cp_cfg = 'ORCA'
+  CHARACTER(LEN=30) :: cp_cfz = 'No zoom'
+  INTEGER :: jp_cfg = 2
+  REAL(KIND=8) :: pn_surf = 1
+  REAL(KIND=8) :: pn_bot = 1
+  REAL(KIND=8) :: pn_dep = 1000         
+  INTEGER  :: nn_hdmp = 0                          ! damping option
+  INTEGER  :: jperio = 0                          ! damping option
+  LOGICAL :: lzoom = .false.
+  LOGICAL :: ln_coast = .false.
+  LOGICAL :: ln_full_field = .true.
+  LOGICAL :: ln_med_red_seas = .false.
+  LOGICAL :: ln_old_31_lev_code = .false.
+  LOGICAL :: ln_zero_top_layer = .false.
+  LOGICAL :: ln_custom = .false.
+
+  NAMELIST/nam_dmp_create/cp_cfg, cp_cfz, jp_cfg, lzoom, ln_full_field, &
+                          ln_med_red_seas, ln_old_31_lev_code, ln_coast, &
+                          ln_zero_top_layer, ln_custom, &
+                          pn_surf, pn_bot, pn_dep, nn_hdmp, jperio
+
+  CONTAINS 
+
+  SUBROUTINE grid_info(mesh)
+     CHARACTER(LEN=*),INTENT(in) :: mesh
+
+     ! Open meshfile
+     CALL check_nf90( nf90_open(mesh, NF90_NOWRITE, ncin), 'Error opening mesh_mask file' )
+  
+     ! Get size of grid from meshfile
+     CALL dimlen( ncin, 'x', jpi )
+     CALL dimlen( ncin, 'y', jpj )
+     CALL dimlen( ncin, 'z', jpk )
+
+     ALLOCATE( tmask(jpi, jpj), gdept(jpi, jpj), gphit(jpi,jpj) )
+
+     !Get ID of tmask in meshfile
+     CALL check_nf90( nf90_inq_varid( ncin, 'tmask', tmask_id ), 'Cannot get variable ID for tmask')
+     CALL check_nf90( nf90_inq_varid( ncin, 'umask', umask_id ), 'Cannot get variable ID for umask')
+     CALL check_nf90( nf90_inq_varid( ncin, 'vmask', vmask_id ), 'Cannot get variable ID for vmask')
+     CALL check_nf90( nf90_inq_varid( ncin, 'fmask', fmask_id ), 'Cannot get variable ID for fmask')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gdept_0', gdept_id ), 'Cannot get variable ID for gdept_0')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphit', gphit_id ), 'Cannot get variable ID for gphit')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphiu', gphiu_id ), 'Cannot get variable ID for gphiu')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphiv', gphiv_id ), 'Cannot get variable ID for gphiv')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphif', gphif_id ), 'Cannot get variable ID for gphif')
+     CALL check_nf90( nf90_inq_varid( ncin, 'glamt', glamt_id ), 'Cannot get variable ID for glamt')
+     CALL check_nf90( nf90_inq_varid( ncin, 'glamu', glamu_id ), 'Cannot get variable ID for glamu')
+     CALL check_nf90( nf90_inq_varid( ncin, 'glamv', glamv_id ), 'Cannot get variable ID for glamv')
+     CALL check_nf90( nf90_inq_varid( ncin, 'glamf', glamf_id ), 'Cannot get variable ID for glamf')
+  
+  END SUBROUTINE grid_info
+
+  SUBROUTINE dimlen( ncid, dimname, len )
+     ! Determine the length of dimension dimname
+     INTEGER, INTENT(in)          :: ncid
+     CHARACTER(LEN=*), INTENT(in) :: dimname
+     INTEGER, INTENT(out)         :: len
+     ! Local variables
+     INTEGER :: id_var, istatus
+
+     id_var = 1
+     CALL check_nf90( nf90_inq_dimid(ncid, dimname, id_var), 'Dimension not found in file')
+     CALL check_nf90( nf90_inquire_dimension(ncid,id_var,len=len))
+
+  END SUBROUTINE dimlen
+
+  SUBROUTINE make_outfile( filename )
+     ! Create the output file
+     ! Define dimensions and resto variable
+     CHARACTER(LEN=*), INTENT(in) :: filename
+     INTEGER :: id_x, id_y, id_z
+
+     CALL check_nf90( nf90_create(filename, NF90_CLOBBER, ncout), 'Could not create output file')
+     CALL check_nf90( nf90_def_dim(ncout, 'x', jpi, id_x) )
+     CALL check_nf90( nf90_def_dim(ncout, 'y', jpj, id_y) )
+     CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) )
+
+     CALL check_nf90( nf90_def_var(ncout, 'resto', nf90_double, (/id_x,id_y,id_z/), resto_id ) )
+     CALL check_nf90( nf90_enddef(ncout) )
+
+  END SUBROUTINE make_outfile
+
+
+  SUBROUTINE check_nf90( istat, message )
+     !Check for netcdf errors
+     INTEGER, INTENT(in) :: istat
+     CHARACTER(LEN=*), INTENT(in), OPTIONAL :: message
+     
+     IF (istat /= nf90_noerr) THEN
+        WRITE(numerr,*) 'ERROR! : '//TRIM(nf90_strerror(istat))
+        IF ( PRESENT(message) ) THEN ; WRITE(numerr,*) message ; ENDIF
+        STOP
+     ENDIF
+
+  END SUBROUTINE check_nf90
+
+END MODULE utils
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90	(revision 5682)
@@ -0,0 +1,90 @@
+MODULE zoom
+   
+   USE utils
+
+   CONTAINS
+
+   SUBROUTINE dtacof_zoom( presto, mask)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dtacof_zoom  ***
+      !!
+      !! ** Purpose :   Compute the damping coefficient for zoom domain
+      !!
+      !! ** Method  : - set along closed boundary due to zoom a damping over
+      !!                6 points with a max time scale of 5 days.
+      !!              - ORCA arctic/antarctic zoom: set the damping along
+      !!                south/north boundary over a latitude strip.
+      !!
+      !! ** Action  : - resto, the damping coeff. for T and S
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)  ::   presto   ! restoring coeff. (s-1)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  ::   mask   ! restoring coeff. (s-1)
+      !
+      INTEGER  ::   ji, jj, jn   ! dummy loop indices
+      REAL(wp) ::   zlat, zlat0, zlat1, zlat2, z1_5d   ! local scalar
+      REAL(wp), DIMENSION(6)  ::   zfact               ! 1Dworkspace
+
+      !Namelist variables
+      LOGICAL :: lzoom_w, lzoom_e, lzoom_n, lzoom_s 
+      NAMELIST/nam_zoom_dmp/lzoom_n,lzoom_e,lzoom_w,lzoom_s
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'dtacof_zoom')
+      !
+      
+      ! Read namelist
+      OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
+      READ( numnam, nam_dmp_create )
+      CLOSE( numnam )
+
+      zfact(1) =  1._wp
+      zfact(2) =  1._wp
+      zfact(3) = 11._wp / 12._wp
+      zfact(4) =  8._wp / 12._wp
+      zfact(5) =  4._wp / 12._wp
+      zfact(6) =  1._wp / 12._wp
+      zfact(:) = zfact(:) / ( 5._wp * rday )    ! 5 days max restoring time scale
+
+      presto(:,:) = 0._wp
+
+      ! damping along the forced closed boundary over 6 grid-points
+      DO jn = 1, 6
+         IF( lzoom_w )   presto( jn, : )                    = zfact(jn)   ! west  closed
+         IF( lzoom_s )   presto( : , jn )                    = zfact(jn)   ! south closed 
+         IF( lzoom_e )   presto( jpi+1-jn , : ) = zfact(jn)   ! east  closed 
+         IF( lzoom_n )   presto( : , jpj+1-jn ) = zfact(jn)   ! north closed
+      END DO
+
+      !                                           ! ====================================================
+      IF( cp_cfz == "arctic" .OR. cp_cfz == "antarctic" ) THEN   !  ORCA configuration : arctic or antarctic zoom
+         !                                        ! ====================================================
+         WRITE(numout,*)
+         IF(cp_cfz == "arctic" ) WRITE(numout,*) '              dtacof_zoom : ORCA    Arctic zoom'
+         IF(cp_cfz == "antarctic" ) WRITE(numout,*) '           dtacof_zoom : ORCA Antarctic zoom'
+         WRITE(numout,*)
+         !
+         !                          ! Initialization : 
+         presto(:,:) = 0._wp
+         zlat0 = 10._wp                     ! zlat0 : latitude strip where resto decreases
+         zlat1 = 30._wp                     ! zlat1 : resto = 1 before zlat1
+         zlat2 = zlat1 + zlat0              ! zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2
+         z1_5d = 1._wp / ( 5._wp * rday )   ! z1_5d : 1 / 5days
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zlat = ABS( gphit(ji,jj) )
+               IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
+                  presto(ji,jj) = 0.5_wp * z1_5d * (  1._wp - COS( rpi*(zlat2-zlat)/zlat0 )  ) 
+               ELSEIF( zlat < zlat1 ) THEN
+                  presto(ji,jj) = z1_5d
+               ENDIF
+            END DO
+         END DO
+         !
+      ENDIF
+      !                             ! Mask resto array
+      presto(:,:) = presto(:,:) * mask(:,:)
+
+   END SUBROUTINE dtacof_zoom
+
+END MODULE zoom
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/MISCELLANEOUS/chk_ifdef.sh
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/MISCELLANEOUS/chk_ifdef.sh	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/MISCELLANEOUS/chk_ifdef.sh	(revision 5682)
@@ -0,0 +1,31 @@
+#!/bin/bash
+#
+# check the propper syntax of C preprocessor directives.
+# for example:
+#if defined key_traldf_c3d && key_traldf_smag
+# is not good and should be
+#if defined key_traldf_c3d && defined key_traldf_smag
+#
+# use: go to TOOLS/MISCELLANEOUS/ and simply execute:
+#  ./chk_ifdef.sh 
+#
+set -u
+#
+grep -r "^ *#if" ../../NEMO | grep -v "~:" > tmp$$      # get each lines of the code starting with #if
+grep -r "^ *#elif" ../../NEMO | grep -v "~:" >> tmp$$   # get each lines of the code starting with #elif
+#
+for ll in $( seq 1 $( cat tmp$$ | wc -l  ) )            # for each of these lines
+do
+    lll=$( sed -n -e "${ll}p" tmp$$ )
+    nbdef=$( echo $lll | grep -o defined  | wc -l )         # number of occurences of "defined"
+    nband=$( echo $lll | grep -o   "&&"   | wc -l )         # number of occurences of "&&"
+    nbor=$(  echo $lll | grep -o   "||"   | wc -l )         # number of occurences of "||"
+    [ $nbdef -ne $(( $nband + $nbor + 1 )) ] && echo $lll   # print bad line
+done
+rm -f tmp$$ 
+
+#
+# add other basic tests
+#
+grep -ir  ":,:.*ji,jj" * | grep -v "~:"
+grep -ir  "ji,jj.*:,:" *  | grep -v "~:"
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh	(revision 5682)
@@ -12,22 +12,67 @@
 #   ../TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh
 #
-set -ue
+set -u
 #
 echo "check for all *90 files contained in "$( pwd )" and its subdirectories"
 #
-for ff in $( grep -il wrk_nemo_2 $( find . -name "*90" ) )
+for ff in $( grep -il "^ *use  *wrk_nemo" $( find . -name "*90" )  $( find . -name "*h90" ) )
 do
+    ierr=0
+    
+    # number of lines with wrk_alloc
+    n1=$( grep -ic "call *wrk_alloc *(" $ff )
+    # number of lines with wrk_dealloc
+    nn1=$( grep -ic "call *wrk_dealloc *(" $ff )  
+    
+    if [ $(( $n1 + $nn1 )) -ne 0 ]
+    then
+	# replace wrk_alloc with wrk_dealloc and count the lines
+	n2=$( sed -e "s/wrk_alloc/wrk_dealloc/" $ff | grep -ic "call *wrk_dealloc *(" )
+	# we should get n2 = 2 * n1...
+	if [ $(( 2 * $n1 )) -ne $n2 ]
+	then
+	    ierr=1
+	    echo "problem with wrk_alloc in $ff" 
+	fi
+	# same story but for wrk_dealloc
+	nn2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" )
+	if [ $(( 2 * $nn1 )) -ne $nn2 ]
+	then
+	    ierr=1
+	    echo "problem with wrk_dealloc in $ff" 
+	fi
 
-    # number of lines with wrk_alloc
-    n1=$( grep -ic "call *wrk_alloc *(" $ff )  
-    # replace wrk_alloc with wrk_dealloc and count the lines
-    n2=$( sed -e "s/wrk_alloc/wrk_dealloc/" $ff | grep -ic "call *wrk_dealloc *(" )
-    # we should get n2 = 2 * n1...
-    [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_alloc in $ff" 
-   
-    # same story but for wrk_dealloc
-    n1=$( grep -ic "call *wrk_dealloc *(" $ff )  
-    n2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" )
-    [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_dealloc in $ff" 
-   
+	if [ $ierr -eq 0 ] # check that wrk_alloc block is the same as wrk_dealloc block
+	then
+	    grep -i "call *wrk_alloc *("   $ff | sed -e "s/ //g" | sed -e "s/!.*//g" > txt1$$
+	    grep -i "call *wrk_dealloc *(" $ff | sed -e "s/wrk_dealloc/wrk_alloc/"  | sed -e "s/ //g" | sed -e "s/!.*//g" > txt2$$
+	    cmp txt1$$ txt2$$
+	    if [ $? -ne 0 ]
+	    then
+		echo "different syntax in wrk_alloc and wrk_dealloc in $ff"
+		echo
+		for ll in $( seq 1 $n1 )  # compare each line
+		do
+		    sed -n ${ll}p txt1$$ > ll1$$
+		    sed -n ${ll}p txt2$$ > ll2$$
+		    cmp ll1$$ ll2$$ > /dev/null
+		    if [ $? -ne 0 ]
+		    then
+			grep -i "call *wrk_alloc *("   $ff | sed -n ${ll}p
+			grep -i "call *wrk_dealloc *(" $ff | sed -n ${ll}p
+			echo
+		    fi
+		    rm -f ll1$$ ll2$$
+		done
+	    fi
+	    rm -f txt1$$ txt2$$
+	else
+	    grep -i "call *wrk_alloc *(" $ff
+	    echo
+	    grep -i "call *wrk_dealloc *(" $ff	
+	    echo
+	fi
+	
+    fi
+    
 done
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh	(revision 5682)
@@ -1,10 +1,15 @@
 #!/bin/bash
+#
+# rsync -av NEMO/ NEMO_no_wrkarrays/
+# cd NEMO_no_wrkarrays/
+# ../TOOLS/MISCELLANEOUS/rewrite_nemo.sh
+# cd ../CONFIG
+# ./makenemo -n ORCA2_LIM3 -s NEMO_no_wrkarrays
 #
 set -u
 #set -xv
 #
-# for on each file containing a call to work alloc (exept BDY files that are too complicated...)
-#for i in $( ack -il "^ *call *wrk_alloc *\(" | grep -v BDY )
-for i in $( egrep -iRl "^ *call *wrk_alloc *\(" * | grep "90$" | grep -v BDY )
+# for on each file containing a call to work alloc
+for i in $( grep -iRl "^[^\!]*call *wrk_alloc *(" * | grep "90$" )
 do
 # create a temporary file that will be easier to process...
@@ -28,5 +33,5 @@
 #
 # number of the lines containing wrk_alloc
-    cnt=$( grep -ci "^ *call *wrk_alloc *(" tmp$$ )
+    cnt=$( grep -ci "^[^\!]*call *wrk_alloc *(" tmp$$ )
 # for each of these lines
     ll=1
@@ -34,9 +39,9 @@
     do
 # get the line with its number
-	line=$( grep -in "^ *call *wrk_alloc *(" tmp$$ | sed -n ${ll}p | sed -e "s/\!.*//" )
+	line=$( grep -in "^[^\!]*call *wrk_alloc *(" tmp$$ | sed -n ${ll}p | sed -e "s/\!.*//" )
 # get its number
 	lline=$( echo $line | sed -e "s/:.*//" )
 # keep only the arument of wrk_alloc between ()
-	line=$( echo $line | sed -e "s/[^(]*\((.*)\).*/\1/" | sed -e "s/, *k[ijkl]start *=[^,]*,/,/" | sed -e "s/, *k[ijkl]start *=.*)/ )/" )
+	line=$( echo $line | sed -e "s/^.*[cC][aA][lL][lL] *[wW][rR][kK]_[aA][lL][lL][oO][cC]//" | sed -e "s/[^(]*\((.*)\).*/\1/" | sed -e "s/, *k[ijkl]start *=[^,]*,/,/" | sed -e "s/, *k[ijkl]start *=.*)/ )/" )
 # find in which subroutine or function is located this call to wrk_alloc: l1 beginning l2: end
 	for lll in $linesbegin
@@ -132,35 +137,71 @@
 #
 # OPA_SRC/SBC/albedo.F90
-sed -e "s/DIMENSION(jpi,jpj,ijpl)/DIMENSION(jpi,jpj,SIZE(pt_ice,3))/" OPA_SRC/SBC/albedo.F90 > tmp$$
+sed -e "s/DIMENSION(jpi,jpj,ijpl/DIMENSION(jpi,jpj,SIZE(pt_ice,3)/" OPA_SRC/SBC/albedo.F90 > tmp$$
 mv tmp$$ OPA_SRC/SBC/albedo.F90
+# see result of
+#    grep -i "wrk_alloc" $( find . -name "*90" ) | grep "="
+#
 # LIM_SRC_2/limrhg_2.F90
-sed -e "s/DIMENSION(jpi,jpj+2)/DIMENSION(jpi,0:jpj+1)/" LIM_SRC_2/limrhg_2.F90 > tmp$$
+#./LIM_SRC_2/limrhg_2.F90:      CALL wrk_alloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 )
+#./LIM_SRC_2/limrhg_2.F90:      CALL wrk_alloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 )
+sed -e "s/DIMENSION(jpi,jpj+2/DIMENSION(jpi,0:jpj+1/" LIM_SRC_2/limrhg_2.F90 > tmp$$
 mv tmp$$ LIM_SRC_2/limrhg_2.F90
+
 # LIM_SRC_3/limitd_me.F90
+#./LIM_SRC_3/limitd_me.F90:      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
 sed -e "s/DIMENSION(jpi,jpj,jpl+2)/DIMENSION(jpi,jpj,-1:jpl)/" LIM_SRC_3/limitd_me.F90 > tmp$$
 mv tmp$$ LIM_SRC_3/limitd_me.F90
+
 # LIM_SRC_3/limitd_th.F90
+#./LIM_SRC_3/limitd_th.F90:      CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
 sed -e "s/DIMENSION(jpi,jpj,jpl+1)/DIMENSION(jpi,jpj,0:jpl)/" LIM_SRC_3/limitd_th.F90 > tmp$$
 mv tmp$$ LIM_SRC_3/limitd_th.F90
+
 # LIM_SRC_3/limthd_dif.F90
+#./LIM_SRC_3/limthd_dif.F90:      CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 )
+#./LIM_SRC_3/limthd_dif.F90:      CALL wrk_alloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 )
 sed -e "s/DIMENSION(kiut,nlay_i+1)/DIMENSION(kiut,0:nlay_i)/" \
     -e "s/DIMENSION(kiut,nlay_s+1)/DIMENSION(kiut,0:nlay_s)/" LIM_SRC_3/limthd_dif.F90 > tmp$$
 mv tmp$$ LIM_SRC_3/limthd_dif.F90
+
 # LIM_SRC_3/limthd_ent.F90
-sed -e "s/DIMENSION(jpij,jkmax+4)/DIMENSION(jpij,0:jkmax+3)/" \
-    -e "s/DIMENSION(jkmax+4,jkmax+4)/DIMENSION(0:jkmax+3,0:jkmax+3)/" LIM_SRC_3/limthd_ent.F90 > tmp$$
+#./LIM_SRC_3/limthd_ent.F90:      CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 )
+#./LIM_SRC_3/limthd_ent.F90:      CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 )
+sed -e "s/DIMENSION(jpij,nlay_i+3)/DIMENSION(jpij,0:nlay_i+2)/" \
+    -e "s/DIMENSION(jpij,nlay_i+1)/DIMENSION(jpij,0:nlay_i)/" LIM_SRC_3/limthd_ent.F90 > tmp$$
 mv tmp$$ LIM_SRC_3/limthd_ent.F90
+
 # OPA_SRC/DYN/divcur.F90
+#./OPA_SRC/DYN/divcur.F90:      CALL wrk_alloc( jpi+4, jpj  , zwv, kjstart = -1 )
 sed -e "s/DIMENSION(jpi+4,jpj)/DIMENSION(-1:jpi+2,jpj)/" OPA_SRC/DYN/divcur.F90 > tmp$$
 mv tmp$$ OPA_SRC/DYN/divcur.F90
+
 # OPA_SRC/LDF/ldfslp.F90
+#./OPA_SRC/LDF/ldfslp.F90:      CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
+#./OPA_SRC/LDF/ldfslp.F90:      CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
 sed -e "s/DIMENSION(jpi,jpj,jpk,2)/DIMENSION(jpi,jpj,jpk,0:1)/" \
     -e "s/DIMENSION(jpi,jpj,2,2)/DIMENSION(jpi,jpj,0:1,0:1)/" OPA_SRC/LDF/ldfslp.F90 > tmp$$
 mv tmp$$ OPA_SRC/LDF/ldfslp.F90
 # OPA_SRC/ZDF/zdfkpp.F90
+#./OPA_SRC/ZDF/zdfkpp.F90:      CALL wrk_alloc( jpi,3, zmoek, kjstart = 0 )
 sed -e "s/DIMENSION(jpi,3) *::* zmoek/DIMENSION(jpi,0:2) ::   zmoek/" OPA_SRC/ZDF/zdfkpp.F90 > tmp$$
 mv tmp$$ OPA_SRC/ZDF/zdfkpp.F90
 
-# link for limrhg.F90...
+# links 
+# see result of
+# find . -type l
+#
+# ./LIM_SRC_2/limrhg.F90
 cd LIM_SRC_2
 ln -sf ../LIM_SRC_3/limrhg.F90 .
+cd ..
+
+# ./OOO_SRC/dtadyn.F90
+cd OOO_SRC
+ln -sf ../OFF_SRC/dtadyn.F90 .
+cd ..
+
+# ./OOO_SRC/obs_fbm.F90
+cd OOO_SRC
+ln -sf ../OPA_SRC/OBS/obs_fbm.F90 .
+cd ..
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/agulhas
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/agulhas	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/agulhas	(revision 5682)
@@ -17,4 +17,5 @@
     removeclosedseas = true
     type_bathy_interp = 0 
+    rn_hmin = -3 
 /   
 
@@ -39,4 +40,8 @@
     pa1  = 245.58132232490
     N  = 31
+    ldbletanh   = .FALSE.
+    ppa2        = 0.0
+    ppkth2      = 0.0
+    ppacr2      = 0.0
 /    
     
@@ -45,6 +50,6 @@
     parent_bathy_meter = 'bathy_meter.nc'
     parent_batmet_name = 'Bathymetry'
-    e3zps_min = 25.
-    e3zps_rat = 0.2
+    e3zps_min = 20.
+    e3zps_rat = 0.1
 /
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 5682)
@@ -105,5 +105,5 @@
     IMPLICIT NONE
     !
-    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax
     TYPE(Coordinates) :: Grid
     INTEGER :: i,j
@@ -134,4 +134,5 @@
        za0  = pa0
        za1  = pa1
+       za2  = pa2
        !
     ELSE
@@ -147,19 +148,49 @@
 
     zacr = ppacr
-    zkth = ppkth 
-
+    zkth = ppkth
+    zacr2 = ppacr2
+    zkth2 = ppkth2   
     !
     ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
     !
-    DO i = 1,N
-       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
-       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
-       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
-       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
-    END DO
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+       za1 = pphmax / FLOAT(N-1) 
+       DO i = 1, N
+          gdepw(i) = ( i - 1   ) * za1
+          gdept(i) = ( i - 0.5 ) * za1
+          e3w  (i) =  za1
+          e3t  (i) =  za1
+       END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+          DO i = 1,N
+             ! Double tanh function
+             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
+                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
+             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
+                &                            + za2        * TANH(       (i-zkth2) / zacr2 )
+             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+            END DO
+       ENDIF
+    ENDIF
     !
     gdepw(1) = 0.0
     zmax = gdepw(N) + e3t(N)
-    zmin = gdepw(4)
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
     !
     IF ( .NOT. ASSOCIATED(Grid%bathy_level)) &
@@ -227,5 +258,5 @@
     IMPLICIT NONE
     !
-    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax
     TYPE(Coordinates) :: Grid
     INTEGER :: i,j
@@ -257,4 +288,5 @@
        za0  = pa0
        za1  = pa1
+       za2  = pa2
        !
     ELSE
@@ -264,22 +296,48 @@
        WRITE(*,*) 'please check values of variables'
        WRITE(*,*) 'in namelist vertical_grid section'
-       WRITE(*,*) ' '
-       STOP      
+       WRITE(*,*) ' ' 
+       STOP     
        !       
     ENDIF
-    !
+
     zacr = ppacr
-    zkth = ppkth 
-
+    zkth = ppkth
+    zacr2 = ppacr2
+    zkth2 = ppkth2   
     !
     ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
     !
-    DO i = 1,N
-       ! 
-       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
-       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
-       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
-       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
-    END DO
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+       za1 = pphmax / FLOAT(N-1) 
+       DO i = 1, N
+          gdepw(i) = ( i - 1   ) * za1
+          gdept(i) = ( i - 0.5 ) * za1
+          e3w  (i) =  za1
+          e3t  (i) =  za1
+       END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+          DO i = 1,N
+             ! Double tanh function
+             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
+                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
+             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
+                &                            + za2        * TANH(       (i-zkth2) / zacr2 )
+             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+         END DO
+       ENDIF
+    ENDIF
     !
     gdepw(1) = 0.0  
@@ -684,8 +742,8 @@
   ! for consistency with fine grid bathymetry			*
   !								*
-  ! if a given coarse grid point is masked and one of the		*
-  ! child grid points contained in this coarse cell is not masked	*
-  ! the corresponding coarse grid point is unmasked with gdepw(4) *
-  ! value								*
+  ! if a given coarse grid point is masked and one of the	  *
+  ! child grid points contained in this coarse cell is not masked *
+  ! the corresponding coarse grid point is unmasked with rn_hmin  *
+  ! value						          *
   !								*
   ! - input :							*
@@ -704,5 +762,5 @@
     !
     INTEGER :: ideb,jdeb,ifin,jfin
-    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin
     INTEGER :: i,j
     INTEGER :: k1
@@ -727,4 +785,5 @@
        za0  = pa0
        za1  = pa1
+       za2  = pa2
        !
     ELSE
@@ -740,18 +799,47 @@
 
     zacr = ppacr
-    zkth = ppkth 
-
+    zkth = ppkth
+    zacr2 = ppacr2
+    zkth2 = ppkth2   
     !
     ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
     !
-    DO i = 1,N
-       ! 
-       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
-       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
-       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
-       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
-    END DO
-    !
-    zmin = gdepw(4)
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+       za1 = pphmax / FLOAT(N-1) 
+       DO i = 1, N
+          gdepw(i) = ( i - 1   ) * za1
+          gdept(i) = ( i - 0.5 ) * za1
+          e3w  (i) =  za1
+          e3t  (i) =  za1
+       END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+          DO i = 1,N
+             ! Double tanh function
+             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
+                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
+             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
+                &                            + za2        * TANH(       (i-zkth2) / zacr2 )
+             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+          END DO
+       ENDIF
+    ENDIF
+    !
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
     !      
     diff = 0
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 5682)
@@ -36,5 +36,5 @@
     !       
     TYPE(Coordinates) :: Grid                     
-    REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
     INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt
     INTEGER, DIMENSION(1) :: k
@@ -76,4 +76,5 @@
        za0  = pa0
        za1  = pa1
+       za2  = pa2
        !
     ELSE
@@ -88,17 +89,41 @@
     ENDIF
 
-    zacr = ppacr
-    zkth = ppkth       
-    !
-    DO i = 1,N
-       ! 
-       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
-       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
-       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
-       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
-       !
-    END DO
-    !
-
+    zacr  = ppacr
+    zkth  = ppkth     
+    zacr2 = ppacr2
+    zkth2 = ppkth2  
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+         za1 = pphmax / FLOAT(N-1) 
+         DO i = 1, N
+            gdepw(i) = ( i - 1   ) * za1
+            gdept(i) = ( i - 0.5 ) * za1
+            e3w  (i) =  za1
+            e3t  (i) =  za1
+         END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+            DO i = 1,N
+               ! Double tanh function
+               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+               gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
+                  &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
+               e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
+                  &                            + za2        * TANH(       (i-zkth2) / zacr2 )
+               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+            END DO
+       ENDIF
+    ENDIF
     gdepw(1) = 0.0  
     !
@@ -106,5 +131,8 @@
     !
     zmax = gdepw(N) + e3t(N)
-    zmin = gdepw(4)
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
     !
     ! Initialize bathy_level to the maximum ocean level available
@@ -235,11 +263,12 @@
     INTEGER :: i,j,ji,ij,ii,jj,jpt,ipt
     REAL,DIMENSION(N) :: gdepw,e3t
-    REAL :: za0,za1,zsur,zacr,zkth,zmin,zmax,zdepth
+    REAL :: za0,za1,za2,zsur,zacr,zacr2,zkth,zkth2,zmin,zmax,zdepth
     INTEGER :: kbathy,jk,diff
     INTEGER :: bornex,borney,bornex2,borney2
-    !       
+    !
     IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
          .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
        !    
+       WRITE(*,*) 'psur,pa0,pa1 computed'
        za1=( ppdzmin - pphmax / (N-1) )          &
             / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
@@ -253,7 +282,9 @@
          pa0.NE.0 .AND. pa1.NE.0 ) THEN
        !       
+       WRITE(*,*) 'psur,pa0,pa1 given by namelist'
        zsur = psur
        za0  = pa0
        za1  = pa1
+       za2  = pa2
        !
     ELSE
@@ -263,19 +294,39 @@
        WRITE(*,*) 'please check values of variables'
        WRITE(*,*) 'in namelist vertical_grid section'
-       WRITE(*,*) ' '      
-       !       
-    ENDIF
-    !       
-    zacr = ppacr
-    zkth = ppkth       
-    !
-    DO i = 1,N
-       ! 
-       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))
-       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))       
-    END DO
-    !
+       WRITE(*,*) ' '  
+       STOP    
+       !       
+    ENDIF
+
+    zacr  = ppacr
+    zkth  = ppkth     
+    zacr2 = ppacr2
+    zkth2 = ppkth2  
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+         za1 = pphmax / FLOAT(N-1) 
+         DO i = 1, N
+            gdepw(i) = ( i - 1   ) * za1
+            e3t  (i) =  za1
+         END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+            DO i = 1,N
+               ! Double tanh function
+               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+            END DO
+       ENDIF
+    ENDIF
     gdepw(1) = 0.0
-    !
     !
     diff = 0      
@@ -344,5 +395,8 @@
     !
     zmax = gdepw(N) + e3t(N)
-    zmin = gdepw(4) 
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
     !
     ! check that interpolated value stays at the same level         
@@ -646,5 +700,5 @@
     REAL*8, DIMENSION(:,:,:) :: fse3u,fse3t,fse3v
     !                                  
-    REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
     INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt,jpk
     INTEGER, DIMENSION(1) :: k
@@ -660,5 +714,5 @@
     ALLOCATE(gdepw(jpk),e3t(jpk))
     ALLOCATE(gdepw_ps(jpi,jpj,jpk))                  
-    !       
+    !  
     IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
          .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
@@ -668,6 +722,6 @@
             / ( TANH((1-ppkth)/ppacr) - ppacr/(jpk-1) &
             *  (  LOG( COSH( (jpk - ppkth) / ppacr) )      &
-            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  ) 
-       !
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
        za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
        zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
@@ -676,18 +730,53 @@
          pa0.NE.0 .AND. pa1.NE.0 ) THEN
        !       
+       WRITE(*,*) 'psur,pa0,pa1 given by namelist'
        zsur = psur
        za0  = pa0
-       za1  = pa1   
-       !       
-    ENDIF
-
-    zacr = ppacr
-    zkth = ppkth       
+       za1  = pa1
+       za2  = pa2
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' '  
+       STOP    
+       !       
+    ENDIF
+
+    zacr  = ppacr
+    zkth  = ppkth     
+    zacr2 = ppacr2
+    zkth2 = ppkth2  
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+         za1 = pphmax / FLOAT(jpk-1) 
+         DO i = 1, jpk
+            gdepw(i) = ( i - 1   ) * za1
+            e3t  (i) =  za1
+         END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,jpk
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+            DO i = 1,jpk
+               ! Double tanh function
+               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+            END DO
+       ENDIF
+    ENDIF         
     !         
     !                
     DO i = 1,jpk
-       ! 
-       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
-       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
        !       
        fse3t(:,:,i) = e3t(i)
@@ -700,5 +789,8 @@
     !
     zmax = gdepw(jpk) + e3t(jpk)
-    zmin = gdepw(4)
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
     !
     DO jj = 1, jpj
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 5682)
@@ -51,7 +51,9 @@
   INTEGER jpizoom,jpjzoom,nb_connection_pts
   !      
-  REAL*8 ppacr,ppdzmin,pphmax,ppkth,smoothing_factor,e3zps_min,e3zps_rat
-  REAL*8 psur,pa0,pa1,adatrj
+  REAL*8 rn_hmin
+  REAL*8 ppkth2, ppacr2, ppkth,ppacr,ppdzmin,pphmax,smoothing_factor,e3zps_min,e3zps_rat
+  REAL*8 psur,pa0,pa1,pa2,adatrj
   !       
+  LOGICAL ldbletanh
   LOGICAL partial_steps,smoothing,bathy_update
   LOGICAL new_topo,removeclosedseas,dimg,iom_activated
@@ -70,9 +72,9 @@
   !      
   NAMELIST /bathymetry/new_topo,elevation_database,elevation_name,smoothing,smoothing_factor, &
-       nb_connection_pts,removeclosedseas,type_bathy_interp      
+       nb_connection_pts,removeclosedseas,type_bathy_interp,rn_hmin      
   !      
   NAMELIST /nesting/imin,imax,jmin,jmax,rho,rhot,bathy_update,updated_parent_file      
   !
-  NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N
+  NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N,ldbletanh,ppa2,ppkth2,ppacr2
   ! 
   NAMELIST /partial_cells/partial_steps,parent_bathy_meter,parent_batmet_name,e3zps_min,e3zps_rat      
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg	(revision 5682)
@@ -1,73 +1,159 @@
-# name       | units          | axis | point | standard name                | long name          | interpolation
-X            | 1              | X    |   | projection_x_coordinate          |                    |                      
-Y            | 1              | Y    |   | projection_y_coordinate          |                    |                      
-Z            | 1              | Z    |   | projection_z_coordinate          |                    |                      
-T            | 1              | T    |   | projection_t_coordinate          |                    |                      
-nav_lon      | degrees_east   | XY   | T | longitude                        | Longitude          | cubic                      
-nav_lat      | degrees_north  | XY   | T | latitude                         | Latitude           | cubic         
-nav_lev      | model_levels   | Z    | T |                                  | Model levels       | cubic        
-deptht       | m              | Z    | T | depth                            | Vertical T levels  |
-time_counter |                | T    |   | time                             | Time axis          | 
-Bathymetry   | m              | XY   | T | bathymetry                       | Bathymetry         | cubic         
-votemper     | degree_Celsius | XYZT | T | sea_water_potential_temperature  | Temperature        | cubic         
-vozocrtx     | m s-1          | XYZT | U |                                  | Zonal velocity     | cubic         
-vomecrty     | m s-1          | XYZT | V |                                  | Meridional velocity| cubic         
-vosaline     | PSU            | XYZT | T | sea_water_salinity               | Salinity           | cubic         
-sossheig     | m              | XYT  | T | sea_surface_height               | Sea Surface Height | cubic         
-glamt        | degrees_east   | XY   | T |                                  | Longitude_T        | cubic
-glamu        | degrees_east   | XY   | U |                                  | Longitude_U        | cubic            
-glamv        | degrees_east   | XY   | V |                                  | Longitude_V        | cubic          
-glamf        | degrees_east   | XY   | F |                                  | Longitude_F        | cubic         
-gphit        | degrees_north  | XY   | T |                                  | Latitude_T         | cubic         
-gphiu        | degrees_north  | XY   | U |                                  | Latitude_U         | cubic        
-gphiv        | degrees_north  | XY   | V |                                  | Latitude_V         | cubic        
-gphif        | degrees_north  | XY   | F |                                  | Latitude_F         | cubic        
-e1t          | m              | XY   | T |                                  |                    | cubic/rhoi    
-e1u          | m              | XY   | U |                                  |                    | cubic/rhoi     
-e1v          | m              | XY   | V |                                  |                    | cubic/rhoi      
-e1f          | m              | XY   | F |                                  |                    | cubic/rhoi    
-e2t          | m              | XY   | T |                                  |                    | cubic/rhoj      
-e2u          | m              | XY   | U |                                  |                    | cubic/rhoj      
-e2v          | m              | XY   | V |                                  |                    | cubic/rhoj     
-e2f          | m              | XY   | F |                                  |                    | cubic/rhoj      
-tmask        |                | XYZ  | T |                                  |                    | nearest       
-umask        |                | XYZ  | U |                                  |                    | nearest       
-vmask        |                | XYZ  | V |                                  |                    | nearest       
-fmask        |                | XYZ  | F |                                  |                    | nearest       
-weight       |                | XY   | T |                                  |                    |               
-kt           |                |      |   |                                  |                    |               
-ndastp       |                |      |   |                                  |                    |               
-adatrj       |                |      |   |                                  |                    |               
-kt           |                |      |   |                                  |                    |               
-rdt          |                |      |   |                                  |                    |               
-rdttra1      |                |      |   |                                  |                    |               
-utau_b       |                | XYT  | U |surface_downward_eastward_stress  |                    |               
-vtau_b       |                | XYT  | V |surface_downward_northward_stress |                    |               
-qns_b        |                | XYT  | T |                                  |                    |               
-emp_b        |                | XYT  | T |                                  |                    |               
-sfx_b        |                | XYT  | T |                                  |                    |               
-en           |                | XYZT | T |                                  |                    |               
-avt          |                | XYZT | T |                                  |                    |               
-avm          |                | XYZT | T |                                  |                    |               
-avmu         |                | XYZT | T |                                  |                    |               
-avmv         |                | XYZT | T |                                  |                    |               
-dissl        |                | XYZT | T |                                  |                    |               
-sbc_hc_b     |                | XYT  | T |                                  |                    |               
-sbc_sc_b     |                | XYT  | T |                                  |                    |               
-gcx          |                | XYT  | T |                                  |                    |               
-gcxb         |                | XYT  | T |                                  |                    |               
-ub           |                | XYZT | U |                                  |                    |               
-vb           |                | XYZT | V |                                  |                    |               
-tb           |                | XYZT | T |                                  |                    |               
-sb           |                | XYZT | T |                                  |                    |               
-rotb         |                | XYZT | T |                                  |                    |               
-hdivb        |                | XYZT | T |                                  |                    |               
-sshb         |                | XYT  | T |                                  |                    |               
-un           |                | XYZT | U |                                  |                    |               
-vn           |                | XYZT | V |                                  |                    |               
-tn           |                | XYZT | T |                                  |                    |               
-sn           |                | XYZT | T |                                  |                    |               
-rotn         |                | XYZT | T |                                  |                    |               
-hdivn        |                | XYZT | T |                                  |                    |               
-sshn         |                | XYT  | T |                                  |                    |               
-rhop         |                | XYZT | T |                                  |                    |               
+# name       | units          | axis | pt| interpolation   | long name                             | standard name                                  
+X            | 1              | X    |   |                 |                                       | projection_x_coordinate               
+Y            | 1              | Y    |   |                 |                                       | projection_y_coordinate               
+Z            | 1              | Z    |   |                 |                                       | projection_z_coordinate               
+T            | 1              | T    |   |                 |                                       | projection_t_coordinate               
+nav_lon      | degrees_east   | XY   | T | cubic           | Longitude                             | longitude                                   
+nav_lat      | degrees_north  | XY   | T | cubic           | Latitude                              | latitude                         
+nav_lev      | model_levels   | Z    | T | cubic           | Model levels                          |                                  
+deptht       | m              | Z    | T |                 | Vertical T levels                     | depth                            
+time_counter |                | T    |   |                 | Time axis                             | time                             
+Bathymetry   | m              | XY   | T | cubic           | Bathymetry                            | bathymetry                       
+votemper     | degree_Celsius | XYZT | T | cubic           | Temperature                           | sea_water_potential_temperature  
+vozocrtx     | m s-1          | XYZT | U | cubic           | Zonal velocity                        |                                  
+vomecrty     | m s-1          | XYZT | V | cubic           | Meridional velocity                   |                                  
+vosaline     | PSU            | XYZT | T | cubic           | Salinity                              | sea_water_salinity               
+sossheig     | m              | XYT  | T | cubic           | Sea Surface Height                    | sea_surface_height               
+sotemper     | m              | XYT  | T | cubic           |                                       |                                  
+sossheig     | m              | XYT  | T | cubic           |                                       |                                  
+glamt        | degrees_east   | XY   | T | cubic           | Longitude_T                           |                                  
+glamu        | degrees_east   | XY   | U | cubic           | Longitude_U                           |                                   
+glamv        | degrees_east   | XY   | V | cubic           | Longitude_V                           |                                  
+glamf        | degrees_east   | XY   | F | cubic           | Longitude_F                           |                                  
+gphit        | degrees_north  | XY   | T | cubic           | Latitude_T                            |                                  
+gphiu        | degrees_north  | XY   | U | cubic           | Latitude_U                            |                                  
+gphiv        | degrees_north  | XY   | V | cubic           | Latitude_V                            |                                  
+gphif        | degrees_north  | XY   | F | cubic           | Latitude_F                            |                                  
+e1t          | m              | XY   | T | cubic/rhoi      |                                       |                                  
+e1u          | m              | XY   | U | cubic/rhoi      |                                       |                                  
+e1v          | m              | XY   | V | cubic/rhoi      |                                       |                                  
+e1f          | m              | XY   | F | cubic/rhoi      |                                       |                                  
+e2t          | m              | XY   | T | cubic/rhoj      |                                       |                                  
+e2u          | m              | XY   | U | cubic/rhoj      |                                       |                                  
+e2v          | m              | XY   | V | cubic/rhoj      |                                       |                                  
+e2f          | m              | XY   | F | cubic/rhoj      |                                       |                                  
+tmask        |                | XYZ  | T | nearest         |                                       |                                  
+umask        |                | XYZ  | U | nearest         |                                       |                                  
+vmask        |                | XYZ  | V | nearest         |                                       |                                  
+fmask        |                | XYZ  | F | nearest         |                                       |                                  
+weight       |                | XY   | T |                 |                                       |                                  
+kt           |                |      |   |                 |                                       |                                  
+ndastp       |                |      |   |                 |                                       |                                  
+adatrj       |                |      |   |                 |                                       |                                  
+kt           |                |      |   |                 |                                       |                                  
+rdt          |                |      |   |                 |                                       |                                  
+rdttra1      |                |      |   |                 |                                       |                                  
+utau_b       |                | XY   | U |                 |                                       |surface_downward_eastward_stress  
+vtau_b       |                | XY   | V |                 |                                       |surface_downward_northward_stress 
+qns_b        |                | XY   | T |                 |                                       |                                  
+emp_b        |                | XY   | T |                 |                                       |                                  
+sfx_b        |                | XY   | T |                 |                                       |                                  
+en           |                | XYZ  | T |                 |                                       |                                  
+avt          |                | XYZ  | T |                 | vertical eddy diffusivity             |                                  
+avm          |                | XYZ  | T |                 | vertical eddy viscosity               |                                  
+avmu         |                | XYZ  | T |                 |                                       |                                  
+avmv         |                | XYZ  | T |                 |                                       |                                  
+dissl        |                | XYZ  | T |                 |                                       |                                  
+sbc_hc_b     |                | XY   | T |                 |                                       |                                  
+sbc_sc_b     |                | XY   | T |                 |                                       |                                  
+gcx          |                | XY   | T |                 |                                       |                                  
+gcxb         |                | XY   | T |                 |                                       |                                  
+ub           |                | XYZ  | U |                 |                                       |                                  
+vb           |                | XYZ  | V |                 |                                       |                                  
+tb           |                | XYZ  | T |                 |                                       |                                  
+sb           |                | XYZ  | T |                 |                                       |                                  
+rotb         |                | XYZ  | T |                 |                                       |                                  
+hdivb        |                | XYZ  | T |                 |                                       |                                  
+sshb         |                | XY   | T |                 |                                       |                                  
+un           |                | XYZ  | U |                 |                                       |                                  
+vn           |                | XYZ  | V |                 |                                       |                                  
+tn           |                | XYZ  | T |                 |                                       |                                  
+sn           |                | XYZ  | T |                 |                                       |                                  
+rotn         |                | XYZ  | T |                 |                                       |                                  
+hdivn        |                | XYZ  | T |                 |                                       |                                  
+sshn         |                | XYT  | T |                 |                                       |                                  
+rhop         |                | XYZ  | T |                 |                                       |                                  
+dic          |                | XYZT | T |                 | Dissolved Inorganic Carbon            | mole_concentration_of_dissolved_inorganic_caron_in_sea_water
+alkalini     |                | XYZT | T |                 | Total Alkalinity                      | sea_water_alkalinity_expressed_as_mole_equivalent
+o2           |                | XYZT | T |                 | Dissolved Oxygen                      | mole_concentration_of_dissolved_molecular_oxygen_in_sea_water
+caco3        |                | XYZT | T |                 | Calcite                               |                                  
+po4          |                | XYZT | T |                 | Phosphate                             | mole_concentration_of_phosphate_in_sea_water
+poc          |                | XYZT | T |                 | Small Particulate Organic Carbon      |                                  
+si           |                | XYZT | T |                 | Dissolved Silicate                    | mole_concentration_of_silicate_in_sea_water
+phy          |                | XYZT | T |                 | Nanophytoplankton                     |                                  
+zoo          |                | XYZT | T |                 | Microzooplankton                      | mole_concentration_of_microzooplankton_expressed_as_carbon_in_sea_water
+doc          |                | XYZT | T |                 | Dissolved Organic Carbon              |                                  
+phy2         |                | XYZT | T |                 | Diatoms                               |                                  
+zoo2         |                | XYZT | T |                 | Mesozooplankton                       | mole_concentration_of_mesozooplankton_expressed_as_carbon_in_sea_water
+gsi          |                | XYZT | T |                 | Sinking biogenic Silica               |                                  
+fer          |                | XYZT | T |                 | Dissolved Iron                        | mole_concentration_of_dissolved_iron_in_sea_water
+bfe          |                | XYZT | T |                 | Iron in the big particles             |                                  
+goc          |                | XYZT | T |                 | Big Particulate Organic Carbon        |                                  
+sfe          |                | XYZT | T |                 | Iron in the small particles           |                                  
+dfe          |                | XYZT | T |                 | Iron content of the Diatoms           |                                  
+dsi          |                | XYZT | T |                 | Silicon content of the Diatoms        |                                  
+nfe          |                | XYZT | T |                 | Iron content of the Nanophytoplankton |                                  
+nchl         |                | XYZT | T |                 | Chlorophyll of the Nanophytoplankton  |                                  
+dchl         |                | XYZT | T |                 | Chlorophyll of the Diatoms            |                                  
+no3          |                | XYZT | T |                 | Nitrate                               | mole_concentration_of_nitrate_in_sea_water
+nh4          |                | XYZT | T |                 | Ammonium                              | mole_concentration_of_ammonium_in_sea_water
+ppd          |                | XYZT | T |                 |                                       |                                  
+ppn          |                | XYZT | T |                 |                                       |                                  
+ph           |                | XYZT | T |                 |                                       |                                  
+cflx         |                | XYZT | T |                 |                                       |                                  
+oflx         |                | XYZT | T |                 |                                       |                                  
+kg           |                | XYZT | T |                 |                                       |                                  
+dpco2        |                | XYZT | T |                 |                                       |                                  
+heup         |                | XYZT | T |                 |                                       |                                  
+kz           |                | XYZT | T |                 |                                       |                                  
+irondep      |                | XYZT | T |                 |                                       |                                  
+kt_ice       |                |      |   |                 |                                       |                                  
+hicif        |                |      |   |                 |                                       |                                  
+hsnif        |                |      |   |                 |                                       |                                  
+frld         |                |      |   |                 |                                       |                                  
+sist         |                |      |   |                 |                                       |                                  
+tbif1        |                |      |   |                 |                                       |                                  
+tbif2        |                |      |   |                 |                                       |                                  
+tbif3        |                |      |   |                 |                                       |                                  
+ui_ice       |                |      |   |                 |                                       |                                  
+vi_ice       |                |      |   |                 |                                       |                                  
+qstoif       |                |      |   |                 |                                       |                                  
+fsbbq        |                |      |   |                 |                                       |                                  
+stress1_i    |                |      |   |                 |                                       |                                  
+stress2_i    |                |      |   |                 |                                       |                                  
+stress12_i   |                |      |   |                 |                                       |                                  
+sxice        |                |      |   |                 |                                       |                                  
+syice        |                |      |   |                 |                                       |                                  
+sxxice       |                |      |   |                 |                                       |                                  
+syyice       |                |      |   |                 |                                       |                                  
+sxyice       |                |      |   |                 |                                       |                                  
+sxsn         |                |      |   |                 |                                       |                                  
+sysn         |                |      |   |                 |                                       |                                  
+sxxsn        |                |      |   |                 |                                       |                                  
+syysn        |                |      |   |                 |                                       |                                  
+sxysn        |                |      |   |                 |                                       |                                  
+sxa          |                |      |   |                 |                                       |                                  
+sya          |                |      |   |                 |                                       |                                  
+sxxa         |                |      |   |                 |                                       |                                  
+syya         |                |      |   |                 |                                       |                                  
+sxya         |                |      |   |                 |                                       |                                  
+sxc0         |                |      |   |                 |                                       |                                  
+syc0         |                |      |   |                 |                                       |                                  
+sxxc0        |                |      |   |                 |                                       |                                  
+syyc0        |                |      |   |                 |                                       |                                  
+sxyc0        |                |      |   |                 |                                       |                                  
+sxc1         |                |      |   |                 |                                       |                                  
+syc1         |                |      |   |                 |                                       |                                  
+sxxc1        |                |      |   |                 |                                       |                                  
+syyc1        |                |      |   |                 |                                       |                                  
+sxyc1        |                |      |   |                 |                                       |                                  
+sxc2         |                |      |   |                 |                                       |                                  
+syc2         |                |      |   |                 |                                       |                                  
+sxxc2        |                |      |   |                 |                                       |                                  
+syyc2        |                |      |   |                 |                                       |                                  
+sxyc2        |                |      |   |                 |                                       |                                  
+sxst         |                |      |   |                 |                                       |                                  
+syst         |                |      |   |                 |                                       |                                  
+sxxst        |                |      |   |                 |                                       |                                  
+syyst        |                |      |   |                 |                                       |                                  
+sxyst        |                |      |   |                 |                                       |                                  
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/attribute.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/attribute.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/attribute.f90	(revision 5682)
@@ -81,5 +81,6 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
-!> @date November, 2014 - Fix memory leaks bug
+!> @date November, 2014 
+!> - Fix memory leaks bug
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -130,10 +131,10 @@
       INTEGER(i4)       :: i_type = 0        !< attribute type
       INTEGER(i4)       :: i_len  = 0        !< number of value store in attribute
-      CHARACTER(LEN=lc) :: c_value = "none"  !< attribute value if type CHAR
+      CHARACTER(LEN=lc) :: c_value = 'none'  !< attribute value if type CHAR
       REAL(dp), DIMENSION(:), POINTER :: d_value => NULL() !< attribute value if type SHORT,INT,FLOAT or DOUBLE
    END TYPE TATT
 
    INTERFACE att_init
-      MODULE PROCEDURE att__init_c
+      MODULE PROCEDURE att__init_c    
       MODULE PROCEDURE att__init_dp
       MODULE PROCEDURE att__init_dp_0d
@@ -181,5 +182,5 @@
    !> @date November, 2013 - Initial Version
    !> @date November, 2014
-   !>    - use function instead of overload assignment operator 
+   !> - use function instead of overload assignment operator 
    !> (to avoid memory leak) 
    !
@@ -234,5 +235,5 @@
 
       ! local variable
-      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_value
+      REAL(dp)         , DIMENSION(:), ALLOCATABLE :: dl_value
       !----------------------------------------------------------------
 
@@ -300,6 +301,7 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial Version
-   !> @date September, 2014 - bug fix with use of id read from attribute structure
-   !
+   !> @date September, 2014 
+   !> - bug fix with use of id read from attribute structure
+   !>
    !> @param[in] td_att    array of attribute structure
    !> @param[in] cd_name   attribute name
@@ -355,6 +357,6 @@
 
       att__init_c%c_name=TRIM(ADJUSTL(cd_name))
-
       att__init_c%i_type=NF90_CHAR
+
       att__init_c%c_value=TRIM(ADJUSTL(cd_value))
       att__init_c%i_len=LEN( TRIM(ADJUSTL(cd_value)) )
@@ -368,5 +370,5 @@
    !>
    !> @author J.Paul
-   !> @dtae November, 2013 - Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_name   attribute name
@@ -1068,5 +1070,6 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial Version
-   !> @date September, 2014 - take into account type of attribute.
+   !> @date September, 2014 
+   !> - take into account type of attribute.
    !
    !> @param[in] td_att attribute structure
@@ -1114,4 +1117,5 @@
 
             CASE(NF90_CHAR)
+
                cl_value=td_att%c_value
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/boundary.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/boundary.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/boundary.f90	(revision 5682)
@@ -26,7 +26,7 @@
 !>       - ld_west  is logical to force used of north boundary [optional]
 !>       - cd_north is string character description of north boundary [optional]
-!>       - cd_south is string character description of north boundary [optional]
-!>       - cd_east  is string character description of north boundary [optional]
-!>       - cd_west  is string character description of north boundary [optional]
+!>       - cd_south is string character description of south boundary [optional]
+!>       - cd_east  is string character description of east  boundary [optional]
+!>       - cd_west  is string character description of west  boundary [optional]
 !>       - ld_oneseg is logical to force to use only one segment for each boundary [optional]
 !>
@@ -36,4 +36,7 @@
 !>    to know if boundary is use:<br/>
 !>    - tl_bdy\%l_use
+!>
+!>    to know if boundary come from namelist (cn_north,..):<br/>
+!>    - tl_bdy\%l_nam
 !>
 !>    to get the number of segment in boundary:<br/>
@@ -105,6 +108,12 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
-!> @date September, 2014 - add boundary description
-!> @date November, 2014 - Fix memory leaks bug
+!> @date September, 2014 
+!> - add boundary description
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!> @date February, 2015 
+!> - Do not change indices read from namelist
+!> - Change string character format of boundary read from namelist, 
+!>  see boundary__get_info
 !> 
 !> @todo add schematic to boundary structure description
@@ -157,5 +166,5 @@
    PRIVATE :: seg__init       ! initialise segment structure
    PRIVATE :: seg__clean      ! clean segment structure
-   PRIVATE :: seg__clean_unit ! clean segment structure
+   PRIVATE :: seg__clean_unit ! clean one segment structure
    PRIVATE :: seg__clean_arr  ! clean array of segment structure
    PRIVATE :: seg__copy       ! copy segment structure in another
@@ -173,8 +182,10 @@
       CHARACTER(LEN=lc) :: c_card = ''          !< boundary cardinal
       LOGICAL           :: l_use  = .FALSE.     !< boundary use or not 
+      LOGICAL           :: l_nam  = .FALSE.     !< boundary get from namelist
       INTEGER(i4)       :: i_nseg = 0           !< number of segment in boundary
       TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() !<  array of segment structure
    END TYPE TBDY
 
+   ! module variable
    INTEGER(i4), PARAMETER :: im_width=10
 
@@ -223,5 +234,5 @@
    !> @date November, 2013 - Initial Version
    !> @date November, 2014
-   !>    - use function instead of overload assignment operator 
+   !> - use function instead of overload assignment operator 
    !> (to avoid memory leak)
    !
@@ -260,5 +271,5 @@
    !> @date November, 2013 - Initial Version
    !> @date November, 2014
-   !>    - use function instead of overload assignment operator 
+   !> - use function instead of overload assignment operator 
    !> (to avoid memory leak)
    !
@@ -353,8 +364,20 @@
    END SUBROUTINE boundary__clean_arr
    !------------------------------------------------------------------- 
-   !> @brief This function put cardinal name inside file name.
+   !> @brief This function put cardinal name and date inside file name.
    ! 
    !> @details 
-   ! 
+   !>    Examples :
+   !>       cd_file="boundary.nc"
+   !>       cd_card="west" 
+   !>       id_seg =2
+   !>       cd_date=y2015m07d16
+   !> 
+   !>       function return "boundary_west_2_y2015m07d16.nc"
+   !> 
+   !>       cd_file="boundary.nc"
+   !>       cd_card="west" 
+   !> 
+   !>       function return "boundary_west.nc"
+   !> 
    !> @author J.Paul 
    !> @date November, 2013 - Initial Version 
@@ -385,4 +408,8 @@
       CHARACTER(LEN=lc) :: cl_date
       CHARACTER(LEN=lc) :: cl_name
+
+      INTEGER(i4)       :: il_ind
+      INTEGER(i4)       :: il_indend
+
       ! loop indices 
       !---------------------------------------------------------------- 
@@ -400,18 +427,31 @@
          cl_suffix=fct_split(TRIM(cl_basename),2,'.')
          
+         ! add segment number
          IF( PRESENT(id_seg) )THEN
-            cl_segnum="_"//TRIM(fct_str(id_seg))//"_"
+            cl_segnum="_"//TRIM(fct_str(id_seg))
          ELSE
             cl_segnum=""
          ENDIF
 
+         ! add date
          IF( PRESENT(cd_date) )THEN
-            cl_date=TRIM(ADJUSTL(cd_date))
+            cl_date="_"//TRIM(ADJUSTL(cd_date))
          ELSE
             cl_date=""
          ENDIF
 
-         cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//&
-         &        TRIM(cl_date)//"."//TRIM(cl_suffix)
+         ! special case for obcdta
+         il_ind=INDEX(cl_base,'_obcdta_')
+         IF( il_ind/=0 )THEN
+            il_ind=il_ind-1+8
+            il_indend=LEN_TRIM(cl_base)
+
+            cl_name=TRIM(cl_base(1:il_ind))//TRIM(cd_card)//&
+               &     TRIM(cl_segnum)//"_"//TRIM(cl_base(il_ind+1:il_indend))//&
+               &     TRIM(cl_date)//"."//TRIM(cl_suffix)
+         ELSE
+            cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//&
+               &     TRIM(cl_date)//"."//TRIM(cl_suffix)
+         ENDIF
 
          boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name)
@@ -442,6 +482,6 @@
    !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2'
    !>
-   !> @note boundaries are compute on T point. change will be done to get data
-   !> on other point when need be. 
+   !> @note Boundaries are compute on T point, but expressed on U,V point.
+   !> change will be done to get data on other point when need be. 
    !>
    !> @author J.Paul 
@@ -581,8 +621,13 @@
 
                ! get namelist information
-               tl_tmp=boundary__get_info(cl_card(jk))
+               tl_tmp=boundary__get_info(cl_card(jk),jk)
+
+               ! get segments indices
                DO ji=1,tl_tmp%i_nseg
                   CALL boundary__add_seg(tl_bdy(jk),tl_tmp%t_seg(ji))
                ENDDO
+               ! indices from namelist or not
+               tl_bdy(jk)%l_nam=tl_tmp%l_nam
+
                CALL boundary_clean(tl_tmp)
 
@@ -642,9 +687,10 @@
    !> @return boundary structure
    !------------------------------------------------------------------- 
-   FUNCTION boundary__init( cd_card, ld_use, td_seg ) 
+   FUNCTION boundary__init( cd_card, ld_use, ld_nam, td_seg ) 
       IMPLICIT NONE 
       ! Argument
       CHARACTER(LEN=*), INTENT(IN) :: cd_card
       LOGICAL         , INTENT(IN), OPTIONAL :: ld_use 
+      LOGICAL         , INTENT(IN), OPTIONAL :: ld_nam 
       TYPE(TSEG)      , INTENT(IN), OPTIONAL :: td_seg
 
@@ -664,4 +710,7 @@
             boundary__init%l_use=.TRUE.
             IF( PRESENT(ld_use) ) boundary__init%l_use=ld_use
+
+            boundary__init%l_nam=.FALSE.
+            IF( PRESENT(ld_nam) ) boundary__init%l_nam=ld_nam
 
             IF( PRESENT(td_seg) )THEN
@@ -778,16 +827,21 @@
    !> orthogonal index, first and last indices, of each segment. 
    !> And also the width of all segments of this boundary.
-   !>   cn_north='index1,first1,last1(width)|index2,first2,last2'
+   !>   cn_north='index1,first1:last1(width)|index2,first2:last2'
    !> 
    !> @author J.Paul 
    !> @date November, 2013 - Initial Version 
+   !> @date february, 2015 
+   !> - do not change indices read from namelist
+   !> - change format cn_north
    ! 
    !> @param[in] cd_card   boundary description
+   !> @param[in] id_jcard  boundary index
    !> @return boundary structure
    !------------------------------------------------------------------- 
-   FUNCTION boundary__get_info(cd_card) 
+   FUNCTION boundary__get_info(cd_card, id_jcard) 
       IMPLICIT NONE 
       ! Argument 
       CHARACTER(LEN=lc), INTENT(IN) :: cd_card
+      INTEGER(i4)      , INTENT(IN) :: id_jcard
 
       ! function 
@@ -802,4 +856,5 @@
       CHARACTER(LEN=lc) :: cl_index
       CHARACTER(LEN=lc) :: cl_width
+      CHARACTER(LEN=lc) :: cl_tmp
       CHARACTER(LEN=lc) :: cl_first
       CHARACTER(LEN=lc) :: cl_last 
@@ -818,4 +873,9 @@
       ! width should be the same for all segment of one boundary
       IF( TRIM(cl_seg)   /= '' )THEN
+
+         ! initialise boundary
+         ! temporaty boundary, so it doesn't matter which caridnal is used
+         boundary__get_info=boundary__init('north',ld_nam=.TRUE.)
+
          il_ind1=SCAN(fct_lower(cl_seg),'(')
          IF( il_ind1 /=0 )THEN
@@ -831,4 +891,5 @@
             ENDIF
          ENDIF
+
       ENDIF 
 
@@ -839,5 +900,5 @@
          il_ind1=SCAN(fct_lower(cl_index),'(')
          IF( il_ind1 /=0 )THEN
-            il_ind2=SCAN(fct_lower(cl_index),'(')
+            il_ind2=SCAN(fct_lower(cl_index),')')
             IF( il_ind2 /=0 )THEN
                cl_index=TRIM(cl_index(:il_ind1-1))//TRIM(cl_index(il_ind2+1:))
@@ -848,9 +909,13 @@
          ENDIF
       
-         cl_first=fct_split(cl_seg,2,',')
+         
+         cl_tmp=fct_split(cl_seg,2,',')
+
+
+         cl_first=fct_split(cl_tmp,1,':')
          ! remove potential width information
          il_ind1=SCAN(fct_lower(cl_first),'(')
          IF( il_ind1 /=0 )THEN
-            il_ind2=SCAN(fct_lower(cl_first),'(')
+            il_ind2=SCAN(fct_lower(cl_first),')')
             IF( il_ind2 /=0 )THEN
                cl_first=TRIM(cl_first(:il_ind1-1))//TRIM(cl_first(il_ind2+1:))
@@ -861,9 +926,9 @@
          ENDIF         
          
-         cl_last =fct_split(cl_seg,3,',')
+         cl_last =fct_split(cl_tmp,2,':')
          ! remove potential width information
          il_ind1=SCAN(fct_lower(cl_last),'(')
          IF( il_ind1 /=0 )THEN
-            il_ind2=SCAN(fct_lower(cl_last),'(')
+            il_ind2=SCAN(fct_lower(cl_last),')')
             IF( il_ind2 /=0 )THEN
                cl_last=TRIM(cl_last(:il_ind1-1))//TRIM(cl_last(il_ind2+1:))
@@ -879,4 +944,10 @@
          IF( TRIM(cl_first) /= '' ) READ(cl_first,*) tl_seg%i_first
          IF( TRIM(cl_last)  /= '' ) READ(cl_last ,*) tl_seg%i_last
+
+         ! index expressed on U,V point, move on T point.
+         SELECT CASE(id_jcard)
+            CASE(jp_north, jp_east)
+               tl_seg%i_index=tl_seg%i_index+1
+         END SELECT
 
          IF( (tl_seg%i_first == 0 .AND.  tl_seg%i_last == 0) .OR. &
@@ -943,5 +1014,5 @@
 
       DO jk=1,ip_ncard
-         IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%i_nseg > 1 )THEN
+         IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%l_nam )THEN
             ! nothing to be done
          ELSE
@@ -1480,5 +1551,5 @@
       il_max(jp_east )=td_var%t_dim(2)%i_len
       il_max(jp_west )=td_var%t_dim(2)%i_len
-      
+ 
       il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost
       il_maxindex(jp_south)=td_var%t_dim(2)%i_len-ip_ghost
@@ -1515,5 +1586,5 @@
          ENDIF
       ENDDO
-      
+ 
       CALL boundary_check_corner(td_bdy, td_var)
 
@@ -1650,5 +1721,5 @@
    !> @date November, 2013 - Initial Version
    !> @date November, 2014
-   !>    - use function instead of overload assignment operator 
+   !> - use function instead of overload assignment operator 
    !> (to avoid memory leak)
    !
@@ -1687,5 +1758,5 @@
    !> @date November, 2013 - Initial Version
    !> @date November, 2014
-   !>    - use function instead of overload assignment operator 
+   !> - use function instead of overload assignment operator 
    !> (to avoid memory leak)
    !
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90	(revision 5682)
@@ -20,5 +20,11 @@
 !>    ./SIREN/bin/create_bathy create_bathy.nam
 !> @endcode
-!>    
+!> <br/>    
+!> \image html  bathy_40.png 
+!> \image latex bathy_30.png
+!>
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
 !>    create_bathy.nam comprise 7 namelists:<br/>
 !>       - logger namelist (namlog)
@@ -37,5 +43,5 @@
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal')
+!> 'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -52,18 +58,21 @@
 !>       - cn_coord1 : coordinate file
 !>       - in_perio1 : periodicity index
-!>       - ln_fillclosed : fill closed sea or not
+!>       - ln_fillclosed : fill closed sea or not (default is .TRUE.)
 !>
 !>    * _variable namelist (namvar)_:<br/>
 !>       - cn_varinfo : list of variable and extra information about request(s) 
 !>       to be used.<br/>
-!>          each elements of *cn_varinfo* is a string character.<br/>
+!>          each elements of *cn_varinfo* is a string character
+!>          (separated by ',').<br/>
 !>          it is composed of the variable name follow by ':', 
 !>          then request(s) to be used on this variable.<br/> 
 !>          request could be:
-!>             - interpolation method
-!>             - extrapolation method
-!>             - filter method
-!>             - > minimum value
-!>             - < maximum value
+!>             - int = interpolation method
+!>             - ext = extrapolation method
+!>             - flt = filter method
+!>             - min = minimum value
+!>             - max = maximum value
+!>             - unt = new units
+!>             - unf = unit scale factor (linked to new units)
 !>
 !>                requests must be separated by ';'.<br/>
@@ -72,5 +81,5 @@
 !>          informations about available method could be find in @ref interp,
 !>          @ref extrap and @ref filter modules.<br/>
-!>          Example: 'Bathymetry: 2*hamming(2,3); > 0'
+!>          Example: 'Bathymetry: flt=2*hamming(2,3); min=0'
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -90,5 +99,4 @@
 !>                - ',' for line
 !>                - '/' for row
-!>                - '\' for level<br/>
 !>                Example:<br/>
 !>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
@@ -99,7 +107,4 @@
 !>             - 'Bathymetry:gridT.nc'
 !>             - 'Bathymetry:5000,5000,5000/5000,3000,5000/5000,5000,5000'
-!>
-!>          \image html  bathy_40.png 
-!>          \image latex bathy_30.png
 !>
 !>    * _nesting namelist (namnst)_:<br/>
@@ -119,5 +124,13 @@
 !> - add header for user
 !> - Bug fix, compute offset depending of grid point
+!> @date June, 2015
+!> - extrapolate all land points.
+!> - allow to change unit.
 !
+!> @todo
+!> - use create_bathy_check_depth as in create_boundary
+!> - use create_bathy_check_time  as in create_boundary
+!> - check tl_multi is not empty
+!>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
 !----------------------------------------------------------------------
@@ -482,5 +495,10 @@
    ENDIF
 
+   ! use additional request
    DO jk=1,tl_multi%i_nvar
+
+         ! change unit and apply factor
+         CALL var_chg_unit(tl_var(jk))
+
          ! forced min and max value
          CALL var_limit_value(tl_var(jk))
@@ -557,5 +575,5 @@
 
    ! add other variables
-   DO jk=1,tl_multi%i_nvar
+   DO jk=tl_multi%i_nvar,1,-1
       CALL file_add_var(tl_fileout, tl_var(jk))
       CALL var_clean(tl_var(jk))
@@ -623,5 +641,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_var    variable structure 
@@ -759,5 +777,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_var    variable structure 
@@ -878,5 +896,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_var    variable structure
@@ -897,10 +915,10 @@
       IMPLICIT NONE
       ! Argument
-      TYPE(TVAR) , INTENT(IN) :: td_var  
-      TYPE(TMPP) , INTENT(IN) :: td_mpp 
-      INTEGER(i4), INTENT(IN) :: id_imin
-      INTEGER(i4), INTENT(IN) :: id_imax
-      INTEGER(i4), INTENT(IN) :: id_jmin
-      INTEGER(i4), INTENT(IN) :: id_jmax
+      TYPE(TVAR)                 , INTENT(IN) :: td_var  
+      TYPE(TMPP)                 , INTENT(IN) :: td_mpp 
+      INTEGER(i4)                , INTENT(IN) :: id_imin
+      INTEGER(i4)                , INTENT(IN) :: id_imax
+      INTEGER(i4)                , INTENT(IN) :: id_jmin
+      INTEGER(i4)                , INTENT(IN) :: id_jmax
       INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_offset
       INTEGER(i4), DIMENSION(:)  , INTENT(IN) :: id_rho
@@ -989,5 +1007,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure 
@@ -1073,7 +1091,5 @@
 
       ! extrapolate variable
-      CALL extrap_fill_value( td_var, id_offset=id_offset(:,:), &
-      &                               id_rho=id_rho(:),         &
-      &                               id_iext=il_iext, id_jext=il_jext )
+      CALL extrap_fill_value( td_var )
 
       ! interpolate Bathymetry
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90	(revision 5682)
@@ -23,5 +23,11 @@
 !>    ./SIREN/bin/create_boundary create_boundary.nam
 !> @endcode
-!>    
+!>  <br/> 
+!> \image html  boundary_NEATL36_70.png 
+!> \image latex boundary_NEATL36_70.png
+!>
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
 !>    create_boundary.nam comprise 9 namelists:<br/>
 !>       - logger namelist (namlog)
@@ -42,5 +48,5 @@
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal')
+!> 'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -79,12 +85,14 @@
 !>    * _variable namelist (namvar)_:<br/>
 !>       - cn_varinfo : list of variable and extra information about request(s)
-!> to be used.<br/>
+!>          to be used (separated by ',').<br/>
 !>          each elements of *cn_varinfo* is a string character.<br/>
 !>          it is composed of the variable name follow by ':', 
 !>          then request(s) to be used on this variable.<br/> 
 !>          request could be:
-!>             - interpolation method
-!>             - extrapolation method
-!>             - filter method
+!>             - int = interpolation method
+!>             - ext = extrapolation method
+!>             - flt = filter method
+!>             - unt = new units
+!>             - unf = unit scale factor (linked to new units)
 !>
 !>                requests must be separated by ';'.<br/>
@@ -94,5 +102,5 @@
 !>          @ref extrap and @ref filter.<br/>
 !>
-!>          Example: 'votemper:linear;hann;dist_weight', 'vosaline:cubic'
+!>          Example: 'votemper:int=linear;flt=hann;ext=dist_weight', 'vosaline:int=cubic'
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -136,9 +144,9 @@
 !>          segments are separated by '|'.<br/>
 !>          each segments of the boundary is composed of:
-!>             - orthogonal indice (.ie. for north boundary,
-!>             J-indice where boundary are). 
-!>             - first indice of boundary (I-indice for north boundary) 
-!>             - last  indice of boundary (I-indice for north boundary)<br/>
-!>                indices must be separated by ',' .<br/>
+!>             - indice of velocity (orthogonal to boundary .ie. 
+!>                for north boundary, J-indice). 
+!>             - indice of segemnt start (I-indice for north boundary) 
+!>             - indice of segment end   (I-indice for north boundary)<br/>
+!>                indices must be separated by ':' .<br/>
 !>             - optionally, boundary size could be added between '(' and ')' 
 !>             in the first segment defined.
@@ -147,19 +155,26 @@
 !>
 !>          Examples:
-!>             - cn_north='index1,first1,last1(width)'
-!>             - cn_north='index1(width),first1,last1|index2,first2,last2'
-!>
-!>          \image html  boundary_50.png 
-!>          \image latex boundary_50.png
-!>
+!>             - cn_north='index1,first1:last1(width)'
+!>             - cn_north='index1(width),first1:last1|index2,first2:last2'
+!>             \image html  boundary_50.png 
+!>             \image latex boundary_50.png
 !>       - cn_south  : south boundary indices on fine grid
 !>       - cn_east   : east  boundary indices on fine grid
 !>       - cn_west   : west  boundary indices on fine grid
 !>       - ln_oneseg : use only one segment for each boundary or not
-!>       - in_extrap : number of mask point to be extrapolated
-!>
-!>   * _output namelist (namout)_:<br/>
+!>
+!>    * _output namelist (namout)_:<br/>
 !>       - cn_fileout : fine grid boundary basename
 !>         (cardinal and segment number will be automatically added)
+!>       - dn_dayofs  : date offset in day (change only ouput file name)
+!>       - ln_extrap  : extrapolate land point or not
+!>
+!>          Examples: 
+!>             - cn_fileout=boundary.nc<br/>
+!>                if time_counter (16/07/2015 00h) is read on input file (see varfile), 
+!>                west boundary will be named boundary_west_y2015m07d16
+!>             - dn_dayofs=-2.<br/>
+!>                if you use day offset you get boundary_west_y2015m07d14
+!>       
 !>
 !> @author J.Paul
@@ -169,5 +184,10 @@
 !> - add header for user
 !> - take into account grid point to compue boundaries
-!> - reorder output dimension for north and south boundaries 
+!> - reorder output dimension for north and south boundaries
+!> @date June, 2015
+!> - extrapolate all land points, and add ln_extrap in namelist.
+!> - allow to change unit.
+!> @date July, 2015
+!> - add namelist parameter to shift date of output file name.  
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -191,5 +211,5 @@
    USE dom                             ! domain manager
    USE grid                            ! grid manager
-   USE vgrid                           ! vartical grid manager
+   USE vgrid                           ! vertical grid manager
    USE extrap                          ! extrapolation manager
    USE interp                          ! interpolation manager
@@ -213,5 +233,4 @@
    INTEGER(i4)                                        :: il_status
    INTEGER(i4)                                        :: il_fileid
-   INTEGER(i4)                                        :: il_dim
    INTEGER(i4)                                        :: il_imin0
    INTEGER(i4)                                        :: il_imax0
@@ -239,4 +258,6 @@
 
    TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+   TYPE(TDATE)                                        :: tl_date
    
    TYPE(TBDY)       , DIMENSION(ip_ncard)             :: tl_bdy
@@ -265,22 +286,37 @@
    ! namelist variable
    ! namlog
-   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_boundary.log' 
-   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning' 
-   INTEGER(i4)                             :: in_maxerror = 5
+   CHARACTER(LEN=lc)  :: cn_logfile = 'create_boundary.log' 
+   CHARACTER(LEN=lc)  :: cn_verbosity = 'warning' 
+   INTEGER(i4)        :: in_maxerror = 5
 
    ! namcfg
-   CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg' 
+   CHARACTER(LEN=lc)  :: cn_varcfg = 'variable.cfg' 
 
    ! namcrs
-   CHARACTER(LEN=lc)                       :: cn_coord0 = '' 
-   INTEGER(i4)                             :: in_perio0 = -1
+   CHARACTER(LEN=lc)  :: cn_coord0 = '' 
+   INTEGER(i4)        :: in_perio0 = -1
 
    ! namfin
-   CHARACTER(LEN=lc)                       :: cn_coord1 = '' 
-   CHARACTER(LEN=lc)                       :: cn_bathy1 = '' 
-   INTEGER(i4)                             :: in_perio1 = -1
+   CHARACTER(LEN=lc)  :: cn_coord1 = '' 
+   CHARACTER(LEN=lc)  :: cn_bathy1 = '' 
+   INTEGER(i4)        :: in_perio1 = -1
 
    !namzgr
-   INTEGER(i4)                             :: in_nlevel = 75
+   REAL(dp)          :: dn_pp_to_be_computed = 0._dp
+   REAL(dp)          :: dn_ppsur     = -3958.951371276829_dp
+   REAL(dp)          :: dn_ppa0      =   103.9530096000000_dp
+   REAL(dp)          :: dn_ppa1      =     2.4159512690000_dp
+   REAL(dp)          :: dn_ppa2      =   100.7609285000000_dp
+   REAL(dp)          :: dn_ppkth     =    15.3510137000000_dp
+   REAL(dp)          :: dn_ppkth2    =    48.0298937200000_dp
+   REAL(dp)          :: dn_ppacr     =     7.0000000000000_dp
+   REAL(dp)          :: dn_ppacr2    =    13.000000000000_dp
+   REAL(dp)          :: dn_ppdzmin   = 6._dp
+   REAL(dp)          :: dn_pphmax    = 5750._dp
+   INTEGER(i4)       :: in_nlevel    = 75
+
+   !namzps
+   REAL(dp)          :: dn_e3zps_min = 25._dp
+   REAL(dp)          :: dn_e3zps_rat = 0.2_dp
 
    ! namvar
@@ -289,21 +325,22 @@
 
    ! namnst
-   INTEGER(i4)                             :: in_rhoi  = 0
-   INTEGER(i4)                             :: in_rhoj  = 0
+   INTEGER(i4)       :: in_rhoi  = 0
+   INTEGER(i4)       :: in_rhoj  = 0
 
    ! nambdy
-   LOGICAL                                 :: ln_north   = .TRUE.
-   LOGICAL                                 :: ln_south   = .TRUE.
-   LOGICAL                                 :: ln_east    = .TRUE.
-   LOGICAL                                 :: ln_west    = .TRUE.
-   CHARACTER(LEN=lc)                       :: cn_north   = ''
-   CHARACTER(LEN=lc)                       :: cn_south   = ''
-   CHARACTER(LEN=lc)                       :: cn_east    = ''
-   CHARACTER(LEN=lc)                       :: cn_west    = ''
-   LOGICAL                                 :: ln_oneseg  = .TRUE.
-   INTEGER(i4)                             :: in_extrap  = 0
+   LOGICAL           :: ln_north   = .TRUE.
+   LOGICAL           :: ln_south   = .TRUE.
+   LOGICAL           :: ln_east    = .TRUE.
+   LOGICAL           :: ln_west    = .TRUE.
+   CHARACTER(LEN=lc) :: cn_north   = ''
+   CHARACTER(LEN=lc) :: cn_south   = ''
+   CHARACTER(LEN=lc) :: cn_east    = ''
+   CHARACTER(LEN=lc) :: cn_west    = ''
+   LOGICAL           :: ln_oneseg  = .TRUE.
 
    ! namout
-   CHARACTER(LEN=lc)                       :: cn_fileout = 'boundary.nc' 
+   CHARACTER(LEN=lc) :: cn_fileout = 'boundary.nc' 
+   REAL(dp)          :: dn_dayofs  = 0._dp
+   LOGICAL           :: ln_extrap  = .FALSE.
    !-------------------------------------------------------------------
 
@@ -319,5 +356,5 @@
    &  cn_coord0,     &  !< coordinate file
    &  in_perio0         !< periodicity index
-   
+ 
    NAMELIST /namfin/ &  !< fine grid namelist
    &  cn_coord1,     &  !< coordinate file
@@ -326,10 +363,25 @@
  
    NAMELIST /namzgr/ &
-   &  in_nlevel
+   &  dn_pp_to_be_computed, &
+   &  dn_ppsur,     &
+   &  dn_ppa0,      &
+   &  dn_ppa1,      &
+   &  dn_ppa2,      &
+   &  dn_ppkth,     &
+   &  dn_ppkth2,    &
+   &  dn_ppacr,     &
+   &  dn_ppacr2,    &
+   &  dn_ppdzmin,   &
+   &  dn_pphmax,    &
+   &  in_nlevel         !< number of vertical level
+
+   NAMELIST /namzps/ &
+   &  dn_e3zps_min, &
+   &  dn_e3zps_rat
 
    NAMELIST /namvar/ &  !< variable namelist
    &  cn_varinfo,    &  !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' )
    &  cn_varfile        !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' ) 
-   
+ 
    NAMELIST /namnst/ &  !< nesting namelist
    &  in_rhoi,       &  !< refinement factor in i-direction
@@ -345,9 +397,10 @@
    &  cn_east ,      &  !< east  boundary indices on fine grid
    &  cn_west ,      &  !< west  boundary indices on fine grid
-   &  ln_oneseg,     &  !< use only one segment for each boundary or not
-   &  in_extrap         !< number of mask point to be extrapolated
+   &  ln_oneseg         !< use only one segment for each boundary or not
 
    NAMELIST /namout/ &  !< output namelist
-   &  cn_fileout    !< fine grid boundary file basename   
+   &  cn_fileout,    &  !< fine grid boundary file basename   
+   &  dn_dayofs,     &  !< date offset in day (change only ouput file name)
+   &  ln_extrap         !< extrapolate or not
    !-------------------------------------------------------------------
 
@@ -448,7 +501,16 @@
    ! check
    ! check output file do not already exist
+   ! WARNING: do not work when use time to create output file name
    DO jk=1,ip_ncard
       cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
       &                                TRIM(cp_card(jk)), 1 )
+      INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist)
+      IF( ll_exist )THEN
+         CALL logger_fatal("CREATE BOUNDARY: output file "//TRIM(cl_bdyout)//&
+         &  " already exist.")
+      ENDIF
+
+      cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+      &                                TRIM(cp_card(jk)) )
       INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist)
       IF( ll_exist )THEN
@@ -490,9 +552,10 @@
 
    CALL iom_mpp_open(tl_bathy1)
-   
+ 
    tl_var1=iom_mpp_read_var(tl_bathy1,'Bathymetry')
-   
+ 
    CALL iom_mpp_close(tl_bathy1)
 
+   ! get boundaries indices
    tl_bdy(:)=boundary_init(tl_var1, ln_north, ln_south, ln_east, ln_west, &
    &                                cn_north, cn_south, cn_east, cn_west, &
@@ -505,8 +568,8 @@
    tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist )
 
-   ! get coordinate on each segment of each boundary
+   ! get coordinate for each segment of each boundary
    ALLOCATE( tl_segdom1(ip_npoint,ip_maxseg,ip_ncard) )
    ALLOCATE( tl_seglvl1(ip_npoint,ip_maxseg,ip_ncard) )
-   
+ 
    DO jl=1,ip_ncard
       IF( tl_bdy(jl)%l_use )THEN
@@ -516,4 +579,11 @@
             tl_segdom1(:,jk,jl)=create_boundary_get_dom( tl_bathy1, &
             &                                            tl_bdy(jl), jk )
+
+            IF( .NOT. ln_extrap )THEN
+               ! get fine grid level
+               tl_seglvl1(:,jk,jl)= &
+                  & create_boundary_get_level( tl_level(:), &
+                  &                            tl_segdom1(:,jk,jl))
+            ENDIF
 
             ! add extra band to fine grid domain (if possible)
@@ -523,8 +593,4 @@
                &                  il_rho(jp_I), il_rho(jp_J))
             ENDDO
-
-            ! get fine grid level
-            tl_seglvl1(:,jk,jl)=create_boundary_get_level( tl_level(:), &
-                                                           tl_segdom1(:,jk,jl))
 
          ENDDO
@@ -594,8 +660,4 @@
                         &                          in_nlevel )
 
-                        ! use mask
-                        CALL create_boundary_use_mask( tl_segvar1(jvar,jk,jl), &
-                        &                         tl_seglvl1(jpoint,jk,jl))
-
                         !del extra
                         CALL dom_del_extra( tl_segvar1(jvar,jk,jl), &
@@ -654,5 +716,6 @@
                   IF( tl_bdy(jl)%l_use )THEN
                      
-                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//' boundary'
+                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//&
+                        &  ' boundary'
                      DO jk=1,tl_bdy(jl)%i_nseg
                         ! compute domain on fine grid
@@ -662,5 +725,6 @@
                            
                            cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name
-                           WRITE(*,'(4x,a,a)') "work on variable "//TRIM(cl_name)
+                           WRITE(*,'(4x,a,a)') "work on (extract) variable "//&
+                              &  TRIM(cl_name)
 
                            cl_point=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_point
@@ -678,5 +742,4 @@
 
                            tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl))
-                           tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl))
 
                            ! open mpp files
@@ -687,8 +750,4 @@
                            &                     tl_mpp, TRIM(cl_name), tl_dom1)
 
-                           ! use mask
-                           CALL create_boundary_use_mask( &
-                           &                 tl_segvar1(jvar+jj,jk,jl), tl_lvl1)
-
                            ! del extra point
                            CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), &
@@ -699,11 +758,14 @@
 
                            ! add attribute to variable
-                           tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
+                           tl_att=att_init('src_file', &
+                              &  TRIM(fct_basename(tl_mpp%c_name)))
                            CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att)
 
-                           tl_att=att_init('src_i_indices',(/tl_dom1%i_imin, tl_dom1%i_imax/))
+                           tl_att=att_init('src_i_indices', &
+                              &  (/tl_dom1%i_imin, tl_dom1%i_imax/))
                            CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att)
 
-                           tl_att=att_init('src_j_indices',(/tl_dom1%i_jmin, tl_dom1%i_jmax/))
+                           tl_att=att_init('src_j_indices', &
+                              &  (/tl_dom1%i_jmin, tl_dom1%i_jmax/))
                            CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att)
 
@@ -736,11 +798,12 @@
                   IF( tl_bdy(jl)%l_use )THEN
 
-                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//' boundary'
+                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//&
+                        &  ' boundary'
                      DO jk=1,tl_bdy(jl)%i_nseg
                         
                         ! for each variable of this file
                         DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
-                           
-                           WRITE(*,'(4x,a,a)') "work on variable "//&
+ 
+                           WRITE(*,'(4x,a,a)') "work on (interp) variable "//&
                            &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
 
@@ -759,5 +822,4 @@
 
                            tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl))
-                           tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl))
 
                            CALL create_boundary_get_coord( tl_coord1, tl_dom1, &
@@ -795,5 +857,6 @@
                            &                 il_jmin0, il_jmax0 )
 
-                           ! add extra band (if possible) to compute interpolation
+                           ! add extra band (if possible) to compute 
+                           ! interpolation
                            CALL dom_add_extra(tl_dom0)
 
@@ -815,8 +878,4 @@
                            CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), &
                            &                   tl_dom0, il_rho(:) )
-
-                           ! use mask
-                           CALL create_boundary_use_mask( &
-                           &     tl_segvar1(jvar+jj,jk,jl), tl_lvl1)
 
                            ! del extra point on fine grid
@@ -889,20 +948,11 @@
 
    IF( jvar /= tl_multi%i_nvar )THEN
-      CALL logger_error("CREATE BOUNDARY: it seems some variable can not be read")
+      CALL logger_error("CREATE BOUNDARY: it seems some variable "//&
+         &  "can not be read")
    ENDIF
-
-   CALL var_clean(tl_seglvl1(:,:,:))
-   DEALLOCATE( tl_seglvl1 )
 
    ! write file for each segment of each boundary
    DO jl=1,ip_ncard
       IF( tl_bdy(jl)%l_use )THEN
-
-         SELECT CASE(TRIM(tl_bdy(jk)%c_card))
-         CASE('north','south')
-            il_dim=1
-         CASE('east','west')
-            il_dim=2
-         END SELECT   
 
          DO jk=1,tl_bdy(jl)%i_nseg
@@ -911,4 +961,8 @@
             &                               'T', tl_lon1, tl_lat1 )
 
+            ! force to use nav_lon, nav_lat as variable name
+            tl_lon1%c_name='nav_lon'
+            tl_lat1%c_name='nav_lat'
+
             ! del extra point on fine grid
             CALL dom_del_extra( tl_lon1, tl_segdom1(jp_T,jk,jl) )
@@ -924,7 +978,9 @@
             CALL boundary_swap(tl_lat1, tl_bdy(jl))
             DO jvar=1,tl_multi%i_nvar
-               CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl))
 
                ! use additional request
+               ! change unit and apply factor
+               CALL var_chg_unit(tl_segvar1(jvar,jk,jl))
+
                ! forced min and max value
                CALL var_limit_value(tl_segvar1(jvar,jk,jl))
@@ -933,9 +989,23 @@
                CALL filter_fill_value(tl_segvar1(jvar,jk,jl))
 
-               ! extrapolate
-               CALL extrap_fill_value( tl_segvar1(jvar,jk,jl), &
-               &                       id_iext=in_extrap,      &
-               &                       id_jext=in_extrap,      &
-               &                       id_kext=in_extrap )
+               IF( .NOT. ln_extrap )THEN
+                  ! use mask
+                  SELECT CASE(TRIM(tl_segvar1(jvar,jk,jl)%c_point))
+                  CASE DEFAULT !'T'
+                     jpoint=jp_T
+                  CASE('U')
+                     jpoint=jp_U
+                  CASE('V')
+                     jpoint=jp_V
+                  CASE('F')
+                     jpoint=jp_F
+                  END SELECT
+
+                  CALL create_boundary_use_mask(tl_segvar1(jvar,jk,jl), &
+                  &                             tl_seglvl1(jpoint,jk,jl))
+               ENDIF
+
+               ! swap dimension order
+               CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl))
 
             ENDDO
@@ -944,13 +1014,32 @@
             ! create file structure
             ! set file namearray of level variable structure
-            IF( ASSOCIATED(tl_time%d_value) )THEN
-               cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
-               cl_date=date_print( var_to_date(tl_time), cl_fmt ) 
-
-               cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
-               &                                TRIM(tl_bdy(jl)%c_card), jk, TRIM(cl_date) )
+            IF( tl_bdy(jl)%i_nseg > 1 )THEN
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
+                  tl_date=var_to_date(tl_time)
+                  tl_date=tl_date+dn_dayofs
+                  cl_date=date_print( tl_date, cl_fmt ) 
+
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card), jk,&
+                  &                                cd_date=TRIM(cl_date) )
+               ELSE
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card), jk )
+               ENDIF
             ELSE
-               cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
-               &                                TRIM(tl_bdy(jl)%c_card), jk )
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
+                  tl_date=var_to_date(tl_time)
+                  tl_date=tl_date+dn_dayofs
+                  cl_date=date_print( tl_date, cl_fmt )
+
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card), &
+                  &                                cd_date=TRIM(cl_date) )
+               ELSE
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card) )
+               ENDIF
             ENDIF
             ! 
@@ -960,19 +1049,9 @@
             tl_dim(:)=var_max_dim(tl_segvar1(:,jk,jl))
 
-            CALL dim_unorder(tl_dim(:))
             SELECT CASE(TRIM(tl_bdy(jl)%c_card))
                CASE DEFAULT ! 'north','south'
                   cl_dimorder='xyzt'
-                  CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder))
                CASE('east','west')
                   cl_dimorder='yxzt'
-                  CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder))
-                  ! reorder coordinates dimension
-                  CALL var_reorder(tl_lon1,TRIM(cl_dimorder))
-                  CALL var_reorder(tl_lat1,TRIM(cl_dimorder))
-                  ! reorder other variable dimension
-                  DO jvar=1,tl_multi%i_nvar
-                     CALL var_reorder(tl_segvar1(jvar,jk,jl),TRIM(cl_dimorder))
-                  ENDDO
             END SELECT
 
@@ -992,16 +1071,22 @@
             ENDIF
             
+
+
             IF( tl_dim(3)%l_use )THEN
-               ! add depth
-               CALL file_add_var(tl_fileout, tl_depth)
+               IF( ASSOCIATED(tl_depth%d_value) )THEN
+                  ! add depth
+                  CALL file_add_var(tl_fileout, tl_depth)
+               ENDIF
             ENDIF
 
             IF( tl_dim(4)%l_use )THEN
-               ! add time
-               CALL file_add_var(tl_fileout, tl_time)
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  ! add time
+                  CALL file_add_var(tl_fileout, tl_time)
+               ENDIF
             ENDIF
 
             ! add other variable
-            DO jvar=1,tl_multi%i_nvar
+            DO jvar=tl_multi%i_nvar,1,-1
                CALL file_add_var(tl_fileout, tl_segvar1(jvar,jk,jl))
                CALL var_clean(tl_segvar1(jvar,jk,jl))
@@ -1048,5 +1133,5 @@
 
             ! write file
-            CALL iom_write_file(tl_fileout)
+            CALL iom_write_file(tl_fileout, cl_dimorder)
 
             ! close file
@@ -1066,4 +1151,7 @@
    DEALLOCATE( tl_segdom1 )
    DEALLOCATE( tl_segvar1 )
+   CALL var_clean(tl_seglvl1(:,:,:))
+   DEALLOCATE( tl_seglvl1 )
+
 
    CALL mpp_clean(tl_coord1)
@@ -1082,5 +1170,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - take into account grid point to compute boundary indices
@@ -1186,9 +1274,10 @@
    !-------------------------------------------------------------------
    !> @brief
-   !> This subroutine get coordinates over boudnary domain
+   !> This subroutine get coordinates over boundary domain
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !> @date September, 2014 - take into account grid point
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - take into account grid point
    !>
    !> @param[in] td_coord1 coordinates file structure
@@ -1237,10 +1326,10 @@
    !-------------------------------------------------------------------
    !> @brief
-   !> This subroutine interpolate variable over boundary
+   !> This subroutine interpolate variable on boundary
    !> 
    !> @details 
    !>
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure 
@@ -1296,5 +1385,5 @@
 
       ! extrapolate variable
-      CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext )
+      CALL extrap_fill_value( td_var )
 
       ! interpolate Bathymetry
@@ -1303,5 +1392,6 @@
 
       ! remove extraband
-      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))
+      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), &
+         &                               il_jext*id_rho(jp_J))
 
    END SUBROUTINE create_boundary_interp
@@ -1317,5 +1407,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_var    variable structure 
@@ -1422,5 +1512,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure 
@@ -1475,5 +1565,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_level  array of level variable structure
@@ -1537,5 +1627,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !>
    !> @param[in] td_mpp       mpp structure
@@ -1588,5 +1678,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !>
    !> @param[in] td_mpp      mpp structure
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/create_coord.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/create_coord.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/create_coord.f90	(revision 5682)
@@ -24,4 +24,7 @@
 !> @endcode
 !>    
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
 !>    create_coord.nam comprise 6 namelists:<br/>
 !>       - logger namelist (namlog)
@@ -39,5 +42,5 @@
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal')
+!> 'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -54,11 +57,12 @@
 !>       - cn_varinfo : list of variable and extra information about request(s)
 !> to be used.<br/>
-!>          each elements of *cn_varinfo* is a string character.<br/>
+!>          each elements of *cn_varinfo* is a string character 
+!>          (separated by ',').<br/>
 !>          it is composed of the variable name follow by ':', 
 !>          then request(s) to be used on this variable.<br/> 
 !>          request could be:
-!>             - interpolation method
-!>             - extrapolation method
-!>             - filter method
+!>             - int = interpolation method
+!>             - ext = extrapolation method
+!>             - flt = filter method
 !> 
 !>                requests must be separated by ';' .<br/>
@@ -68,6 +72,6 @@
 !>          @ref extrap and @ref filter modules.<br/>
 !>
-!>          Example: 'votemper: linear; hann(2,3); dist_weight', 
-!>          'vosaline: cubic'<br/>
+!>          Example: 'votemper: int=linear; flt=hann(2,3); ext=dist_weight', 
+!>          'vosaline: int=cubic'<br/>
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -90,5 +94,5 @@
 !>
 !>    * _output namelist (namout)_:
-!>       - cn_fileout : output coordinate file
+!>       - cn_fileout : output coordinate file name
 !>
 !> @author J.Paul
@@ -152,12 +156,4 @@
    TYPE(TFILE)                                          :: tl_fileout
 
-   ! check 
-!   INTEGER(i4)                                          :: il_imin0
-!   INTEGER(i4)                                          :: il_imax0
-!   INTEGER(i4)                                          :: il_jmin0
-!   INTEGER(i4)                                          :: il_jmax0
-!   INTEGER(i4)      , DIMENSION(2,2)                    :: il_ind2
-!   TYPE(TMPP)                                           :: tl_mppout
-
    ! loop indices
    INTEGER(i4) :: ji
@@ -165,15 +161,20 @@
 
    ! namelist variable
+   ! namlog
    CHARACTER(LEN=lc) :: cn_logfile = 'create_coord.log' 
    CHARACTER(LEN=lc) :: cn_verbosity = 'warning' 
    INTEGER(i4)       :: in_maxerror = 5
 
+   ! namcfg
+   CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg' 
+
+   ! namcrs
    CHARACTER(LEN=lc) :: cn_coord0 = '' 
    INTEGER(i4)       :: in_perio0 = -1
 
-   CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg' 
-
+   ! namvar
    CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
 
+   !namnst
    INTEGER(i4)       :: in_imin0 = 0
    INTEGER(i4)       :: in_imax0 = 0
@@ -183,4 +184,5 @@
    INTEGER(i4)       :: in_rhoj  = 1
 
+   !namout
    CHARACTER(LEN=lc) :: cn_fileout= 'coord_fine.nc'
    !-------------------------------------------------------------------
@@ -305,5 +307,4 @@
 
       il_offset(:,:,:)=create_coord_get_offset(il_rho(:))
-
    ENDIF
 
@@ -348,8 +349,4 @@
       CALL dom_del_extra( tl_var(ji), tl_dom, il_rho(:), .true. )
 
-      ! do not add ghost cell. 
-      ! ghost cell already replace by value for coordinates 
-      ! CALL grid_add_ghost(tl_var(ji),tl_dom%i_ghost(:,:))
-
       ! filter
       CALL filter_fill_value(tl_var(ji))      
@@ -375,9 +372,8 @@
 
    ! add variables
-   DO ji=1,il_nvar
+   DO ji=il_nvar,1,-1
       CALL file_add_var(tl_fileout, tl_var(ji))
+      CALL var_clean(tl_var(ji))
    ENDDO
-
-   ! recompute some attribute
 
    ! add some attribute
@@ -440,37 +436,4 @@
 
    CALL file_clean(tl_fileout)
-
-!   ! check domain
-!   tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0)
-!   tl_mppout=mpp_init( file_init(TRIM(cn_fileout)) )
-!   CALL grid_get_info(tl_coord0)
-!   CALL iom_mpp_open(tl_mppout)
-!
-!   il_ind2(:,:)=grid_get_coarse_index( tl_coord0, tl_mppout, &
-!   &                                   id_rho=il_rho(:) )
-!
-!   il_imin0=il_ind2(1,1) ; il_imax0=il_ind2(1,2)
-!   il_jmin0=il_ind2(2,1) ; il_jmax0=il_ind2(2,2)
-!
-!   IF( il_imin0 /= in_imin0 .OR. &
-!   &   il_imax0 /= in_imax0 .OR. &
-!   &   il_jmin0 /= in_jmin0 .OR. &
-!   &   il_jmax0 /= in_jmax0 )THEN
-!      CALL logger_debug("CREATE COORD: output indices ("//&
-!      &                 TRIM(fct_str(il_imin0))//","//&
-!      &                 TRIM(fct_str(il_imax0))//") ("//&
-!      &                 TRIM(fct_str(il_jmin0))//","//&
-!      &                 TRIM(fct_str(il_jmax0))//")" ) 
-!      CALL logger_debug("CREATE COORD: input indices ("//&
-!      &                 TRIM(fct_str(in_imin0))//","//&
-!      &                 TRIM(fct_str(in_imax0))//") ("//&
-!      &                 TRIM(fct_str(in_jmin0))//","//&
-!      &                 TRIM(fct_str(in_jmax0))//")" ) 
-!      CALL logger_fatal("CREATE COORD: output domain not confrom "//&
-!      &                 "with input indices")
-!   ENDIF
-!
-!   CALL iom_mpp_close(tl_coord0)
-!   CALL iom_mpp_close(tl_mppout)
 
    ! close log file
@@ -539,4 +502,6 @@
    !> @param[in] id_iext   number of points to be extrapolated in i-direction
    !> @param[in] id_jext   number of points to be extrapolated in j-direction
+   !>
+   !> @todo check if mask is really needed
    !-------------------------------------------------------------------
    SUBROUTINE create_coord_interp( td_var,          &
@@ -626,5 +591,5 @@
 
          ! extrapolate variable
-         CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext )
+         CALL extrap_fill_value( td_var )
 
          ! interpolate variable
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/create_restart.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/create_restart.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/create_restart.f90	(revision 5682)
@@ -25,4 +25,7 @@
 !> @endcode
 !>    
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
 !>    create_restart.nam comprise 9 namelists:<br/>
 !>       - logger namelist (namlog)
@@ -43,5 +46,5 @@
 !>       - cn_logfile   : log filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!> 'warning','error','fatal')
+!> 'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -59,6 +62,4 @@
 !>       - cn_bathy1 : bathymetry file
 !>       - in_perio1 : NEMO periodicity index
-!>       - in_extrap : number of land point to be extrapolated 
-!>       before writing file
 !>
 !>    * _vertical grid namelist (namzgr)_:<br/>
@@ -83,13 +84,16 @@
 !>       - cn_varinfo : list of variable and extra information about request(s) 
 !>       to be used.<br/>
-!>          each elements of *cn_varinfo* is a string character.<br/>
+!>          each elements of *cn_varinfo* is a string character
+!>          (separated by ',').<br/>
 !>          it is composed of the variable name follow by ':', 
 !>          then request(s) to be used on this variable.<br/> 
 !>          request could be:
-!>             - interpolation method
-!>             - extrapolation method
-!>             - filter method
-!>             - > minimum value
-!>             - < maximum value
+!>             - int = interpolation method
+!>             - ext = extrapolation method
+!>             - flt = filter method
+!>             - min = minimum value
+!>             - max = maximum value
+!>             - unt = new units
+!>             - unf = unit scale factor (linked to new units)
 !>
 !>             requests must be separated by ';'.<br/>
@@ -98,5 +102,5 @@
 !>          informations about available method could be find in @ref interp,
 !>          @ref extrap and @ref filter.<br/>
-!>          Example: 'votemper: linear; hann; dist_weight','vosaline: cubic'
+!>          Example: 'votemper: int=linear; flt=hann; ext=dist_weight','vosaline: int=cubic'
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -136,7 +140,8 @@
 !>    * _output namelist (namout)_:<br/>
 !>       - cn_fileout : output file
-!>       - in_nproc  : total number of processor to be used
+!>       - ln_extrap : extrapolate land point or not
 !>       - in_niproc : i-direction number of processor
 !>       - in_njproc : j-direction numebr of processor
+!>       - in_nproc  : total number of processor to be used
 !>       - cn_type   : output format ('dimg', 'cdf')
 !>
@@ -148,4 +153,7 @@
 !> - offset computed considering grid point
 !> - add attributes in output variable
+!> @date June, 2015
+!> - extrapolate all land points, and add ln_extrap in namelist.
+!> - allow to change unit.
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -165,5 +173,5 @@
    USE iom                             ! I/O manager
    USE grid                            ! grid manager
-   USE vgrid                           ! vertical grid manager
+   USE vgrid                            ! vertical grid manager
    USE extrap                          ! extrapolation manager
    USE interp                          ! interpolation manager
@@ -249,5 +257,4 @@
    CHARACTER(LEN=lc) :: cn_bathy1 = ''
    INTEGER(i4)       :: in_perio1 = -1
-   INTEGER(i4)       :: in_extrap = 0
 
    !namzgr
@@ -279,4 +286,5 @@
    ! namout
    CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc' 
+   LOGICAL           :: ln_extrap  = .FALSE.
    INTEGER(i4)       :: in_nproc   = 0
    INTEGER(i4)       :: in_niproc  = 0
@@ -301,6 +309,5 @@
    &  cn_coord1,   &    !< coordinate file
    &  cn_bathy1,   &    !< bathymetry file
-   &  in_perio1,   &    !< periodicity index
-   &  in_extrap
+   &  in_perio1         !< periodicity index
  
    NAMELIST /namzgr/ &
@@ -332,7 +339,8 @@
    NAMELIST /namout/ &  !< output namlist
    &  cn_fileout, &     !< fine grid bathymetry file
-   &  in_nproc,   &     !< number of processor to be used
+   &  ln_extrap,  &     !< extrapolate or not
    &  in_niproc,  &     !< i-direction number of processor
    &  in_njproc,  &     !< j-direction numebr of processor
+   &  in_nproc,   &     !< number of processor to be used
    &  cn_type           !< output type format (dimg, cdf)
    !-------------------------------------------------------------------
@@ -347,5 +355,5 @@
       CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
    ENDIF
-   
+
    ! read namelist
    INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
@@ -434,5 +442,9 @@
    ! check
    ! check output file do not already exist
-   cl_fileout=file_rename(cn_fileout,1)
+   IF( in_nproc > 0 )THEN
+      cl_fileout=file_rename(cn_fileout,1)
+   ELSE
+      cl_fileout=file_rename(cn_fileout)
+   ENDIF
    INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist)
    IF( ll_exist )THEN
@@ -468,16 +480,6 @@
    &                            il_rho(:) )
 
-   ! compute level
-   ALLOCATE(tl_level(ip_npoint))
-   tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist )
-
-   ! remove ghost cell
+   ! fine grid ghost cell
    il_xghost(:,:)=grid_get_ghost(tl_bathy1)
-   DO ji=1,ip_npoint
-      CALL grid_del_ghost(tl_level(ji), il_xghost(:,:))
-   ENDDO
-
-   ! clean
-   CALL mpp_clean(tl_bathy1)
 
    ! work on variables
@@ -514,5 +516,8 @@
                tl_var(jvar) = create_restart_matrix( &
                &  tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj), tl_coord1, &
-               &  in_nlevel, tl_level(:) )
+               &  in_nlevel, il_xghost(:,:) )
+
+               ! add ghost cell
+               CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:))
 
             ENDDO
@@ -535,4 +540,5 @@
             ! open mpp file
             CALL iom_mpp_open(tl_mpp)
+
 
             ! get or check depth value
@@ -579,5 +585,5 @@
                DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
 
-                  WRITE(*,'(2x,a,a)') "work on variable "//&
+                  WRITE(*,'(2x,a,a)') "work on (extract) variable "//&
                   &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
 
@@ -600,9 +606,6 @@
                   CALL att_clean(tl_att)
 
-                  ! use mask
-                  CALL create_restart_mask(tl_var(jvar), tl_level(:))
-
                   ! add ghost cell
-                  CALL grid_add_ghost( tl_var(jvar), tl_dom1%i_ghost(:,:) )
+                  CALL grid_add_ghost(tl_var(jvar), tl_dom1%i_ghost(:,:))
 
                ENDDO
@@ -631,5 +634,5 @@
                DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
 
-                  WRITE(*,'(2x,a,a)') "work on variable "//&
+                  WRITE(*,'(2x,a,a)') "work on (interp) variable "//&
                   &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
 
@@ -646,8 +649,7 @@
                   &                                   id_rho=il_rho(:), &
                   &                                   cd_point=TRIM(tl_var(jvar)%c_point))
-                  
 
                   ! interpolate variable
-                  CALL create_restart_interp(tl_var(jvar), tl_level(:), &
+                  CALL create_restart_interp(tl_var(jvar), & 
                   &                          il_rho(:), &
                   &                          id_offset=il_offset(:,:))
@@ -675,11 +677,6 @@
                   CALL att_clean(tl_att)
 
-                  ! use mask
-                  CALL create_restart_mask(tl_var(jvar), tl_level(:))
-
                   ! add ghost cell
-                  CALL grid_add_ghost( tl_var(jvar), il_xghost(:,:) )
-
-
+                  CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:))
                ENDDO
 
@@ -705,7 +702,19 @@
    CALL mpp_clean(tl_coord0)
 
+   IF( .NOT. ln_extrap )THEN
+      ! compute level
+      ALLOCATE(tl_level(ip_npoint))
+      tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist )
+   ENDIF
+
+   ! clean
+   CALL mpp_clean(tl_bathy1)
+
    ! use additional request
    DO jvar=1,il_nvar
 
+      ! change unit and apply factor
+      CALL var_chg_unit(tl_var(jvar))
+
       ! forced min and max value
       CALL var_limit_value(tl_var(jvar))
@@ -714,8 +723,8 @@
       CALL filter_fill_value(tl_var(jvar))
 
-      ! extrapolate
-      CALL extrap_fill_value(tl_var(jvar), id_iext=in_extrap, &
-      &                                    id_jext=in_extrap, &
-      &                                    id_kext=in_extrap)
+      IF( .NOT. ln_extrap )THEN
+         ! use mask
+         CALL create_restart_mask(tl_var(jvar), tl_level(:))
+      ENDIF
 
    ENDDO
@@ -724,5 +733,5 @@
    IF( in_niproc == 0 .AND. &
    &   in_njproc == 0 .AND. &
-   &   in_nproc  == 0 )THEN
+   &   in_nproc == 0 )THEN
       in_niproc = 1
       in_njproc = 1
@@ -782,5 +791,5 @@
          CALL mpp_add_var(tl_mppout, tl_depth)
       ELSE
-         CALL logger_error("CREATE RESTART: no value for depth variable.")
+         CALL logger_warn("CREATE RESTART: no value for depth variable.")
       ENDIF
    ENDIF
@@ -792,5 +801,5 @@
          CALL mpp_add_var(tl_mppout, tl_time)
       ELSE
-         CALL logger_error("CREATE RESTART: no value for time variable.")
+         CALL logger_warn("CREATE RESTART: no value for time variable.")
       ENDIF
    ENDIF
@@ -798,5 +807,5 @@
 
    ! add other variable
-   DO jvar=1,il_nvar
+   DO jvar=il_nvar,1,-1
       ! check if variable already add
       il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name)
@@ -807,9 +816,4 @@
    ENDDO
 
-!   DO ji=1,4
-!      CALL grid_add_ghost( tl_level(ji), il_xghost(:,:) )
-!      CALL var_clean(tl_level(ji))
-!   ENDDO
-
    ! add some attribute
    tl_att=att_init("Created_by","SIREN create_restart")
@@ -839,4 +843,7 @@
    ENDIF
 
+   ! print
+   CALL mpp_print(tl_mppout)
+
    ! create file
    CALL iom_mpp_create(tl_mppout)
@@ -847,13 +854,12 @@
    CALL iom_mpp_close(tl_mppout)
 
-   ! print
-   CALL mpp_print(tl_mppout)
-
    ! clean
    CALL att_clean(tl_att)
    CALL var_clean(tl_var(:))
    DEALLOCATE(tl_var)
-   CALL var_clean(tl_level(:))
-   DEALLOCATE(tl_level)
+   IF( .NOT. ln_extrap )THEN
+      CALL var_clean(tl_level(:))
+      DEALLOCATE(tl_level)
+   ENDIF
 
    CALL mpp_clean(tl_mppout)
@@ -876,19 +882,21 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - do not use level anymore 
    !>
    !> @param[in] td_var    variable structure 
    !> @param[in] td_coord  coordinate file structure 
    !> @param[in] id_nlevel number of vertical level  
-   !> @param[in] td_level  array of level on T,U,V,F point (variable structure) 
+   !> @param[in] id_xghost ghost cell array
    !> @return variable structure 
    !-------------------------------------------------------------------
-   FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, td_level)
+   FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, id_xghost)
       IMPLICIT NONE
       ! Argument
-      TYPE(TVAR)              , INTENT(IN) :: td_var
-      TYPE(TMPP)              , INTENT(IN) :: td_coord
-      INTEGER(i4)             , INTENT(IN) :: id_nlevel
-      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level
+      TYPE(TVAR)                 , INTENT(IN) :: td_var
+      TYPE(TMPP)                 , INTENT(IN) :: td_coord
+      INTEGER(i4)                , INTENT(IN) :: id_nlevel
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_xghost
 
       ! function
@@ -899,5 +907,4 @@
       INTEGER(i4)      , DIMENSION(3)                    :: il_size
       INTEGER(i4)      , DIMENSION(3)                    :: il_rest
-      INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost
 
       INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape
@@ -915,7 +922,4 @@
       !----------------------------------------------------------------
 
-      ! look for ghost cell
-      il_xghost(:,:)=grid_get_ghost( td_coord )
-
       ! write value on grid
       ! get matrix dimension
@@ -929,6 +933,6 @@
 
       ! remove ghost cell
-      tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(il_xghost(jp_I,:))*ip_ghost
-      tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(il_xghost(jp_J,:))*ip_ghost
+      tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(id_xghost(jp_I,:))*ip_ghost
+      tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(id_xghost(jp_J,:))*ip_ghost
 
       ! split output domain in N subdomain depending of matrix dimension 
@@ -992,10 +996,4 @@
       DEALLOCATE(dl_value)
 
-      ! use mask
-      CALL create_restart_mask(create_restart_matrix, td_level(:))
-
-      ! add ghost cell
-      CALL grid_add_ghost( create_restart_matrix, il_xghost(:,:) )
-
       ! clean 
       DEALLOCATE(il_ishape)
@@ -1009,5 +1007,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -1071,8 +1069,9 @@
    !> 
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - do not use level anymore (for extrapolation)
    !>
    !> @param[inout] td_var    variable structure 
-   !> @param[inout] td_level  fine grid level, array of variable structure
    !> @param[in] id_rho       array of refinment factor
    !> @param[in] id_offset    array of offset between fine and coarse grid
@@ -1080,5 +1079,5 @@
    !> @param[in] id_jext      j-direction size of extra bands (default=im_minext)
    !-------------------------------------------------------------------
-   SUBROUTINE create_restart_interp( td_var, td_level,&
+   SUBROUTINE create_restart_interp( td_var, & 
    &                                 id_rho,          &
    &                                 id_offset,       &
@@ -1089,5 +1088,4 @@
       ! Argument
       TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
-      TYPE(TVAR) , DIMENSION(:)  , INTENT(INOUT) :: td_level
       INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
       INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
@@ -1119,5 +1117,4 @@
          il_jext=2
       ENDIF
-
       ! work on variable
       ! add extraband
@@ -1125,8 +1122,5 @@
 
       ! extrapolate variable
-      CALL extrap_fill_value( td_var, td_level(:),    &
-      &                               id_offset(:,:), &
-      &                               id_rho(:),      &
-      &                               id_iext=il_iext, id_jext=il_jext )
+      CALL extrap_fill_value( td_var )
 
       ! interpolate variable
@@ -1146,5 +1140,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !>
    !> @param[in] td_mpp       mpp structure
@@ -1197,5 +1191,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !>
    !> @param[in] td_mpp      mpp structure
@@ -1220,4 +1214,5 @@
 
       ! get or check depth value
+
       IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/dimension.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/dimension.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/dimension.f90	(revision 5682)
@@ -78,5 +78,5 @@
 !>
 !>    This subroutine filled dimension structure with unused dimension, 
-!>    then switch from "unordered" dimension to "ordered" dimension.<br/>
+!>    then switch from "disordered" dimension to "ordered" dimension.<br/>
 !>    The dimension structure return will be:<br/>
 !>    tl_dim(1) => 'X', i_len=10, l_use=T, l_uld=F<br/>
@@ -94,8 +94,8 @@
 !>    - cl_neworder : character(len=4) (example: 'yxzt')
 !>
-!>    to switch dimension array from ordered dimension to unordered
+!>    to switch dimension array from ordered dimension to disordered
 !> dimension:<br/>
 !> @code
-!>    CALL dim_unorder(tl_dim(:))
+!>    CALL dim_disorder(tl_dim(:))
 !> @endcode
 !>
@@ -111,7 +111,7 @@
 !>    CALL dim_reshape_2xyzt(tl_dim(:), value(:,:,:,:))
 !> @endcode
-!>       - value must be a 4D array of real(8) value "unordered"
-!>
-!>    to reshape array of value in "unordered" dimension:<br/>
+!>       - value must be a 4D array of real(8) value "disordered"
+!>
+!>    to reshape array of value in "disordered" dimension:<br/>
 !> @code
 !>    CALL dim_reshape_xyzt2(tl_dim(:), value(:,:,:,:))
@@ -123,10 +123,10 @@
 !>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
 !> @endcode
-!>       - tab must be a 1D array with 4 elements "unordered".
+!>       - tab must be a 1D array with 4 elements "disordered".
 !>       It could be composed of character, integer(4), or logical
 !> 
-!>    to reorder a 1D array of 4 elements in "unordered" dimension:<br/>
-!> @code
-!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
+!>    to reorder a 1D array of 4 elements in "disordered" dimension:<br/>
+!> @code
+!>    CALL dim_reorder_xyzt2(tl_dim(:), tab(:))
 !> @endcode
 !>       - tab must be a 1D array with 4 elements "ordered".
@@ -173,6 +173,6 @@
    PUBLIC :: dim_print         !< print dimension information
    PUBLIC :: dim_copy          !< copy dimension structure
-   PUBLIC :: dim_reorder       !< filled dimension structure to switch from unordered to ordered dimension
-   PUBLIC :: dim_unorder       !< switch dimension array from ordered to unordered dimension
+   PUBLIC :: dim_reorder       !< filled dimension structure to switch from disordered to ordered dimension
+   PUBLIC :: dim_disorder      !< switch dimension array from ordered to disordered dimension
    PUBLIC :: dim_fill_unused   !< filled dimension structure with unused dimension 
    PUBLIC :: dim_reshape_2xyzt !< reshape array dimension to ('x','y','z','t')
@@ -321,5 +321,6 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial Version
-   !> @date September, 2014 - do not check if dimension used
+   !> @date September, 2014 
+   !> - do not check if dimension used
    !>
    !> @param[in] td_dim    array of dimension structure
@@ -502,8 +503,14 @@
    !> Optionally length could be inform, as well as short name and if dimension
    !> is unlimited or not.<br/>
-   !> define dimension is supposed to be used.
-   !>
-   !> @author J.Paul
-   !> @date November, 2013 - Initial Version
+   !> By default, define dimension is supposed to be used.
+   !> Optionally you could force a defined dimension to be unused. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - add optional argument to define dimension unused
+   !> @date July, 2015
+   !> - Bug fix: inform order to disorder table instead of disorder to order
+   !> table
    !
    !> @param[in] cd_name   dimension name
@@ -511,7 +518,8 @@
    !> @param[in] ld_uld    dimension unlimited
    !> @param[in] cd_sname  dimension short name
+   !> @param[in] ld_uld    dimension use or not
    !> @return dimension structure
    !-------------------------------------------------------------------
-   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname)
+   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use)
       IMPLICIT NONE
 
@@ -521,4 +529,5 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_uld
       CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_use
 
       ! local variable
@@ -543,5 +552,9 @@
 
       ! define dimension is supposed to be used
-      dim_init%l_use=.TRUE.
+      IF( PRESENT(ld_use) )THEN
+         dim_init%l_use=ld_use
+      ELSE
+         dim_init%l_use=.TRUE.
+      ENDIF
 
       IF( PRESENT(cd_sname) )THEN
@@ -590,6 +603,6 @@
       ENDIF
       
-      ! get dimension orderer index
-      dim_init%i_2xyzt=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname))
+      ! get dimension order indices
+      dim_init%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname))
 
    END FUNCTION dim_init
@@ -655,4 +668,6 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - Bug fix: use order to disorder table (see dim_init)
    !>
    !> @param[in] td_dim array of dimension structure
@@ -686,6 +701,6 @@
          ! search missing dimension
          IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN
-            ! search first empty dimension
-            il_ind(:)=MINLOC( tl_dim(:)%i_2xyzt, tl_dim(:)%i_2xyzt == 0 )
+            ! search first empty dimension (see dim_init)
+            il_ind(:)=MINLOC( tl_dim(:)%i_xyzt2, tl_dim(:)%i_xyzt2 == 0 )
 
             ! put missing dimension instead of empty one
@@ -693,5 +708,5 @@
             ! update output structure
             tl_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji))
-            tl_dim(il_ind(1))%i_2xyzt=ji
+            tl_dim(il_ind(1))%i_xyzt2=ji
             tl_dim(il_ind(1))%i_len=1
             tl_dim(il_ind(1))%l_use=.FALSE.
@@ -711,5 +726,5 @@
    !> This subroutine switch element of an array (4 elts) of dimension 
    !> structure 
-   !> from unordered dimension to ordered dimension <br/>
+   !> from disordered dimension to ordered dimension <br/>
    !>
    !> @details
@@ -722,5 +737,6 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial Version
-   !> @date September, 2014 - allow to choose ordered dimension to be output
+   !> @date September, 2014 
+   !> - allow to choose ordered dimension to be output
    !>
    !> @param[inout] td_dim    array of dimension structure
@@ -811,5 +827,5 @@
    !-------------------------------------------------------------------
    !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t')
-   !> to unordered dimension. <br/>
+   !> to disordered dimension. <br/>
    !> @details
    !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/>
@@ -822,5 +838,5 @@
    !> @param[inout] td_dim array of dimension structure
    !-------------------------------------------------------------------
-   SUBROUTINE dim_unorder(td_dim)
+   SUBROUTINE dim_disorder(td_dim)
       IMPLICIT NONE
       ! Argument      
@@ -835,5 +851,5 @@
 
       IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
-         CALL logger_error("DIM UNORDER: invalid dimension of array dimension.")
+         CALL logger_error("DIM DISORDER: invalid dimension of array dimension.")
       ELSE      
          ! add dummy xyzt2 id to unused dimension
@@ -868,5 +884,5 @@
       ENDIF
 
-   END SUBROUTINE dim_unorder
+   END SUBROUTINE dim_disorder
    !-------------------------------------------------------------------
    !> @brief This function reshape real(8) 4D array   
@@ -908,5 +924,6 @@
 
       IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
-         CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of array dimension.")
+         CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of "//&
+            &  "array dimension.")
       ELSE      
 
@@ -914,6 +931,6 @@
 
             CALL logger_fatal( &
-            &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder &
-            &     before running RESHAPE" )
+            &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder"// &
+            &  "   before running RESHAPE" )
 
          ENDIF
@@ -972,5 +989,5 @@
    !-------------------------------------------------------------------
    !> @brief This function reshape ordered real(8) 4D array with dimension 
-   !> (/'x','y','z','t'/) to an "unordered" array.<br/>
+   !> (/'x','y','z','t'/) to an "disordered" array.<br/>
    !> @details
    !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)
@@ -1009,5 +1026,6 @@
 
       IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
-         CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of array dimension.")
+         CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of "//&
+            &  "array dimension.")
       ELSE
 
@@ -1015,6 +1033,6 @@
 
             CALL logger_fatal( &
-            &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder &
-            &     before running RESHAPE" )
+            &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder"// &
+            &  "   before running RESHAPE" )
 
          ENDIF        
@@ -1104,6 +1122,6 @@
 
             CALL logger_error( &
-            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder &
-            &     before running REORDER" )
+            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//&
+            &  "   before running REORDER" )
 
          ENDIF        
@@ -1116,5 +1134,5 @@
    END FUNCTION dim__reorder_2xyzt_i4
    !-------------------------------------------------------------------
-   !> @brief This function unordered integer(4) 1D array to be suitable with
+   !> @brief This function disordered integer(4) 1D array to be suitable with
    !> initial dimension order (ex: dimension read in file).
    !> @note you must have run dim_reorder before use this subroutine
@@ -1143,12 +1161,12 @@
       IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
       &   SIZE(id_arr(:)) /= ip_maxdim )THEN
-         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//&
-         &              " or of array of value.")
+         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of "//&
+            &  "array dimension or of array of value.")
       ELSE      
          IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
 
             CALL logger_error( &
-            &  "  DIM REORDER XYZT 2: you should have run dim_reorder &
-            &     before running REORDER" )
+            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
+            &  "   before running REORDER" )
 
          ENDIF        
@@ -1166,5 +1184,5 @@
    !
    !> @author J.Paul
-   !> @date Nov, 2013 - Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_dim array of dimension structure
@@ -1193,6 +1211,6 @@
 
             CALL logger_error( &
-            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder &
-            &     before running REORDER" )
+            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"// &
+            &  "   before running REORDER" )
 
          ENDIF        
@@ -1205,5 +1223,5 @@
    END FUNCTION dim__reorder_2xyzt_l
    !-------------------------------------------------------------------
-   !> @brief This function unordered logical 1D array to be suitable with
+   !> @brief This function disordered logical 1D array to be suitable with
    !> initial dimension order (ex: dimension read in file).
    !> @note you must have run dim_reorder before use this subroutine
@@ -1238,6 +1256,6 @@
 
             CALL logger_error( &
-            &  "  DIM REORDER XYZT 2: you should have run dim_reorder &
-            &     before running REORDER" )
+            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"//&
+            &  "  before running REORDER" )
 
          ENDIF        
@@ -1294,10 +1312,10 @@
    END FUNCTION dim__reorder_2xyzt_c
    !-------------------------------------------------------------------
-   !> @brief This function unordered string 1D array to be suitable with
+   !> @brief This function disordered string 1D array to be suitable with
    !> initial dimension order (ex: dimension read in file).
    !> @note you must have run dim_reorder before use this subroutine
    !
    !> @author J.Paul
-   !> @date Nov, 2013 - Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_dim array of dimension structure
@@ -1326,6 +1344,6 @@
          IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
             CALL logger_error( &
-            &  "  DIM REORDER XYZT 2: you should have run dim_reorder &
-            &     before running REORDER" )
+            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
+            &  "   before running REORDER" )
 
          ENDIF        
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md	(revision 5682)
@@ -13,6 +13,6 @@
 # Fortran Compiler
    SIREN codes were succesfully tested with :
-   - ifort (version 12.0.4)
-   - gfortran (version 4.7.2 20121109)
+   - ifort (version 15.0.1)
+   - gfortran (version 4.8.2 20140120) 
 <!--   - pgf95 (version 13.9-0) -->
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md	(revision 5682)
@@ -80,5 +80,5 @@
 
 # Implicit none {#implicit}
-All subroutines and functions will include an IMPLICTI NONE statement.
+All subroutines and functions will include an IMPLICIT NONE statement.
 
 # Header {#header}
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/domain.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/domain.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/domain.f90	(revision 5682)
@@ -246,5 +246,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_dom dom structure
@@ -294,5 +294,5 @@
    !
    !> @author J.Paul
-   !> - June, 2013- Initial Version
+   !> @date June, 2013 - Initial Version
    !> @date September, 2014
    !> - add boundary index
@@ -362,6 +362,7 @@
 
          IF( td_mpp%i_perio < 0 .OR. td_mpp%i_perio > 6 )THEN
-            CALL logger_error("DOM INIT: invalid grid periodicity. "//&
-            &  "you should use grid_get_perio to compute it")
+            CALL logger_error("DOM INIT: invalid grid periodicity ("//&
+            &  TRIM(fct_str(td_mpp%i_perio))//&
+            &  ") you should use grid_get_perio to compute it")
          ELSE
             dom__init_mpp%i_perio0=td_mpp%i_perio
@@ -424,5 +425,5 @@
    !
    !> @author J.Paul
-   !> - June, 2013- Initial Version
+   !> @date June, 2013 - Initial Version
    !> @date September, 2014
    !> - add boundary index
@@ -489,6 +490,7 @@
 
          IF( td_file%i_perio < 0 .OR. td_file%i_perio > 6 )THEN
-            CALL logger_error("DOM INIT: invalid grid periodicity. "//&
-            &  "you should use grid_get_perio to compute it")
+            CALL logger_error("DOM INIT: invalid grid periodicity ("//&
+            &  TRIM(fct_str(td_file%i_perio))//&
+            &  ") you should use grid_get_perio to compute it")
          ELSE
             dom__init_file%i_perio0=td_file%i_perio
@@ -548,5 +550,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain structure
@@ -653,5 +655,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !> @date September, 2014
    !> - use zero indice to defined cyclic or global domain
@@ -721,5 +723,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial verison
    !
    !> @param[inout] td_dom domain strcuture
@@ -755,5 +757,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -774,5 +776,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -806,5 +808,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -824,5 +826,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -862,5 +864,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -912,5 +914,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -951,5 +953,5 @@
    !>
    !> @author J.Paul
-   !> - April, 2013- Subroutine written
+   !> @date April, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -979,5 +981,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -1041,5 +1043,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -1082,5 +1084,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -1180,5 +1182,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -1292,5 +1294,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !> @date September, 2014
    !> - take into account number of ghost cell
@@ -1433,5 +1435,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
@@ -1476,5 +1478,5 @@
    !> 
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !> @date September, 2014
    !> - take into account boundary for one point size domain
@@ -1715,5 +1717,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_dom domain strcuture
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/extrap.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/extrap.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/extrap.f90	(revision 5682)
@@ -19,30 +19,19 @@
 !>    defining string character _cn\_varinfo_. By default _dist_weight_.<br/>
 !>    Example:
-!>       - cn_varinfo='varname1:dist_weight', 'varname2:min_error'
+!>       - cn_varinfo='varname1:ext=dist_weight', 'varname2:ext=min_error'
 !>
 !>    to detect point to be extrapolated:<br/>
 !> @code
-!>    il_detect(:,:,:)=extrap_detect(td_var, [td_level], [id_offset,] [id_rho,] [id_ext]) 
+!>    il_detect(:,:,:)=extrap_detect(td_var)
 !> @endcode
 !>       - il_detect(:,:,:) is 3D array of point to be extrapolated
 !>       - td_var  is coarse grid variable to be extrapolated
-!>       - td_level is fine grid array of level (see vgrid_get_level) [optional]
-!>       - id_offset is array of offset between fine and coarse grid [optional]
-!>       - id_rho    is array of refinment factor [optional]
-!>       - id_ext    is array of number of points to be extrapolated [optional]
 !>
 !>    to extrapolate variable:<br/>
 !> @code
-!>    CALL extrap_fill_value( td_var, [td_level], [id_offset], [id_rho], [id_iext], [id_jext], [id_kext], [id_radius], [id_maxiter])
+!>    CALL extrap_fill_value( td_var, [id_radius])
 !> @endcode
 !>       - td_var  is coarse grid variable to be extrapolated
-!>       - td_level is fine grid array of level (see vgrid_get_level) [optional]
-!>       - id_offset is array of offset between fine and coarse grid [optional]
-!>       - id_rho    is array of refinment factor [optional]
-!>       - id_iext   is number of points to be extrapolated in i-direction [optional]
-!>       - id_jext   is number of points to be extrapolated in j-direction [optional]
-!>       - id_kext   is number of points to be extrapolated in k-direction [optional]
 !>       - id_radius is radius of the halo used to compute extrapolation [optional]
-!>       - id_maxiter is maximum number of iteration [optional]
 !>
 !>    to add extraband to the variable (to be extrapolated):<br/>
@@ -62,30 +51,4 @@
 !>       - id_jsize : j-direction size of extra bands [optional]
 !>
-!>    to compute first derivative of 1D array:<br/>
-!> @code
-!>    dl_value(:)=extrap_deriv_1D( dd_value(:), dd_fill, [ld_discont] )
-!> @endcode
-!>       - dd_value is 1D array of variable
-!>       - dd_fill is FillValue of variable
-!>       - ld_discont is logical to take into account longitudinal East-West discontinuity [optional]
-!>
-!>    to compute first derivative of 2D array:<br/>
-!> @code
-!>    dl_value(:,:)=extrap_deriv_2D( dd_value(:,:), dd_fill, cd_dim, [ld_discont] )
-!> @endcode
-!>       - dd_value is 2D array of variable
-!>       - dd_fill is FillValue of variable
-!>       - cd_dim is character to compute derivative on first (I) or second (J) dimension
-!>       - ld_discont is logical to take into account longitudinal East-West discontinuity [optional]
-!>
-!>    to compute first derivative of 3D array:<br/>
-!> @code
-!>    dl_value(:,:,:)=extrap_deriv_3D( dd_value(:,:,:), dd_fill, cd_dim, [ld_discont] )
-!> @endcode
-!>       - dd_value is 3D array of variable
-!>       - dd_fill is FillValue of variable
-!>       - cd_dim is character to compute derivative on first (I), second (J), or third (K) dimension
-!>       - ld_discont is logical to take into account longitudinal East-West discontinuity [optional]
-!>
 !> @warning _FillValue must not be zero (use var_chg_FillValue())
 !>
@@ -93,10 +56,17 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date Nov, 2013 - Initial Version
+!> @date November, 2013 - Initial Version
 !> @date September, 2014
 !> - add header
+!> @date June, 2015
+!> - extrapolate all land points (_FillValue)
+!> - move deriv function to math module
+!> @date July, 2015
+!> - compute extrapolation from north west to south east, 
+!> and from south east to north west
 !>
 !> @todo
 !> - create module for each extrapolation method
+!> - smooth extrapolated points
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -110,4 +80,5 @@
    USE date                            ! date manager
    USE logger                          ! log file manager
+   USE math                            ! mathematical function
    USE att                             ! attribute manager
    USE dim                             ! dimension manager
@@ -118,5 +89,4 @@
 
    ! type and variable
-   PRIVATE :: im_maxiter   !< default maximum number of iteration 
    PRIVATE :: im_minext    !< default minumum number of point to extrapolate
    PRIVATE :: im_mincubic  !< default minumum number of point to extrapolate for cubic interpolation
@@ -127,7 +97,4 @@
    PUBLIC :: extrap_add_extrabands !< add extraband to the variable (to be extrapolated) 
    PUBLIC :: extrap_del_extrabands !< delete extraband of the variable 
-   PUBLIC :: extrap_deriv_1D       !< compute first derivative of 1D array 
-   PUBLIC :: extrap_deriv_2D       !< compute first derivative of 2D array 
-   PUBLIC :: extrap_deriv_3D       !< compute first derivative of 3D array
 
    PRIVATE :: extrap__detect_wrapper      ! detected point to be extrapolated wrapper
@@ -141,5 +108,4 @@
    PRIVATE :: extrap__3D_dist_weight_fill ! 
 
-   INTEGER(i4), PARAMETER :: im_maxiter = 10 !< default maximum number of iteration
    INTEGER(i4), PARAMETER :: im_minext  = 2  !< default minumum number of point to extrapolate
    INTEGER(i4), PARAMETER :: im_mincubic= 4  !< default minumum number of point to extrapolate for cubic interpolation
@@ -171,22 +137,15 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - do not use level to select points to be extrapolated
    !
    !> @param[in] td_var0   coarse grid variable to extrapolate
-   !> @param[in] td_level1 fine grid array of level
-   !> @param[in] id_offset array of offset between fine and coarse grid 
-   !> @param[in] id_rho    array of refinment factor 
-   !> @param[in] id_ext    array of number of points to be extrapolated
    !> @return array of point to be extrapolated
    !-------------------------------------------------------------------
-   FUNCTION extrap__detect( td_var0, td_level1, &
-   &                        id_offset, id_rho, id_ext )
+   FUNCTION extrap__detect( td_var0 ) 
       IMPLICIT NONE
       ! Argument
       TYPE(TVAR) ,                 INTENT(IN   ) :: td_var0
-      TYPE(TVAR) , DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: td_level1
-      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset
-      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho
-      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_ext
 
       ! function
@@ -196,180 +155,12 @@
 
       ! local variable
-      CHARACTER(LEN=lc)                                :: cl_level
-
-      INTEGER(i4)                                      :: il_ind
-      INTEGER(i4)      , DIMENSION(:,:,:), ALLOCATABLE :: il_detect
-      INTEGER(i4)      , DIMENSION(:,:,:), ALLOCATABLE :: il_tmp
-      INTEGER(i4)      , DIMENSION(:,:)  , ALLOCATABLE :: il_offset
-      INTEGER(i4)      , DIMENSION(:,:)  , ALLOCATABLE :: il_level1
-      INTEGER(i4)      , DIMENSION(:,:)  , ALLOCATABLE :: il_level1_G0
-      INTEGER(i4)      , DIMENSION(:,:)  , ALLOCATABLE :: il_extra
-      INTEGER(i4)      , DIMENSION(:)    , ALLOCATABLE :: il_ext
-      INTEGER(i4)      , DIMENSION(:)    , ALLOCATABLE :: il_rho
-      INTEGER(i4)      , DIMENSION(:)    , ALLOCATABLE :: il_dim0
-
-      TYPE(TVAR)                                       :: tl_var1
-
       ! loop indices
       INTEGER(i4) :: ji0
       INTEGER(i4) :: jj0
       INTEGER(i4) :: jk0
-      INTEGER(i4) :: ji1
-      INTEGER(i4) :: jj1
-      INTEGER(i4) :: ji1m
-      INTEGER(i4) :: jj1m
-      INTEGER(i4) :: ji1p
-      INTEGER(i4) :: jj1p
       !----------------------------------------------------------------
 
-      ! init
-      extrap__detect(:,:,:)=0
-
-      ALLOCATE( il_dim0(3) )
-      il_dim0(:)=td_var0%t_dim(1:3)%i_len
-
-      ! optional argument
-      ALLOCATE( il_rho(ip_maxdim) )
-      il_rho(:)=1
-      IF( PRESENT(id_rho) ) il_rho(1:SIZE(id_rho(:)))=id_rho(:)
-
-      ALLOCATE( il_offset(ip_maxdim,2) )
-      il_offset(:,:)=0
-      IF( PRESENT(id_offset) )THEN
-         il_offset(1:SIZE(id_offset(:,:),DIM=1),&
-         &         1:SIZE(id_offset(:,:),DIM=2) )= id_offset(:,:)
-      ELSE
-         il_offset(jp_I,:)=FLOOR(REAL(il_rho(jp_I)-1,dp)*0.5)
-         il_offset(jp_J,:)=FLOOR(REAL(il_rho(jp_J)-1,dp)*0.5)
-      ENDIF
-
-      ALLOCATE( il_ext(ip_maxdim) )
-      il_ext(:)=im_minext
-      IF( PRESENT(id_ext) ) il_ext(1:SIZE(id_ext(:)))=id_ext(:)
-
-      ALLOCATE( il_detect(il_dim0(1),&
-      &                   il_dim0(2),&
-      &                   il_dim0(3)) )
-      il_detect(:,:,:)=0
-
-      ! select point already inform
-      DO jk0=1,td_var0%t_dim(3)%i_len
-         DO jj0=1,td_var0%t_dim(2)%i_len
-            DO ji0=1,td_var0%t_dim(1)%i_len
-               IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill ) il_detect(ji0,jj0,jk0)=1
-            ENDDO
-         ENDDO
-      ENDDO
- 
-      IF( PRESENT(td_level1) )THEN
-         SELECT CASE(TRIM(td_var0%c_point))
-            CASE DEFAULT !'T'
-               cl_level='tlevel'
-            CASE('U')
-               cl_level='ulevel'
-            CASE('V')
-               cl_level='vlevel'
-            CASE('F')
-               cl_level='flevel'
-         END SELECT
-
-         il_ind=var_get_index(td_level1(:),TRIM(cl_level))
-         IF( il_ind == 0 )THEN
-            CALL logger_error("EXTRAP DETECT: can not compute point to be "//&
-            &     "extrapolated for variable "//TRIM(td_var0%c_name)//&
-            &      ". can not find "//&
-            &     "level for variable point "//TRIM(TRIM(td_var0%c_point)))
-         ELSE
-            tl_var1=var_copy(td_level1(il_ind))
-
-            ALLOCATE( il_level1_G0( il_dim0(1), il_dim0(2)) )
-            IF( ALL(tl_var1%t_dim(1:2)%i_len == il_dim0(1:2)) )THEN
-
-               ! variable to be extrapolated use same resolution than level
-               il_level1_G0(:,:)=INT(tl_var1%d_value(:,:,1,1),i4)
-               
-            ELSE
-               ! variable to be extrapolated do not use same resolution than level
-               ALLOCATE( il_level1(tl_var1%t_dim(1)%i_len, &
-               &                   tl_var1%t_dim(2)%i_len) )
-               ! match fine grid vertical level with coarse grid
-               il_level1(:,:)=INT(tl_var1%d_value(:,:,1,1),i4)/il_rho(jp_K)
-
-               ALLOCATE( il_extra(ip_maxdim,2) )
-               ! coarsening fine grid level
-               il_extra(jp_I,1)=CEILING(REAL(il_rho(jp_I)-1,dp)*0.5_dp)
-               il_extra(jp_I,2)=FLOOR(REAL(il_rho(jp_I)-1,dp)*0.5_dp)
-
-               il_extra(jp_J,1)=CEILING(REAL(il_rho(jp_J)-1,dp)*0.5_dp)
-               il_extra(jp_J,2)=FLOOR(REAL(il_rho(jp_J)-1,dp)*0.5_dp)
-
-               DO jj0=1,td_var0%t_dim(2)%i_len
-                  
-                  jj1=(jj0-1)*il_rho(jp_J)+1-il_offset(jp_J,1)
-
-                  jj1m=MAX( jj1-il_extra(jp_J,1), 1 )
-                  jj1p=MIN( jj1+il_extra(jp_J,2), &
-                  &         tl_var1%t_dim(2)%i_len-il_offset(jp_J,2) )
-                  
-                  DO ji0=1,td_var0%t_dim(1)%i_len
-
-                     ji1=(ji0-1)*il_rho(jp_I)+1-id_offset(jp_I,1)
-
-                     ji1m=MAX( ji1-il_extra(jp_I,1), 1 )
-                     ji1p=MIN( ji1+il_extra(jp_I,2), &
-                     &         tl_var1%t_dim(1)%i_len-id_offset(jp_I,2) )
-               
-                     il_level1_G0(ji0,jj0)=MAXVAL(il_level1(ji1m:ji1p,jj1m:jj1p))
-
-                  ENDDO
-               ENDDO
-
-               ! clean
-               DEALLOCATE( il_extra )
-               DEALLOCATE( il_level1 )
-
-            ENDIF
-
-            ! look for sea point
-            DO jk0=1,td_var0%t_dim(3)%i_len
-               WHERE( il_level1_G0(:,:) >= jk0)
-                  il_detect(:,:,jk0)=1
-               END WHERE
-            ENDDO
-
-            ! clean
-            DEALLOCATE( il_level1_G0 )
-            CALL var_clean(tl_var1)
-
-         ENDIF
-      ENDIF
-
-      ! clean
-      DEALLOCATE( il_offset )
- 
-      ALLOCATE( il_tmp(il_dim0(1),&
-      &                il_dim0(2),&
-      &                il_dim0(3)) )
-      il_tmp(:,:,:)=il_detect(:,:,:)
-      ! select extra point depending on interpolation method
-      ! compute point near grid point already inform
-      DO jk0=1,il_dim0(3)
-         DO jj0=1,il_dim0(2)
-            DO ji0=1,il_dim0(1)
-
-               IF( il_tmp(ji0,jj0,jk0) == 1 )THEN
-                  il_detect( &
-                  &  MAX(1,ji0-il_ext(jp_I)):MIN(ji0+il_ext(jp_I),il_dim0(1)),&
-                  &  MAX(1,jj0-il_ext(jp_J)):MIN(jj0+il_ext(jp_J),il_dim0(2)),&
-                  &  MAX(1,jk0-il_ext(jp_K)):MIN(jk0+il_ext(jp_K),il_dim0(3)) &
-                  &  ) = 1 
-               ENDIF
-
-            ENDDO
-         ENDDO
-      ENDDO
-      
-      ! clean
-      DEALLOCATE( il_tmp )
+      ! force to extrapolated all points
+      extrap__detect(:,:,:)=1
 
       ! do not compute grid point already inform
@@ -377,17 +168,10 @@
          DO jj0=1,td_var0%t_dim(2)%i_len
             DO ji0=1,td_var0%t_dim(1)%i_len
-               IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill ) il_detect(ji0,jj0,jk0)=0
+               IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill )THEN
+                  extrap__detect(ji0,jj0,jk0)=0
+               ENDIF
             ENDDO
          ENDDO
       ENDDO
-
-      ! save result
-      extrap__detect(:,:,:)=il_detect(:,:,:)
-
-      ! clean
-      DEALLOCATE( il_dim0 )
-      DEALLOCATE( il_ext )
-      DEALLOCATE( il_detect )
-      DEALLOCATE( il_rho )
 
    END FUNCTION extrap__detect
@@ -398,23 +182,16 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - select all land points for extrapolation
    !>
    !> @param[in] td_var    coarse grid variable to extrapolate
-   !> @param[in] td_level  fine grid array of level
-   !> @param[in] id_offset array of offset between fine and coarse grid 
-   !> @param[in] id_rho    array of refinment factor 
-   !> @param[in] id_ext    array of number of points to be extrapolated
    !> @return 3D array of point to be extrapolated
    !-------------------------------------------------------------------
-   FUNCTION extrap__detect_wrapper( td_var, td_level, &
-   &                                id_offset, id_rho, id_ext )
+   FUNCTION extrap__detect_wrapper( td_var )
 
       IMPLICIT NONE
       ! Argument
       TYPE(TVAR) ,                 INTENT(IN   ) :: td_var
-      TYPE(TVAR) , DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: td_level
-      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset
-      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho
-      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_ext
 
       ! function
@@ -439,8 +216,5 @@
          &              " for variable "//TRIM(td_var%c_name) )
          
-         extrap__detect_wrapper(:,:,:)=extrap__detect( td_var, td_level, &
-         &                                             id_offset, &
-         &                                             id_rho,    &
-         &                                             id_ext     )
+         extrap__detect_wrapper(:,:,:)=extrap__detect( td_var )
 
       ELSE IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
@@ -450,8 +224,5 @@
          &              " for variable "//TRIM(td_var%c_name) )
          
-         extrap__detect_wrapper(:,:,1:1)=extrap__detect( td_var , td_level,&
-         &                                               id_offset, &
-         &                                               id_rho,    &
-         &                                               id_ext     )
+         extrap__detect_wrapper(:,:,1:1)=extrap__detect( td_var )
 
       ELSE IF( td_var%t_dim(3)%l_use )THEN
@@ -461,8 +232,5 @@
          &              " for variable "//TRIM(td_var%c_name) )
          
-         extrap__detect_wrapper(1:1,1:1,:)=extrap__detect( td_var , td_level, &
-         &                                                 id_offset, &
-         &                                                 id_rho,    &
-         &                                                 id_ext     )
+         extrap__detect_wrapper(1:1,1:1,:)=extrap__detect( td_var )
 
       ENDIF              
@@ -489,39 +257,20 @@
    !>
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - select all land points for extrapolation
    !
    !> @param[inout] td_var    variable structure
-   !> @param[in] td_level     fine grid array of level
-   !> @param[in] id_offset    array of offset between fine and coarse grid 
-   !> @param[in] id_rho       array of refinment factor 
-   !> @param[in] id_iext      number of points to be extrapolated in i-direction
-   !> @param[in] id_jext      number of points to be extrapolated in j-direction
-   !> @param[in] id_kext      number of points to be extrapolated in k-direction
    !> @param[in] id_radius    radius of the halo used to compute extrapolation 
-   !> @param[in] id_maxiter   maximum number of iteration
-   !-------------------------------------------------------------------
-   SUBROUTINE extrap__fill_value_wrapper( td_var, td_level, &
-   &                                      id_offset,        &
-   &                                      id_rho,           &
-   &                                      id_iext, id_jext, id_kext, &
-   &                                      id_radius, id_maxiter )
+   !-------------------------------------------------------------------
+   SUBROUTINE extrap__fill_value_wrapper( td_var, & 
+   &                                      id_radius )
       IMPLICIT NONE
       ! Argument
       TYPE(TVAR) ,                  INTENT(INOUT) :: td_var
-      TYPE(TVAR) ,  DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: td_level
-      INTEGER(i4),  DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset
-      INTEGER(i4),  DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho
-      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_iext
-      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_jext
-      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_kext
       INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_radius
-      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_maxiter
 
       ! local variable
-      INTEGER(i4) :: il_iext
-      INTEGER(i4) :: il_jext
-      INTEGER(i4) :: il_kext
       INTEGER(i4) :: il_radius
-      INTEGER(i4) :: il_maxiter
 
       CHARACTER(LEN=lc) :: cl_method
@@ -544,66 +293,18 @@
          END SELECT
 
-         il_iext=im_minext
-         IF( PRESENT(id_iext) ) il_iext=id_iext
-         il_jext=im_minext
-         IF( PRESENT(id_jext) ) il_jext=id_jext
-         il_kext=0
-         IF( PRESENT(id_kext) ) il_kext=id_kext
-
-         IF( TRIM(td_var%c_interp(1)) == 'cubic')THEN
-            IF( il_iext > 0 .AND. il_iext < im_mincubic ) il_iext=im_mincubic
-            IF( il_jext > 0 .AND. il_jext < im_mincubic ) il_jext=im_mincubic
+         ! number of point use to compute box
+         il_radius=1
+         IF( PRESENT(id_radius) ) il_radius=id_radius
+         IF( il_radius < 0 )THEN
+            CALL logger_error("EXTRAP FILL VALUE: invalid "//&
+            &  " radius of the box used to compute extrapolation "//&
+            &  "("//TRIM(fct_str(il_radius))//")")
          ENDIF
 
-         IF( il_iext < 0 )THEN
-            CALL logger_error("EXTRAP FILL VALUE: invalid "//&
-            &  " number of points to be extrapolated in i-direction "//&
-            &  "("//TRIM(fct_str(il_iext))//")")
-         ENDIF
-
-         IF( il_jext < 0 )THEN
-            CALL logger_error("EXTRAP FILL VALUE: invalid "//&
-            &  " number of points to be extrapolated in j-direction "//&
-            &  "("//TRIM(fct_str(il_jext))//")")
-         ENDIF
-
-         IF( il_kext < 0 )THEN
-            CALL logger_error("EXTRAP FILL VALUE: invalid "//&
-            &  " number of points to be extrapolated in k-direction "//&
-            &  "("//TRIM(fct_str(il_kext))//")")
-         ENDIF
-
-         IF( (il_iext /= 0 .AND. td_var%t_dim(1)%l_use) .OR. &
-         &   (il_jext /= 0 .AND. td_var%t_dim(2)%l_use) .OR. &
-         &   (il_kext /= 0 .AND. td_var%t_dim(3)%l_use) )THEN
-
-            ! number of point use to compute box
-            il_radius=1
-            IF( PRESENT(id_radius) ) il_radius=id_radius
-            IF( il_radius < 0 )THEN
-               CALL logger_error("EXTRAP FILL VALUE: invalid "//&
-               &  " radius of the box used to compute extrapolation "//&
-               &  "("//TRIM(fct_str(il_radius))//")")
-            ENDIF
-
-            ! maximum number of iteration
-            il_maxiter=im_maxiter
-            IF( PRESENT(id_maxiter) ) il_maxiter=id_maxiter
-            IF( il_maxiter < 0 )THEN
-               CALL logger_error("EXTRAP FILL VALUE: invalid "//&
-               &  " maximum nuber of iteration "//&
-               &  "("//TRIM(fct_str(il_maxiter))//")")
-            ENDIF
-
-            CALL logger_info("EXTRAP FILL: extrapolate "//TRIM(td_var%c_name)//&
-            &  " using "//TRIM(cl_method)//" method." )
-
-            CALL extrap__fill_value( td_var, cl_method, &
-            &                        il_iext, il_jext, il_kext,   &
-            &                        il_radius, il_maxiter,       &
-            &                        td_level,                    &
-            &                        id_offset, id_rho )
- 
-         ENDIF
+         CALL logger_info("EXTRAP FILL: extrapolate "//TRIM(td_var%c_name)//&
+         &  " using "//TRIM(cl_method)//" method." )
+
+         CALL extrap__fill_value( td_var, cl_method, &
+         &                        il_radius )
  
       ENDIF
@@ -621,35 +322,19 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - select all land points for extrapolation
    !
    !> @param[inout] td_var    variable structure
    !> @param[in] cd_method    extrapolation method
-   !> @param[in] id_iext      number of points to be extrapolated in i-direction
-   !> @param[in] id_jext      number of points to be extrapolated in j-direction
-   !> @param[in] id_kext      number of points to be extrapolated in k-direction
    !> @param[in] id_radius    radius of the halo used to compute extrapolation
-   !> @param[in] id_maxiter   maximum number of iteration
-   !> @param[in] td_level     fine grid array of level
-   !> @param[in] id_offset    array of offset between fine and coarse grid 
-   !> @param[in] id_rho       array of refinment factor
    !-------------------------------------------------------------------
    SUBROUTINE extrap__fill_value( td_var, cd_method, &
-   &                              id_iext, id_jext, id_kext, &
-   &                              id_radius, id_maxiter, &
-   &                              td_level,          &
-   &                              id_offset,         &
-   &                              id_rho )
+   &                              id_radius )
       IMPLICIT NONE
       ! Argument
       TYPE(TVAR)      ,                 INTENT(INOUT) :: td_var
       CHARACTER(LEN=*),                 INTENT(IN   ) :: cd_method
-      INTEGER(i4)     ,                 INTENT(IN   ) :: id_iext
-      INTEGER(i4)     ,                 INTENT(IN   ) :: id_jext
-      INTEGER(i4)     ,                 INTENT(IN   ) :: id_kext
       INTEGER(i4)     ,                 INTENT(IN   ) :: id_radius
-      INTEGER(i4)     ,                 INTENT(IN   ) :: id_maxiter
-      TYPE(TVAR)      , DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: td_level
-      INTEGER(i4)     , DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset
-      INTEGER(i4)     , DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho
 
       ! local variable
@@ -668,8 +353,6 @@
       &                    td_var%t_dim(3)%i_len) )
 
-      il_detect(:,:,:) = extrap_detect( td_var, td_level, &
-      &                                 id_offset,        &
-      &                                 id_rho,           &
-      &                                 id_ext=(/id_iext, id_jext, id_kext/) )
+      il_detect(:,:,:) = extrap_detect( td_var )
+
       !2- add attribute to variable
       cl_extrap=fct_concat(td_var%c_extrap(:))
@@ -679,12 +362,21 @@
       CALL att_clean(tl_att)
 
-      CALL logger_info(" EXTRAP FILL: "//&
-         &              TRIM(fct_str(SUM(il_detect(:,:,:))))//&
-         &              " point(s) to extrapolate " )
-
-      !3- extrapolate
-      CALL extrap__3D(td_var%d_value(:,:,:,:), td_var%d_fill,    &
-      &               il_detect(:,:,:),                           &
-      &               cd_method, id_radius, id_maxiter  )
+      IF( ALL(il_detect(:,:,:)==1) )THEN
+         CALL logger_warn(" EXTRAP FILL: "//&
+            &  " can not extrapolate "//TRIM(td_var%c_name)//&
+            &  ". no value inform." )
+      ELSE
+         CALL logger_info(" EXTRAP FILL: "//&
+            &              TRIM(fct_str(SUM(il_detect(:,:,:))))//&
+            &              " point(s) to extrapolate " )
+
+         CALL logger_info(" EXTRAP FILL: method "//&
+            &  TRIM(cd_method) )
+
+         !3- extrapolate
+         CALL extrap__3D(td_var%d_value(:,:,:,:), td_var%d_fill, &
+         &               il_detect(:,:,:),                       &
+         &               cd_method, id_radius )
+      ENDIF
 
       DEALLOCATE(il_detect)
@@ -705,5 +397,8 @@
    !>
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - compute coef indices to be used
+   !> - bug fix: force coef indice to 1, for dimension lenth equal to 1
    !
    !> @param[inout] dd_value  3D array of variable to be extrapolated
@@ -714,26 +409,31 @@
    !-------------------------------------------------------------------
    SUBROUTINE extrap__3D( dd_value, dd_fill, id_detect,&
-   &                      cd_method, id_radius, id_maxiter )
+   &                      cd_method, id_radius )
       IMPLICIT NONE
       ! Argument
       REAL(dp)   , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_value
-      REAL(dp)   ,                   INTENT(IN   ) :: dd_fill
-      INTEGER(i4), DIMENSION(:,:,:), INTENT(INOUT) :: id_detect
-      CHARACTER(LEN=*),              INTENT(IN   ) :: cd_method
-      INTEGER(i4),                   INTENT(IN   ) :: id_radius
-      INTEGER(i4),                   INTENT(IN   ) :: id_maxiter
+      REAL(dp)   ,                     INTENT(IN   ) :: dd_fill
+      INTEGER(i4), DIMENSION(:,:,:)  , INTENT(INOUT) :: id_detect
+      CHARACTER(LEN=*),                INTENT(IN   ) :: cd_method
+      INTEGER(i4),                     INTENT(IN   ) :: id_radius
 
       ! local variable
-      INTEGER(i4) :: il_imin
-      INTEGER(i4) :: il_imax
-      INTEGER(i4) :: il_jmin
-      INTEGER(i4) :: il_jmax
-      INTEGER(i4) :: il_kmin
-      INTEGER(i4) :: il_kmax
-      INTEGER(i4) :: il_iter
-      INTEGER(i4) :: il_radius
-
-      INTEGER(i4), DIMENSION(4) :: il_shape
-      INTEGER(i4), DIMENSION(3) :: il_dim
+      INTEGER(i4)                                :: il_imin
+      INTEGER(i4)                                :: il_imax
+      INTEGER(i4)                                :: il_jmin
+      INTEGER(i4)                                :: il_jmax
+      INTEGER(i4)                                :: il_kmin
+      INTEGER(i4)                                :: il_kmax
+      INTEGER(i4)                                :: il_iter
+      INTEGER(i4)                                :: il_radius
+      INTEGER(i4)                                :: il_i1
+      INTEGER(i4)                                :: il_i2
+      INTEGER(i4)                                :: il_j1
+      INTEGER(i4)                                :: il_j2
+      INTEGER(i4)                                :: il_k1
+      INTEGER(i4)                                :: il_k2
+
+      INTEGER(i4), DIMENSION(4)                  :: il_shape
+      INTEGER(i4), DIMENSION(3)                  :: il_dim
 
       INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
@@ -743,4 +443,6 @@
       REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dfdz
       REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_coef
+
+      LOGICAL                                    :: ll_iter
 
       ! loop indices
@@ -765,5 +467,6 @@
             DO WHILE( ANY(il_detect(:,:,:)==1) )
                ! change extend value to minimize number of iteration
-               il_radius=id_radius+(il_iter/id_maxiter)
+               il_radius=id_radius+(il_iter-1)
+               ll_iter=.TRUE.
 
                ALLOCATE( dl_dfdx(il_shape(1), il_shape(2), il_shape(3)) ) 
@@ -774,5 +477,6 @@
                dl_dfdx(:,:,:)=dd_fill
                IF( il_shape(1) > 1 )THEN
-                  dl_dfdx(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'I' )
+                  dl_dfdx(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
+                     &                          dd_fill, 'I' )
                ENDIF
 
@@ -780,5 +484,6 @@
                dl_dfdy(:,:,:)=dd_fill
                IF( il_shape(2) > 1 )THEN
-                  dl_dfdy(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'J' )
+                  dl_dfdy(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
+                     &                          dd_fill, 'J' )
                ENDIF
  
@@ -786,5 +491,6 @@
                dl_dfdz(:,:,:)=dd_fill
                IF( il_shape(3) > 1 )THEN
-                  dl_dfdz(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'K' )
+                  dl_dfdz(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
+                     &                          dd_fill, 'K' )
                ENDIF
  
@@ -804,4 +510,5 @@
 
                DO jk=1,il_shape(3)
+                  ! from North West(1,1) to South East(il_shape(1),il_shape(2))
                   IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
                   DO jj=1,il_shape(2)
@@ -813,21 +520,40 @@
                            il_imin=MAX(ji-il_radius,1)
                            il_imax=MIN(ji+il_radius,il_shape(1))
+                           ! coef indices to be used
+                           il_i1 = il_radius-(ji-il_imin)+1
+                           il_i2 = il_radius+(il_imax-ji)+1
                            IF( il_dim(1) == 1 )THEN
                               il_imin=ji
                               il_imax=ji
-                           ENDIF
+                              ! coef indices to be used
+                              il_i1 = 1
+                              il_i2 = 1
+                           ENDIF
+
 
                            il_jmin=MAX(jj-il_radius,1)
                            il_jmax=MIN(jj+il_radius,il_shape(2))
+                           ! coef indices to be used
+                           il_j1 = il_radius-(jj-il_jmin)+1
+                           il_j2 = il_radius+(il_jmax-jj)+1
                            IF( il_dim(2) == 1 )THEN
                               il_jmin=jj
                               il_jmax=jj
+                              ! coef indices to be used
+                              il_j1 = 1
+                              il_j2 = 1
                            ENDIF
 
                            il_kmin=MAX(jk-il_radius,1)
                            il_kmax=MIN(jk+il_radius,il_shape(3))
+                           ! coef indices to be used
+                           il_k1 = il_radius-(jk-il_kmin)+1
+                           il_k2 = il_radius+(il_kmax-jk)+1
                            IF( il_dim(3) == 1 )THEN
                               il_kmin=jk
                               il_kmax=jk
+                              ! coef indices to be used
+                              il_k1 = 1
+                              il_k2 = 1
                            ENDIF
 
@@ -845,8 +571,85 @@
                            &            il_jmin:il_jmax, &
                            &            il_kmin:il_kmax ), &
-                           &  dl_coef(:,:,:) )
+                           &  dl_coef(il_i1:il_i2, &
+                           &          il_j1:il_j2, &
+                           &          il_k1:il_k2) )
 
                            IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
                               il_detect(ji,jj,jk)= 0
+                              ll_iter=.FALSE.
+                           ENDIF
+
+                        ENDIF
+
+                     ENDDO
+                  ENDDO
+                  ! from South East(il_shape(1),il_shape(2)) to North West(1,1)
+                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
+                  DO jj=il_shape(2),1,-1
+                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE
+                     DO ji=il_shape(1),1,-1
+
+                        IF( il_detect(ji,jj,jk) == 1 )THEN
+                          
+                           il_imin=MAX(ji-il_radius,1)
+                           il_imax=MIN(ji+il_radius,il_shape(1))
+                           ! coef indices to be used
+                           il_i1 = il_radius-(ji-il_imin)+1
+                           il_i2 = il_radius+(il_imax-ji)+1
+                           IF( il_dim(1) == 1 )THEN
+                              il_imin=ji
+                              il_imax=ji
+                              ! coef indices to be used
+                              il_i1 = 1
+                              il_i2 = 1
+                           ENDIF
+
+
+                           il_jmin=MAX(jj-il_radius,1)
+                           il_jmax=MIN(jj+il_radius,il_shape(2))
+                           ! coef indices to be used
+                           il_j1 = il_radius-(jj-il_jmin)+1
+                           il_j2 = il_radius+(il_jmax-jj)+1
+                           IF( il_dim(2) == 1 )THEN
+                              il_jmin=jj
+                              il_jmax=jj
+                              ! coef indices to be used
+                              il_j1 = 1
+                              il_j2 = 1
+                           ENDIF
+
+                           il_kmin=MAX(jk-il_radius,1)
+                           il_kmax=MIN(jk+il_radius,il_shape(3))
+                           ! coef indices to be used
+                           il_k1 = il_radius-(jk-il_kmin)+1
+                           il_k2 = il_radius+(il_kmax-jk)+1
+                           IF( il_dim(3) == 1 )THEN
+                              il_kmin=jk
+                              il_kmax=jk
+                              ! coef indices to be used
+                              il_k1 = 1
+                              il_k2 = 1
+                           ENDIF
+
+                           dd_value(ji,jj,jk,jl)=extrap__3D_min_error_fill( &
+                           &  dd_value( il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax,jl ), dd_fill, il_radius, &
+                           &  dl_dfdx(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_dfdy(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_dfdz(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_coef(il_i1:il_i2, &
+                           &          il_j1:il_j2, &
+                           &          il_k1:il_k2) )
+
+                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
+                              il_detect(ji,jj,jk)= 0
+                              ll_iter=.FALSE.
                            ENDIF
 
@@ -862,5 +665,5 @@
                DEALLOCATE( dl_coef )
 
-               il_iter=il_iter+1
+               IF( ll_iter ) il_iter=il_iter+1
             ENDDO
          ENDDO
@@ -875,5 +678,6 @@
             DO WHILE( ANY(il_detect(:,:,:)==1) )
                ! change extend value to minimize number of iteration
-               il_radius=id_radius+(il_iter/id_maxiter)
+               il_radius=id_radius+(il_iter-1)
+               ll_iter=.TRUE.
 
                il_dim(1)=2*il_radius+1
@@ -886,10 +690,11 @@
                ALLOCATE( dl_coef(il_dim(1), il_dim(2), il_dim(3)) )
 
-               dl_coef(:,:,:)=extrap__3D_dist_weight_coef(dd_value(1:il_dim(1), &
-               &                                                   1:il_dim(2), &
-               &                                                   1:il_dim(3), &
+               dl_coef(:,:,:)=extrap__3D_dist_weight_coef(dd_value(1:il_dim(1),&
+               &                                                   1:il_dim(2),&
+               &                                                   1:il_dim(3),&
                &                                                   jl ) )
-
+               
                DO jk=1,il_shape(3)
+                  ! from North West(1,1) to South East(il_shape(1),il_shape(2))
                   IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
                   DO jj=1,il_shape(2)
@@ -901,21 +706,39 @@
                            il_imin=MAX(ji-il_radius,1)
                            il_imax=MIN(ji+il_radius,il_shape(1))
+                           ! coef indices to be used
+                           il_i1 = il_radius-(ji-il_imin)+1
+                           il_i2 = il_radius+(il_imax-ji)+1
                            IF( il_dim(1) == 1 )THEN
                               il_imin=ji
                               il_imax=ji
+                              ! coef indices to be used
+                              il_i1 = 1
+                              il_i2 = 1
                            ENDIF
 
                            il_jmin=MAX(jj-il_radius,1)
                            il_jmax=MIN(jj+il_radius,il_shape(2))
+                           ! coef indices to be used
+                           il_j1 = il_radius-(jj-il_jmin)+1
+                           il_j2 = il_radius+(il_jmax-jj)+1
                            IF( il_dim(2) == 1 )THEN
                               il_jmin=jj
                               il_jmax=jj
+                              ! coef indices to be used
+                              il_j1 = 1
+                              il_j2 = 1
                            ENDIF
 
                            il_kmin=MAX(jk-il_radius,1)
                            il_kmax=MIN(jk+il_radius,il_shape(3))
+                           ! coef indices to be used
+                           il_k1 = il_radius-(jk-il_kmin)+1
+                           il_k2 = il_radius+(il_kmax-jk)+1
                            IF( il_dim(3) == 1 )THEN
                               il_kmin=jk
                               il_kmax=jk
+                              ! coef indices to be used
+                              il_k1 = 1
+                              il_k2 = 1
                            ENDIF
 
@@ -925,8 +748,76 @@
                            &            il_kmin:il_kmax, &
                            &            jl), dd_fill, il_radius, &
-                           &  dl_coef(:,:,:) )
+                           &  dl_coef(il_i1:il_i2, &
+                           &          il_j1:il_j2, &
+                           &          il_k1:il_k2) )
 
                            IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
                               il_detect(ji,jj,jk)= 0
+                              ll_iter=.FALSE.
+                           ENDIF
+
+                        ENDIF
+
+                     ENDDO
+                  ENDDO
+                  ! from South East(il_shape(1),il_shape(2)) to North West(1,1)
+                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
+                  DO jj=il_shape(2),1,-1
+                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE
+                     DO ji=il_shape(1),1,-1
+
+                        IF( il_detect(ji,jj,jk) == 1 )THEN
+                           
+                           il_imin=MAX(ji-il_radius,1)
+                           il_imax=MIN(ji+il_radius,il_shape(1))
+                           ! coef indices to be used
+                           il_i1 = il_radius-(ji-il_imin)+1
+                           il_i2 = il_radius+(il_imax-ji)+1
+                           IF( il_dim(1) == 1 )THEN
+                              il_imin=ji
+                              il_imax=ji
+                              ! coef indices to be used
+                              il_i1 = 1
+                              il_i2 = 1
+                           ENDIF
+
+                           il_jmin=MAX(jj-il_radius,1)
+                           il_jmax=MIN(jj+il_radius,il_shape(2))
+                           ! coef indices to be used
+                           il_j1 = il_radius-(jj-il_jmin)+1
+                           il_j2 = il_radius+(il_jmax-jj)+1
+                           IF( il_dim(2) == 1 )THEN
+                              il_jmin=jj
+                              il_jmax=jj
+                              ! coef indices to be used
+                              il_j1 = 1
+                              il_j2 = 1
+                           ENDIF
+
+                           il_kmin=MAX(jk-il_radius,1)
+                           il_kmax=MIN(jk+il_radius,il_shape(3))
+                           ! coef indices to be used
+                           il_k1 = il_radius-(jk-il_kmin)+1
+                           il_k2 = il_radius+(il_kmax-jk)+1
+                           IF( il_dim(3) == 1 )THEN
+                              il_kmin=jk
+                              il_kmax=jk
+                              ! coef indices to be used
+                              il_k1 = 1
+                              il_k2 = 1
+                           ENDIF
+
+                           dd_value(ji,jj,jk,jl)=extrap__3D_dist_weight_fill( &
+                           &  dd_value( il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax, &
+                           &            jl), dd_fill, il_radius, &
+                           &  dl_coef(il_i1:il_i2, &
+                           &          il_j1:il_j2, &
+                           &          il_k1:il_k2) )
+
+                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
+                              il_detect(ji,jj,jk)= 0
+                              ll_iter=.FALSE.
                            ENDIF
 
@@ -936,7 +827,10 @@
                   ENDDO
                ENDDO
-
+               CALL logger_info(" EXTRAP 3D: "//&
+               &              TRIM(fct_str(SUM(il_detect(:,:,:))))//&
+               &              " point(s) to extrapolate " )
+            
                DEALLOCATE( dl_coef )
-               il_iter=il_iter+1
+               IF( ll_iter ) il_iter=il_iter+1
             ENDDO
          ENDDO            
@@ -946,546 +840,4 @@
 
    END SUBROUTINE extrap__3D
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This function compute derivative of 1D array.
-   !> 
-   !> @details 
-   !> optionaly you could specify to take into account east west discontinuity
-   !> (-180° 180° or 0° 360° for longitude variable)
-   !>
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
-   !> @param[in] dd_value     1D array of variable to be extrapolated
-   !> @param[in] dd_fill      FillValue of variable
-   !> @param[in] ld_discont   logical to take into account east west discontinuity 
-   !-------------------------------------------------------------------
-   PURE FUNCTION extrap_deriv_1D( dd_value, dd_fill, ld_discont )
-
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp)   , DIMENSION(:), INTENT(IN) :: dd_value
-      REAL(dp)                 , INTENT(IN) :: dd_fill
-      LOGICAL                  , INTENT(IN), OPTIONAL :: ld_discont
-
-      ! function
-      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1) ) :: extrap_deriv_1D
-
-      ! local variable
-      INTEGER(i4)                            :: il_imin
-      INTEGER(i4)                            :: il_imax
-      INTEGER(i4), DIMENSION(1)              :: il_shape
-
-      REAL(dp)                               :: dl_min
-      REAL(dp)                               :: dl_max
-      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value
-
-      LOGICAL                                :: ll_discont
-
-      ! loop indices
-      INTEGER(i4) :: ji
-
-      INTEGER(i4) :: i1
-      INTEGER(i4) :: i2
-      !----------------------------------------------------------------
-      ! init
-      extrap_deriv_1D(:)=dd_fill
-
-      ll_discont=.FALSE.
-      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
-
-      il_shape(:)=SHAPE(dd_value(:))
-
-      ALLOCATE( dl_value(3))
-
-      ! compute derivative in i-direction
-      DO ji=1,il_shape(1)
-         
-            il_imin=MAX(ji-1,1)
-            il_imax=MIN(ji+1,il_shape(1))
-
-            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
-               i1=1  ; i2=3
-            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
-               i1=1  ; i2=2
-            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
-               i1=2  ; i2=3
-            ENDIF
-
-            dl_value(i1:i2)=dd_value(il_imin:il_imax)
-            IF( il_imin == 1 )THEN
-               dl_value(:)=EOSHIFT( dl_value(:), &
-               &                    DIM=1,         &
-               &                    SHIFT=-1,      &
-               &                    BOUNDARY=dl_value(1) )
-            ENDIF
-            IF( il_imax == il_shape(1) )THEN
-               dl_value(:)=EOSHIFT( dl_value(:), &
-               &                    DIM=1,         &
-               &                    SHIFT=1,       &
-               &                    BOUNDARY=dl_value(3))
-            ENDIF
-
-            IF( ll_discont )THEN
-               dl_min=MINVAL( dl_value(:), dl_value(:)/=dd_fill )
-               dl_max=MAXVAL( dl_value(:), dl_value(:)/=dd_fill )
-               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
-                  WHERE( dl_value(:) < 0._dp ) 
-                     dl_value(:) = dl_value(:)+360._dp
-                  END WHERE
-               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
-                  WHERE( dl_value(:) > 180._dp ) 
-                     dl_value(:) = dl_value(:)-180._dp
-                  END WHERE
-               ENDIF
-            ENDIF
-
-         IF( dl_value( 2) /= dd_fill .AND. & ! ji
-         &   dl_value( 3) /= dd_fill .AND. & ! ji+1
-         &   dl_value( 1) /= dd_fill )THEN   ! ji-1
-
-            extrap_deriv_1D(ji)=&
-            &  ( dl_value(3) - dl_value(1) ) / &
-            &  REAL( il_imax-il_imin ,dp)
-
-         ENDIF
-
-      ENDDO
-
-      DEALLOCATE( dl_value )
-
-   END FUNCTION extrap_deriv_1D
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This function compute derivative of 2D array.
-   !> you have to specify in which direction derivative have to be computed:
-   !> first (I) or second (J) dimension. 
-   !>
-   !> @details 
-   !> optionaly you could specify to take into account east west discontinuity
-   !> (-180° 180° or 0° 360° for longitude variable)
-   !>
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
-   !> @param[in] dd_value     2D array of variable to be extrapolated
-   !> @param[in] dd_fill      FillValue of variable
-   !> @param[in] cd_dim       compute derivative on first (I) or second (J) dimension 
-   !> @param[in] ld_discont   logical to take into account east west discontinuity 
-   !-------------------------------------------------------------------
-   FUNCTION extrap_deriv_2D( dd_value, dd_fill, cd_dim, ld_discont )
-
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_value
-      REAL(dp)                   , INTENT(IN) :: dd_fill
-      CHARACTER(LEN=*)           , INTENT(IN) :: cd_dim
-      LOGICAL                    , INTENT(IN), OPTIONAL :: ld_discont
-
-      ! function
-      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), &
-      &                   SIZE(dd_value,DIM=2) ) :: extrap_deriv_2D
-
-      ! local variable
-      INTEGER(i4)                              :: il_imin
-      INTEGER(i4)                              :: il_imax
-      INTEGER(i4)                              :: il_jmin
-      INTEGER(i4)                              :: il_jmax
-      INTEGER(i4), DIMENSION(2)                :: il_shape
-
-      REAL(dp)                                 :: dl_min
-      REAL(dp)                                 :: dl_max
-      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_value
-
-      LOGICAL                                  :: ll_discont
-
-      ! loop indices
-      INTEGER(i4) :: ji
-      INTEGER(i4) :: jj
-
-      INTEGER(i4) :: i1
-      INTEGER(i4) :: i2
-
-      INTEGER(i4) :: j1
-      INTEGER(i4) :: j2
-      !----------------------------------------------------------------
-      ! init
-      extrap_deriv_2D(:,:)=dd_fill
-
-      ll_discont=.FALSE.
-      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
-
-      il_shape(:)=SHAPE(dd_value(:,:))
-
-      SELECT CASE(TRIM(fct_upper(cd_dim)))
-
-      CASE('I')
-
-         ALLOCATE( dl_value(3,il_shape(2)) )
-         ! compute derivative in i-direction
-         DO ji=1,il_shape(1)
-
-            ! init
-            dl_value(:,:)=dd_fill
-            
-            il_imin=MAX(ji-1,1)
-            il_imax=MIN(ji+1,il_shape(1))
-
-            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
-               i1=1  ; i2=3
-            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
-               i1=1  ; i2=2
-            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
-               i1=2  ; i2=3
-            ENDIF
-
-            dl_value(i1:i2,:)=dd_value(il_imin:il_imax,:)
-            IF( il_imin == 1 )THEN
-               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
-               &                      DIM=1,         &
-               &                      SHIFT=-1,      &
-               &                      BOUNDARY=dl_value(1,:) )
-            ENDIF
-            IF( il_imax == il_shape(1) )THEN
-               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
-               &                      DIM=1,         &
-               &                      SHIFT=1,       &
-               &                      BOUNDARY=dl_value(3,:))
-            ENDIF
-
-            IF( ll_discont )THEN
-               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
-               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
-               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
-                  WHERE( dl_value(:,:) < 0_dp ) 
-                     dl_value(:,:) = dl_value(:,:)+360._dp
-                  END WHERE
-               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
-                  WHERE( dl_value(:,:) > 180 ) 
-                     dl_value(:,:) = dl_value(:,:)-180._dp
-                  END WHERE
-               ENDIF
-            ENDIF
-            
-            WHERE( dl_value(2,:) /= dd_fill .AND. &  ! ji
-            &      dl_value(3,:) /= dd_fill .AND. &  ! ji+1
-            &      dl_value(1,:) /= dd_fill )        ! ji-1
-
-               extrap_deriv_2D(ji,:)=&
-               &  ( dl_value(3,:) - dl_value(1,:) ) / &
-               &    REAL( il_imax-il_imin,dp)
-
-            END WHERE
-
-         ENDDO
-
-      CASE('J')
-
-         ALLOCATE( dl_value(il_shape(1),3) )
-         ! compute derivative in j-direction
-         DO jj=1,il_shape(2)
-         
-            il_jmin=MAX(jj-1,1)
-            il_jmax=MIN(jj+1,il_shape(2))
-
-            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN
-               j1=1  ; j2=3
-            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN
-               j1=1  ; j2=2
-            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN
-               j1=2  ; j2=3
-            ENDIF
-
-            dl_value(:,j1:j2)=dd_value(:,il_jmin:il_jmax)
-            IF( il_jmin == 1 )THEN
-               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
-               &                      DIM=2,         &
-               &                      SHIFT=-1,      &
-               &                      BOUNDARY=dl_value(:,1))
-            ENDIF
-            IF( il_jmax == il_shape(2) )THEN
-               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
-               &                      DIM=2,         &
-               &                      SHIFT=1,       &
-               &                      BOUNDARY=dl_value(:,3))
-            ENDIF
-
-            IF( ll_discont )THEN
-               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
-               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
-               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
-                  WHERE( dl_value(:,:) < 0_dp ) 
-                     dl_value(:,:) = dl_value(:,:)+360._dp
-                  END WHERE
-               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
-                  WHERE( dl_value(:,:) > 180 ) 
-                     dl_value(:,:) = dl_value(:,:)-180._dp
-                  END WHERE
-               ENDIF
-            ENDIF
-
-            WHERE( dl_value(:, 2) /= dd_fill .AND. & ! jj
-            &      dl_value(:, 3) /= dd_fill .AND. & ! jj+1
-            &      dl_value(:, 1) /= dd_fill )       ! jj-1
-
-               extrap_deriv_2D(:,jj)=&
-               &  ( dl_value(:,3) - dl_value(:,1) ) / &
-               &   REAL(il_jmax-il_jmin,dp)         
-
-            END WHERE
-
-         ENDDO
-         
-      END SELECT
-
-      DEALLOCATE( dl_value )
-
-   END FUNCTION extrap_deriv_2D
-   !-------------------------------------------------------------------
-   !> @brief
-   !> This function compute derivative of 3D array.
-   !> you have to specify in which direction derivative have to be computed:
-   !> first (I), second (J) or third (K) dimension.
-   !> 
-   !> @details 
-   !> optionaly you could specify to take into account east west discontinuity
-   !> (-180° 180° or 0° 360° for longitude variable)
-   !>
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
-   !> @param[inout] dd_value  3D array of variable to be extrapolated
-   !> @param[in] dd_fill      FillValue of variable
-   !> @param[in] cd_dim       compute derivative on first (I) second (J) or third (K) dimension   
-   !> @param[in] ld_discont   logical to take into account east west discontinuity
-   !-------------------------------------------------------------------
-   PURE FUNCTION extrap_deriv_3D( dd_value, dd_fill, cd_dim, ld_discont )
-
-      IMPLICIT NONE
-      ! Argument
-      REAL(dp)        , DIMENSION(:,:,:), INTENT(IN) :: dd_value
-      REAL(dp)                          , INTENT(IN) :: dd_fill
-      CHARACTER(LEN=*)                  , INTENT(IN) :: cd_dim
-      LOGICAL                           , INTENT(IN), OPTIONAL :: ld_discont
-
-      ! function
-      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), &
-      &                   SIZE(dd_value,DIM=2), &
-      &                   SIZE(dd_value,DIM=3)) :: extrap_deriv_3D
-
-      ! local variable
-      INTEGER(i4)                                :: il_imin
-      INTEGER(i4)                                :: il_imax
-      INTEGER(i4)                                :: il_jmin
-      INTEGER(i4)                                :: il_jmax
-      INTEGER(i4)                                :: il_kmin
-      INTEGER(i4)                                :: il_kmax
-      INTEGER(i4), DIMENSION(3)                  :: il_shape
-
-      REAL(dp)                                   :: dl_min
-      REAL(dp)                                   :: dl_max
-      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_value
-
-      LOGICAL                                    :: ll_discont
-
-      ! loop indices
-      INTEGER(i4) :: ji
-      INTEGER(i4) :: jj
-      INTEGER(i4) :: jk
-
-      INTEGER(i4) :: i1
-      INTEGER(i4) :: i2
-
-      INTEGER(i4) :: j1
-      INTEGER(i4) :: j2
-      
-      INTEGER(i4) :: k1
-      INTEGER(i4) :: k2      
-      !----------------------------------------------------------------
-      ! init
-      extrap_deriv_3D(:,:,:)=dd_fill
-
-      ll_discont=.FALSE.
-      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
-
-      il_shape(:)=SHAPE(dd_value(:,:,:))
-
-
-      SELECT CASE(TRIM(fct_upper(cd_dim)))
-
-      CASE('I')
-
-         ALLOCATE( dl_value(3,il_shape(2),il_shape(3)) )
-         ! compute derivative in i-direction
-         DO ji=1,il_shape(1)
-            
-            il_imin=MAX(ji-1,1)
-            il_imax=MIN(ji+1,il_shape(1))
-
-            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
-               i1=1  ; i2=3
-            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
-               i1=1  ; i2=2
-            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
-               i1=2  ; i2=3
-            ENDIF
-
-            dl_value(i1:i2,:,:)=dd_value(il_imin:il_imax,:,:)
-            IF( il_imin == 1 )THEN
-               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
-               &                      DIM=1,         &
-               &                      SHIFT=-1,      &
-               &                      BOUNDARY=dl_value(1,:,:) )
-            ENDIF
-            IF( il_imax == il_shape(1) )THEN
-               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
-               &                      DIM=1,         &
-               &                      SHIFT=1,       &
-               &                      BOUNDARY=dl_value(3,:,:))
-            ENDIF
-
-            IF( ll_discont )THEN
-               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
-               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
-               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
-                  WHERE( dl_value(:,:,:) < 0_dp ) 
-                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
-                  END WHERE
-               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
-                  WHERE( dl_value(:,:,:) > 180 ) 
-                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
-                  END WHERE
-               ENDIF
-            ENDIF
-
-            WHERE( dl_value(2,:,:) /= dd_fill .AND. & ! ji
-            &      dl_value(3,:,:) /= dd_fill .AND. & !ji+1 
-            &      dl_value(1,:,:) /= dd_fill )       !ji-1
-
-               extrap_deriv_3D(ji,:,:)= &
-               &  ( dl_value(3,:,:) - dl_value(1,:,:) ) / &
-               &  REAL( il_imax-il_imin ,dp)
-
-            END WHERE
-
-         ENDDO
-
-      CASE('J')
-
-         ALLOCATE( dl_value(il_shape(1),3,il_shape(3)) )
-         ! compute derivative in j-direction
-         DO jj=1,il_shape(2)
-         
-            il_jmin=MAX(jj-1,1)
-            il_jmax=MIN(jj+1,il_shape(2))
-
-            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN
-               j1=1  ; j2=3
-            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN
-               j1=1  ; j2=2
-            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN
-               j1=2  ; j2=3
-            ENDIF
-
-            dl_value(:,j1:j2,:)=dd_value(:,il_jmin:il_jmax,:)
-            IF( il_jmin == 1 )THEN
-               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
-               &                      DIM=2,         &
-               &                      SHIFT=-1,      &
-               &                      BOUNDARY=dl_value(:,1,:) )
-            ENDIF
-            IF( il_jmax == il_shape(2) )THEN
-               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
-               &                      DIM=2,         &
-               &                      SHIFT=1,       &
-               &                      BOUNDARY=dl_value(:,3,:))
-            ENDIF
-
-            IF( ll_discont )THEN
-               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
-               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
-               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
-                  WHERE( dl_value(:,:,:) < 0_dp ) 
-                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
-                  END WHERE
-               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
-                  WHERE( dl_value(:,:,:) > 180 ) 
-                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
-                  END WHERE
-               ENDIF
-            ENDIF
-
-            WHERE( dl_value(:, 2,:) /= dd_fill .AND. & ! jj
-               &   dl_value(:, 3,:) /= dd_fill .AND. & ! jj+1
-            &      dl_value(:, 1,:) /= dd_fill )       ! jj-1
-
-               extrap_deriv_3D(:,jj,:)=&
-               &  ( dl_value(:,3,:) - dl_value(:,1,:) ) / &
-               &  REAL( il_jmax - il_jmin ,dp)         
-
-            END WHERE
-
-         ENDDO
-         
-      CASE('K')
-         ! compute derivative in k-direction
-         DO jk=1,il_shape(3)
-
-            il_kmin=MAX(jk-1,1)
-            il_kmax=MIN(jk+1,il_shape(3))
-
-            IF( il_kmin==jk-1 .AND. il_kmax==jk+1 )THEN
-               k1=1  ; k2=3
-            ELSEIF( il_kmin==jk .AND. il_kmax==jk+1 )THEN
-               k1=1  ; k2=2
-            ELSEIF( il_kmin==jk-1 .AND. il_kmax==jk )THEN
-               k1=2  ; k2=3
-            ENDIF
-
-            dl_value(:,:,k1:k2)=dd_value(:,:,il_kmin:il_kmax)
-            IF( il_kmin == 1 )THEN
-               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
-               &                      DIM=3,         &
-               &                      SHIFT=-1,      &
-               &                      BOUNDARY=dl_value(:,:,1) )
-            ENDIF
-            IF( il_kmax == il_shape(3) )THEN
-               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
-               &                        DIM=3,         &
-               &                        SHIFT=1,       &
-               &                        BOUNDARY=dl_value(:,:,3))
-            ENDIF
-
-            IF( ll_discont )THEN
-               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
-               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
-               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
-                  WHERE( dl_value(:,:,:) < 0_dp ) 
-                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
-                  END WHERE
-               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
-                  WHERE( dl_value(:,:,:) > 180 ) 
-                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
-                  END WHERE
-               ENDIF
-            ENDIF         
-
-            WHERE( dl_value(:,:, 2) /= dd_fill .AND. & ! jk
-               &   dl_value(:,:, 3) /= dd_fill .AND. & ! jk+1
-               &   dl_value(:,:, 1) /= dd_fill )       ! jk-1
-
-               extrap_deriv_3D(:,:,jk)=&
-               &  ( dl_value(:,:,3) - dl_value(:,:,1) ) / &
-               &  REAL( il_kmax-il_kmin,dp)         
-
-            END WHERE
-
-         ENDDO
-
-      END SELECT
-
-      DEALLOCATE( dl_value )
-
-   END FUNCTION extrap_deriv_3D
    !-------------------------------------------------------------------
    !> @brief
@@ -1493,9 +845,11 @@
    !> 
    !> @details 
-   !> coefficients are  "grid distance" to the center of the box choosed to compute
-   !> extrapolation.
+   !> coefficients are  "grid distance" to the center of the box 
+   !> choosed to compute extrapolation.
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - decrease weight of third dimension
    !
    !> @param[in] dd_value  3D array of variable to be extrapolated
@@ -1544,7 +898,8 @@
 
                ! compute distance
+               ! "vertical weight" is lower than horizontal 
                dl_dist(ji,jj,jk) = (ji-il_imid)**2 + &
                &                   (jj-il_jmid)**2 + &
-               &                   (jk-il_kmid)**2
+               &                 3*(jk-il_kmid)**2
 
                IF( dl_dist(ji,jj,jk) /= 0 )THEN
@@ -1569,5 +924,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] dd_value  3D array of variable to be extrapolated
@@ -1658,5 +1013,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - decrease weight of third dimension
    !
    !> @param[in] dd_value  3D array of variable to be extrapolated
@@ -1705,7 +1062,8 @@
 
                ! compute distance
+               ! "vertical weight" is lower than horizontal 
                dl_dist(ji,jj,jk) = (ji-il_imid)**2 + &
                &                   (jj-il_jmid)**2 + &
-               &                   (jk-il_kmid)**2
+               &                 3*(jk-il_kmid)**2
 
                IF( dl_dist(ji,jj,jk) /= 0 )THEN
@@ -1732,5 +1090,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_value  3D array of variable to be extrapolated
@@ -1763,5 +1121,4 @@
       INTEGER(i4) :: jj
       INTEGER(i4) :: jk
-
       !----------------------------------------------------------------
 
@@ -1793,4 +1150,5 @@
             ENDDO
          ENDDO
+
 
          ! return value
@@ -1815,5 +1173,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013-Initial version
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_var variable 
@@ -1917,5 +1275,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013-Initial version
+   !> @date November, 2013 - Initial version
    !>
    !> @param[inout] td_var variable 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/file.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/file.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/file.f90	(revision 5682)
@@ -137,6 +137,7 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date November, 2013- Initial Version
-!> @date November, 2014 - Fix memory leaks bug
+!> @date November, 2013 - Initial Version
+!> @date November, 2014 
+!> - Fix memory leaks bug
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -288,7 +289,7 @@
    !>   
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date November, 2014
-   !>    - use function instead of overload assignment operator 
+   !> - use function instead of overload assignment operator 
    !> (to avoid memory leak)
    !
@@ -409,7 +410,7 @@
    !>   
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date November, 2014
-   !>    - use function instead of overload assignment operator 
+   !> - use function instead of overload assignment operator 
    !> (to avoid memory leak)
    !
@@ -448,5 +449,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_file   file name
@@ -553,5 +554,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_file   file name
@@ -589,5 +590,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -604,6 +605,7 @@
       CHARACTER(LEN=lc) :: cl_dim
       LOGICAL           :: ll_error
-
-      INTEGER(i4) :: il_ind
+      LOGICAL           :: ll_warn 
+
+      INTEGER(i4)       :: il_ind
 
       ! loop indices
@@ -614,4 +616,5 @@
       ! check used dimension 
       ll_error=.FALSE.
+      ll_warn=.FALSE.
       DO ji=1,ip_maxdim
          il_ind=dim_get_index( td_file%t_dim(:), &
@@ -619,21 +622,18 @@
          &                     TRIM(td_var%t_dim(ji)%c_sname))
          IF( il_ind /= 0 )THEN
-         IF( td_var%t_dim(ji)%l_use  .AND. &
-         &   td_file%t_dim(il_ind)%l_use .AND. &
-         &   td_var%t_dim(ji)%i_len /= td_file%t_dim(il_ind)%i_len )THEN
-            ll_error=.TRUE.
-         ENDIF
+            IF( td_var%t_dim(ji)%l_use  .AND. &
+            &   td_file%t_dim(il_ind)%l_use .AND. &
+            &   td_var%t_dim(ji)%i_len /= td_file%t_dim(il_ind)%i_len )THEN
+               IF( INDEX( TRIM(td_var%c_axis), &
+               &          TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN
+                  ll_warn=.TRUE.
+               ELSE
+                  ll_error=.TRUE.
+               ENDIF
+            ENDIF
          ENDIF
       ENDDO
 
       IF( ll_error )THEN
-
-         file_check_var_dim=.FALSE.
-
-         CALL logger_error( &
-         &  " FILE CHECK VAR DIM: variable and file dimension differ"//&
-         &  " for variable "//TRIM(td_var%c_name)//&
-         &  " and file "//TRIM(td_file%c_name))
-
 
          cl_dim='(/'
@@ -659,4 +659,17 @@
          CALL logger_debug( " variable dimension: "//TRIM(cl_dim) )
 
+         file_check_var_dim=.FALSE.
+
+         CALL logger_error( &
+         &  " FILE CHECK VAR DIM: variable and file dimension differ"//&
+         &  " for variable "//TRIM(td_var%c_name)//&
+         &  " and file "//TRIM(td_file%c_name))
+
+      ELSEIF( ll_warn )THEN
+         CALL logger_warn( &
+         &  " FILE CHECK VAR DIM: variable and file dimension differ"//&
+         &  " for variable "//TRIM(td_var%c_name)//&
+         &  " and file "//TRIM(td_file%c_name)//". you should use"//&
+         &  " var_check_dim to remove useless dimension.")
       ELSE
 
@@ -679,5 +692,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - add dimension to file if need be
@@ -707,7 +720,7 @@
       IF( TRIM(td_file%c_name) == '' )THEN
 
-         CALL logger_error( " FILE ADD VAR: structure file unknown" )
          CALL logger_debug( " FILE ADD VAR: you should have used file_init before "//&
          & "running file_add_var" )
+         CALL logger_error( " FILE ADD VAR: structure file unknown" )
 
       ELSE
@@ -723,5 +736,6 @@
                &                                       td_var%c_stdname )
             ENDIF
-
+            CALL logger_debug( &
+            &  " FILE ADD VAR: ind "//TRIM(fct_str(il_ind)) )
             IF( il_ind /= 0 )THEN
 
@@ -739,5 +753,5 @@
             ELSE
 
-               CALL logger_trace( &
+               CALL logger_debug( &
                &  " FILE ADD VAR: add variable "//TRIM(td_var%c_name)//&
                &  ", standard name "//TRIM(td_var%c_stdname)//&
@@ -770,6 +784,4 @@
                         !il_rec=td_file%t_dim(3)%i_len
                   END SELECT
-                  CALL logger_info( &
-                     &  " FILE ADD VAR: variable index "//TRIM(fct_str(il_ind)))
 
                   IF( td_file%i_nvar > 0 )THEN
@@ -806,5 +818,5 @@
                         ENDIF
 
-                        IF( il_ind < td_file%i_nvar )THEN
+                        IF( il_ind < td_file%i_nvar+1 )THEN
                            ! variable with more dimension than new variable
                            td_file%t_var( il_ind+1 : td_file%i_nvar+1 ) = &
@@ -893,5 +905,7 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - define local variable structure to avoid mistake with pointer
    !
    !> @param[inout] td_file   file structure
@@ -907,4 +921,5 @@
       ! local variable
       INTEGER(i4)       :: il_ind
+      TYPE(TVAR)        :: tl_var
       !----------------------------------------------------------------
 
@@ -928,9 +943,10 @@
             IF( il_ind /= 0 )THEN
    
-               CALL file_del_var(td_file, td_file%t_var(il_ind))
+               tl_var=var_copy(td_file%t_var(il_ind))
+               CALL file_del_var(td_file, tl_var)
 
             ELSE
 
-               CALL logger_warn( &
+               CALL logger_debug( &
                &  " FILE DEL VAR NAME: there is no variable with name or "//&
                &  "standard name "//TRIM(cd_name)//" in file "//&
@@ -953,5 +969,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_file   file structure
@@ -1096,5 +1112,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1131,5 +1147,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1247,5 +1263,8 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - define local attribute structure to avoid mistake
+   !> with pointer
    !
    !> @param[inout] td_file   file structure
@@ -1261,4 +1280,5 @@
       ! local variable
       INTEGER(i4)       :: il_ind
+      TYPE(TATT)        :: tl_att
       !----------------------------------------------------------------
 
@@ -1282,9 +1302,10 @@
             IF( il_ind /= 0 )THEN
    
-               CALL file_del_att(td_file, td_file%t_att(il_ind))
+               tl_att=att_copy(td_file%t_att(il_ind))
+               CALL file_del_att(td_file, tl_att)
 
             ELSE
 
-               CALL logger_warn( &
+               CALL logger_debug( &
                &  " FILE DEL ATT NAME: there is no attribute with name "//&
                &  TRIM(cd_name)//" in file "//TRIM(td_file%c_name))
@@ -1305,5 +1326,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1403,5 +1424,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1444,5 +1465,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - do not reorder dimension, before put in file
@@ -1529,5 +1550,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1609,5 +1630,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1652,5 +1673,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1717,5 +1738,5 @@
          WRITE(*,'(/a)') " File variable"
          DO ji=1,td_file%i_nvar
-            CALL var_print(td_file%t_var(ji))!,.FALSE.)
+            CALL var_print(td_file%t_var(ji),.FALSE.)
          ENDDO
       ENDIF
@@ -1730,5 +1751,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_file   file structure
@@ -1769,5 +1790,10 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - add case to not return date (yyyymmdd) at the end of filename
+   !> @date February, 2015 
+   !> - add case to not return release number
+   !> we assume release number only on one digit (ex : file_v3.5.nc)
    !
    !> @param[in] cd_file   file name (without suffix)
@@ -1803,4 +1829,10 @@
          IF( .NOT. fct_is_num(file__get_number(2:)) )THEN
             file__get_number=''
+         ELSEIF( LEN(TRIM(file__get_number))-1 == 8 )THEN
+            ! date case yyyymmdd
+            file__get_number=''
+         ELSEIF( LEN(TRIM(file__get_number))-1 == 1 )THEN
+            ! release number case 
+            file__get_number=''
          ENDIF
       ELSE
@@ -1816,5 +1848,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1879,5 +1911,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1906,5 +1938,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -2019,5 +2051,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   array of file structure
@@ -2057,5 +2089,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[in] td_file   array of file 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/filter.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/filter.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/filter.f90	(revision 5682)
@@ -18,5 +18,6 @@
 !>          - rad > cutoff : @f$ filter=0 @f$               
 !>       - 'blackman'
-!>          - rad < cutoff : @f$ filter=0.42 + 0.5*COS(\pi*\frac{rad}{cutoff}) + 0.08*COS(2\pi*\frac{rad}{cutoff}) @f$
+!>          - rad < cutoff : @f$ filter=0.42 + 0.5*COS(\pi*\frac{rad}{cutoff}) + 
+!>                                      0.08*COS(2\pi*\frac{rad}{cutoff}) @f$
 !>          - rad > cutoff : @f$ filter=0 @f$
 !>       - 'gauss'
@@ -29,7 +30,10 @@
 !>
 !>    td_var\%c_filter(2) string character is the number of turn to be done<br/>
-!>    td_var\%c_filter(3) string character is the cut-off frequency (count in number of mesh grid)<br/>
-!>    td_var\%c_filter(4) string character is the halo radius (count in number of mesh grid)<br/>
-!>    td_var\%c_filter(5) string character is the alpha parameter (for gauss and butterworth method)<br/>
+!>    td_var\%c_filter(3) string character is the cut-off frequency 
+! >                       (count in number of mesh grid)<br/>
+!>    td_var\%c_filter(4) string character is the halo radius 
+!>                        (count in number of mesh grid)<br/>
+!>    td_var\%c_filter(5) string character is the alpha parameter 
+!>                        (for gauss and butterworth method)<br/>
 !>    
 !>    @note Filter method could be specify for each variable in namelist _namvar_,
@@ -40,5 +44,6 @@
 !>    The number of turn is specify using '*' separator.<br/>
 !>    Example:
-!>       - cn_varinfo='varname1:2*hamming(@f$cutoff@f$,@f$radius@f$)', 'varname2:gauss(@f$cutoff@f$,@f$radius@f$,@f$\alpha@f$)'
+!>       - cn_varinfo='varname1:flt=2*hamming(@f$cutoff@f$,@f$radius@f$)', 
+!>                    'varname2:flt=gauss(@f$cutoff@f$,@f$radius@f$,@f$\alpha@f$)'
 !>
 !>    to filter variable value:<br/>
@@ -106,5 +111,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure 
@@ -250,5 +255,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable 
@@ -296,5 +301,5 @@
 
       !3-extrapolate
-      CALL extrap_fill_value( td_var, id_iext=id_radius, id_jext=id_radius )
+      CALL extrap_fill_value( td_var ) !, id_iext=id_radius, id_jext=id_radius )
 
       !4-filtering
@@ -341,5 +346,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -393,5 +398,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -439,5 +444,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -482,5 +487,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -537,5 +542,5 @@
    !>
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] dd_value  array of value to be filtered 
@@ -590,5 +595,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_name   filter name
@@ -649,5 +654,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_name   filter name
@@ -695,5 +700,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -749,5 +754,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -808,5 +813,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -863,5 +868,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -922,5 +927,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_cutoff cut-off frequency
@@ -978,5 +983,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
@@ -1038,5 +1043,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
@@ -1090,5 +1095,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
@@ -1146,5 +1151,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
@@ -1198,5 +1203,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] dd_cutoff cut-off frequency
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/function.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/function.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/function.f90	(revision 5682)
@@ -51,4 +51,9 @@
 !> @endcode
 !>
+!>  to check if character is real
+!> @code
+!>  ll_is_real=fct_is_real(cd_var)
+!> @endcode
+!>
 !>  to split string into substring and return one of the element:<br/>  
 !> @code
@@ -89,5 +94,6 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
-!> @date September, 2014 - add header
+!> @date September, 2014 
+!> - add header
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -106,4 +112,5 @@
    PUBLIC :: fct_lower    !< convert character from upper to lower case
    PUBLIC :: fct_is_num   !< check if character is numeric
+   PUBLIC :: fct_is_real  !< check if character is real
    PUBLIC :: fct_split    !< split string into substring
    PUBLIC :: fct_basename !< return basename (name without path)
@@ -153,5 +160,5 @@
    ! 
    !> @author J.Paul 
-   !> - September, 2014- Initial Version 
+   !> @date September, 2014 - Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -177,5 +184,5 @@
    ! 
    !> @author J.Paul 
-   !> - September, 2014- Initial Version 
+   !> @date September, 2014 - Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -201,5 +208,5 @@
    ! 
    !> @author J.Paul 
-   !> - Nov, 2013- Initial Version 
+   !> @date November, 2013 - Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -225,5 +232,5 @@
    ! 
    !> @author J.Paul 
-   !> - November, 2013- Initial Version 
+   !> @date November, 2013 - Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -249,5 +256,5 @@
    ! 
    !> @author J.Paul 
-   !> - November, 2013- Initial Version 
+   !> @date November, 2013 - Initial Version 
    ! 
    !> @param[in] cd_char   string character
@@ -273,5 +280,5 @@
    !>
    !> @author J.Paul 
-   !> - November, 2013- Initial Version 
+   !> @date November, 2013 - Initial Version 
    !>
    !> @param[in] cd_char   string character
@@ -297,5 +304,5 @@
    !>
    !> @author J.Paul 
-   !> - November, 2013- Initial Version 
+   !> @date November, 2013 - Initial Version 
    !>
    !> @param[in] cd_char   string character
@@ -321,5 +328,5 @@
    !>
    !> @author J.Paul 
-   !> - November, 2013- Initial Version 
+   !> @date November, 2013 - Initial Version 
    !>
    !> @return file id 
@@ -344,5 +351,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] id_status
@@ -365,5 +372,5 @@
    !
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !>
    !> @param[in] cd_msg optional message to be added
@@ -387,5 +394,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] ld_var logical variable
@@ -409,5 +416,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] bd_var integer(1) variable
@@ -431,5 +438,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] sd_var integer(2) variable
@@ -453,5 +460,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] id_var integer(4) variable
@@ -475,5 +482,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] kd_var integer(8) variable
@@ -497,5 +504,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] rd_var real(4) variable
@@ -519,5 +526,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_var real(8) variable
@@ -544,5 +551,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_arr array of character
@@ -590,5 +597,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_var character
@@ -647,5 +654,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_var character
@@ -697,5 +704,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_var character
@@ -723,4 +730,67 @@
    END FUNCTION fct_is_num
    !-------------------------------------------------------------------
+   !> @brief This function check if character is real number.
+   !
+   !> @details
+   !> it allows exponantial and decimal number
+   !> exemple :  1e6, 2.3
+   !>
+   !> @author J.Paul
+   !> @date June, 2015 - Initial Version
+   !
+   !> @param[in] cd_var character
+   !> @return character is numeric
+   !-------------------------------------------------------------------
+   PURE LOGICAL FUNCTION fct_is_real(cd_var)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_var
+   
+      ! local variables
+      LOGICAL :: ll_exp
+      LOGICAL :: ll_dec
+   
+      ! loop indices
+      INTEGER :: ji
+      !----------------------------------------------------------------
+   
+      ll_exp=.TRUE.
+      ll_dec=.FALSE.
+      DO ji=1,LEN(TRIM(cd_var))
+         IF( IACHAR(cd_var(ji:ji)) >= IACHAR('0') .AND. &
+         &   IACHAR(cd_var(ji:ji)) <= IACHAR('9') )THEN
+   
+            fct_is_real=.TRUE.
+            ll_exp=.FALSE.
+      
+         ELSEIF( TRIM(cd_var(ji:ji))=='e' )THEN
+         
+            IF( ll_exp .OR. ji== LEN(TRIM(cd_var)) )THEN
+               fct_is_real=.FALSE.
+               EXIT
+            ELSE 
+               ll_exp=.TRUE.
+            ENDIF
+   
+         ELSEIF( TRIM(cd_var(ji:ji))=='.' )THEN
+   
+            IF( ll_dec )THEN
+               fct_is_real=.FALSE.
+               EXIT
+            ELSE
+               fct_is_real=.TRUE.
+               ll_dec=.TRUE.
+            ENDIF
+   
+         ELSE
+   
+            fct_is_real=.FALSE.
+            EXIT
+   
+         ENDIF
+      ENDDO
+   
+   END FUNCTION fct_is_real
+   !-------------------------------------------------------------------
    !> @brief This function split string of character 
    !> using separator character, by default '|',
@@ -728,5 +798,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_string string of character
@@ -808,5 +878,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_string string of character
@@ -873,5 +943,5 @@
    !> Optionally you could specify another separator.
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_string filename
@@ -914,5 +984,5 @@
    !> Optionally you could specify another separator.
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_string filename
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/grid.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/grid.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/grid.f90	(revision 5682)
@@ -149,5 +149,5 @@
 !>    CALL grid_check_coincidence(td_coord0, td_coord1, 
 !>                                id_imin0, id_imax0, id_jmin0, id_jmax0
-!>                                [,id_rho])
+!>                                ,id_rho)
 !> @endcode
 !>       - td_coord0 is coarse grid coordinate mpp structure
@@ -161,5 +161,5 @@
 !>       - id_jmax0  is coarse grid upper right corner j-indice of fine grid 
 !> domain 
-!>       - id_rho    is array of refinement factor (default 1)
+!>       - id_rho    is array of refinement factor 
 !>
 !>    to add ghost cell at boundaries:<br/>
@@ -213,4 +213,6 @@
 !> @date October, 2014
 !> - use mpp file structure instead of file
+!> @date February, 2015
+!> - add function grid_fill_small_msk to fill small domain inside bigger one
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -255,4 +257,5 @@
    PUBLIC :: grid_split_domain         !< compute closed sea domain 
    PUBLIC :: grid_fill_small_dom       !< fill small closed sea with fill value 
+   PUBLIC :: grid_fill_small_msk       !< fill small domain inside bigger one 
 
                                      ! get closest coarse grid indices of fine grid domain
@@ -352,5 +355,5 @@
    !> @note need all processor files to be there
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @param[inout] td_file file structure 
@@ -466,7 +469,7 @@
    !> - compute East West overlap
    !>
-   !> @note need all processor files to be there
+   !> @note need all processor files
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @param[in] td_mpp mpp structure 
@@ -496,4 +499,5 @@
       il_ew   =-1
 
+      CALL logger_info("GRID GET INFO: look for "//TRIM(td_mpp%c_name))
       ! copy structure
       tl_mpp=mpp_copy(td_mpp)
@@ -523,9 +527,11 @@
       ENDIF
 
+      CALL logger_info("GRID GET INFO: perio "//TRIM(fct_str(il_perio)))
+
       SELECT CASE(il_perio)
       CASE(3,4)
+         il_pivot=1
+      CASE(5,6)
          il_pivot=0
-      CASE(5,6)
-         il_pivot=1
       CASE(0,1,2)
          il_pivot=1
@@ -534,4 +540,5 @@
       IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
          ! get pivot
+         CALL logger_info("GRID GET INFO: look for pivot ")
          il_pivot=grid_get_pivot(tl_mpp)
       ENDIF
@@ -539,4 +546,5 @@
       IF( il_perio < 0 .OR. il_perio > 6 )THEN
          ! get periodicity
+         CALL logger_info("GRID GET INFO: look for perio ")
          il_perio=grid_get_perio(tl_mpp, il_pivot)
       ENDIF
@@ -544,4 +552,5 @@
       IF( il_ew < 0 )THEN
          ! get periodicity
+         CALL logger_info("GRID GET INFO: look for overlap ")
          il_ew=grid_get_ew_overlap(tl_mpp)
       ENDIF
@@ -595,5 +604,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !> @date September, 2014
    !> - add dummy loop in case variable not over right point.
@@ -708,5 +717,5 @@
    !> 
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -783,5 +792,5 @@
 
          IF( ll_check )THEN
-            CALL logger_info("GRID GET PIVOT: T-pivot")
+            CALL logger_info("GRID GET PIVOT: F-pivot")
             grid__get_pivot_varT=0
          ENDIF
@@ -801,5 +810,5 @@
    !> 
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -876,5 +885,5 @@
 
          IF( ll_check )THEN
-            CALL logger_info("GRID GET PIVOT: T-pivot")
+            CALL logger_info("GRID GET PIVOT: F-pivot")
             grid__get_pivot_varU=0
          ENDIF
@@ -894,5 +903,5 @@
    !> 
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -969,5 +978,5 @@
 
          IF( ll_check )THEN
-            CALL logger_info("GRID GET PIVOT: T-pivot")
+            CALL logger_info("GRID GET PIVOT: F-pivot")
             grid__get_pivot_varV=0
          ENDIF
@@ -987,5 +996,5 @@
    !> 
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] dd_value array of value
@@ -1062,5 +1071,5 @@
 
          IF( ll_check )THEN
-            CALL logger_info("GRID GET PIVOT: T-pivot")
+            CALL logger_info("GRID GET PIVOT: F-pivot")
             grid__get_pivot_varF=0
          ENDIF
@@ -1083,5 +1092,5 @@
    !>
    !> @author J.Paul
-   !> - Ocotber, 2014- Initial version
+   !> @date Ocotber, 2014 - Initial version
    !
    !> @param[in] td_file file structure
@@ -1172,5 +1181,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] td_mpp   mpp file structure
@@ -1277,13 +1286,13 @@
    !> 1: cyclic east-west boundary
    !> 2: symmetric boundary condition across the equator
-   !> 3: North fold boundary (with a F-point pivot)
-   !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary
-   !> 5: North fold boundary (with a T-point pivot)
-   !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary
+   !> 3: North fold boundary (with a T-point pivot)
+   !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary
+   !> 5: North fold boundary (with a F-point pivot)
+   !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary
    !>
    !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
    !>
    !> @author J.Paul
-   !> - November, 2013- Subroutine written
+   !> @date November, 2013 - Initial version
    !> @date October, 2014
    !> - work on variable structure instead of file structure
@@ -1452,5 +1461,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !>
    !> @param[in] td_file   file structure
@@ -1537,13 +1546,13 @@
    !> 1: cyclic east-west boundary
    !> 2: symmetric boundary condition across the equator
-   !> 3: North fold boundary (with a F-point pivot)
-   !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary
-   !> 5: North fold boundary (with a T-point pivot)
-   !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary
+   !> 3: North fold boundary (with a T-point pivot)
+   !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary
+   !> 5: North fold boundary (with a F-point pivot)
+   !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary
    !>
    !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
    !>
    !> @author J.Paul
-   !> - October, 2014 - Initial version
+   !> @date October, 2014 - Initial version
    !
    !> @param[in] td_mpp   mpp file structure
@@ -1634,5 +1643,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -1746,5 +1755,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @param[in] td_file file structure 
@@ -1797,5 +1806,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -1853,5 +1862,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_lat latitude variable structure 
@@ -1890,5 +1899,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -1978,9 +1987,12 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - use grid point to read coordinates variable. 
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
+   !> @date February, 2015
+   !> - use longitude or latitude as standard name, if can not find 
+   !> longitude_T, latitude_T...
    !>
    !> @param[in] td_coord0 coarse grid coordinate mpp structure
@@ -2004,24 +2016,25 @@
 
       ! local variable
-      TYPE(TMPP) :: tl_coord0
-      TYPE(TMPP) :: tl_coord1
-
-      TYPE(TVAR)  :: tl_lon0
-      TYPE(TVAR)  :: tl_lat0
-      TYPE(TVAR)  :: tl_lon1
-      TYPE(TVAR)  :: tl_lat1
-
-      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
-
-      INTEGER(i4), DIMENSION(2,2)         :: il_xghost0
-      INTEGER(i4), DIMENSION(2,2)         :: il_xghost1
-
-      INTEGER(i4) :: il_imin0
-      INTEGER(i4) :: il_imax0
-      INTEGER(i4) :: il_jmin0
-      INTEGER(i4) :: il_jmax0
-
-      CHARACTER(LEN= 1) :: cl_point
-      CHARACTER(LEN=lc) :: cl_name
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
+
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
+
+      INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho
+
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+      TYPE(TVAR)                               :: tl_lon1
+      TYPE(TVAR)                               :: tl_lat1
+
+      TYPE(TMPP)                               :: tl_coord0
+      TYPE(TMPP)                               :: tl_coord1
 
       ! loop indices
@@ -2057,6 +2070,21 @@
          ! read coarse longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
          tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
          tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
          
@@ -2077,6 +2105,21 @@
          ! read fine longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
          tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
+
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
          tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
  
@@ -2127,9 +2170,12 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - use grid point to read coordinates variable.
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
+   !> @date February, 2015
+   !> - use longitude or latitude as standard name, if can not find 
+   !> longitude_T, latitude_T...
    !>
    !> @param[in] td_longitude0   coarse grid longitude
@@ -2154,15 +2200,17 @@
 
       ! local variable
-      TYPE(TMPP)  :: tl_coord1
-
-      TYPE(TVAR)  :: tl_lon1
-      TYPE(TVAR)  :: tl_lat1
-
-      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
-
-      INTEGER(i4), DIMENSION(2,2)       :: il_xghost
-
-      CHARACTER(LEN= 1) :: cl_point
-      CHARACTER(LEN=lc) :: cl_name
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      INTEGER(i4)                              :: il_ind
+
+      INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho
+
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost
+
+      TYPE(TVAR)                               :: tl_lon1
+      TYPE(TVAR)                               :: tl_lat1
+
+      TYPE(TMPP)                               :: tl_coord1
 
       ! loop indices
@@ -2209,6 +2257,21 @@
          ! read fine longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
          tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
          tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
          
@@ -2244,9 +2307,12 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - use grid point to read coordinates variable.
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
+   !> @date February, 2015
+   !> - use longitude or latitude as standard name, if can not find 
+   !> longitude_T, latitude_T...
    !> 
    !> @param[in] td_coord0 coarse grid coordinate mpp structure
@@ -2271,20 +2337,21 @@
 
       ! local variable
-      TYPE(TMPP)  :: tl_coord0
-
-      TYPE(TVAR)  :: tl_lon0
-      TYPE(TVAR)  :: tl_lat0
-
-      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
-
-      INTEGER(i4), DIMENSION(2,2)       :: il_xghost
-
-      INTEGER(i4) :: il_imin0
-      INTEGER(i4) :: il_imax0
-      INTEGER(i4) :: il_jmin0
-      INTEGER(i4) :: il_jmax0
-
-      CHARACTER(LEN= 1) :: cl_point
-      CHARACTER(LEN=lc) :: cl_name      
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name      
+
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
+
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost
+
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+
+      TYPE(TMPP)                               :: tl_coord0
 
       ! loop indices
@@ -2330,6 +2397,21 @@
          ! read coarse longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
          tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+         
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
          tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
 
@@ -2377,5 +2459,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - check grid point
@@ -2520,5 +2602,5 @@
             CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
             CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
-            
+ 
             ! "global" coarse grid indice
             il_imin0=1
@@ -2568,4 +2650,10 @@
             IF( dl_lon1_ll == tl_lon1%d_fill .OR. &
             &   dl_lat1_ll == tl_lat1%d_fill )THEN
+               CALL logger_debug("GRID GET COARSE INDEX: lon "//&
+               &  TRIM(fct_str(dl_lon1_ll))//" "//&
+               &  TRIM(fct_str(tl_lon1%d_fill)) )
+               CALL logger_debug("GRID GET COARSE INDEX: lat "//&
+               &  TRIM(fct_str(dl_lat1_ll))//" "//&
+               &  TRIM(fct_str(tl_lat1%d_fill)) )
                CALL logger_error("GRID GET COARSE INDEX: lower left corner "//&
                &                 "point is FillValue. remove ghost cell "//&
@@ -2632,5 +2720,4 @@
             ji = il_iul(1)
             jj = il_iul(2)
-
             IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ul) > dp_delta )THEN
                IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ul )THEN
@@ -2647,5 +2734,4 @@
                ENDIF
             ENDIF
-
             IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ul) > dp_delta )THEN
                IF(tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ul )THEN
@@ -2798,5 +2884,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_lon longitude structure 
@@ -2866,5 +2952,6 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 - change dichotomy method to manage ORCA grid
    !
    !> @param[in] dd_lon0   coarse grid array of longitude
@@ -2872,8 +2959,8 @@
    !> @param[in] dd_lon1   fine   grid longitude
    !> @param[in] dd_lat1   fine   grid latitude
+   !> @param[in] dd_fill   fill value
    !> @return coarse grid indices of closest point of fine grid point
-   !>
-   !-------------------------------------------------------------------
-   FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1  )
+   !-------------------------------------------------------------------
+   FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, dd_fill )
       IMPLICIT NONE
       ! Argument
@@ -2882,4 +2969,5 @@
       REAL(dp),                 INTENT(IN) :: dd_lon1
       REAL(dp),                 INTENT(IN) :: dd_lat1
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
 
       ! function
@@ -2929,46 +3017,71 @@
 
       ll_north=.FALSE.
-      ll_continue=.TRUE.
-
-      ! look for meridian 0°/360°
-      il_jmid = il_jinf + INT(il_shape(2)/2)
-      il_ind(:) = MAXLOC( dl_lon0(:,il_jmid), dl_lon0(:,il_jmid) <= 360._dp )
-
-      il_imid=il_ind(1)
-
-      IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. &
-      &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN
-
-         il_iinf = il_imid ;  il_isup = il_imid
-         il_jinf = il_jmid ;  il_jsup = il_jmid
-
-         ll_continue=.FALSE.
-
-      ELSE
-         IF( dl_lon1 < dl_lon0(il_isup,il_jmid) .AND. &
-         &   il_imid /= il_isup )THEN
-
-            ! point east
-            il_iinf = il_imid
-      
-         ELSE IF( dl_lon1 > dl_lon0(il_iinf,il_jmid) .AND. &
-         &        il_imid /= il_iinf )THEN
-
-            ! point west
-            il_isup = il_imid
-
-         ENDIF
+      ll_continue=.FALSE.
+
+      ! avoid to use fillvalue for reduce domain on first time
+      IF( PRESENT(dd_fill) )THEN
+         DO WHILE( ALL(dl_lon0(il_isup,:) == dd_fill) )
+            il_isup=il_isup-1
+         ENDDO
+         DO WHILE( ALL(dl_lon0(il_iinf,:) == dd_fill) )
+            il_iinf=il_iinf+1
+         ENDDO
+         DO WHILE( ALL(dd_lat0(:,il_jsup) == dd_fill) )
+            il_jsup=il_jsup-1
+         ENDDO
+         DO WHILE( ALL(dd_lat0(:,il_jinf) == dd_fill) )
+            il_jinf=il_jinf+1
+         ENDDO
 
          il_shape(1)= il_isup - il_iinf + 1
          il_shape(2)= il_jsup - il_jinf + 1
 
-         il_imid = il_iinf + INT(il_shape(1)/2) 
+      ENDIF
+
+      ! special case for north ORCA grid
+      IF( dd_lat1 > 19. .AND. dl_lon1 < 74.  )THEN
+         ll_north=.TRUE.
+      ENDIF
+
+      IF( .NOT. ll_north )THEN
+         ! look for meridian 0°/360°
          il_jmid = il_jinf + INT(il_shape(2)/2)
-
-         ! exit if too close from north fold (safer)
-         IF( dd_lat0(il_imid,il_jmid) > 50.0 ) ll_north=.TRUE.
-
-         ! exit when close enough of point
-         IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE.
+         il_ind(:) = MAXLOC( dl_lon0(il_iinf:il_isup,il_jmid), &
+         &                   dl_lon0(il_iinf:il_isup,il_jmid) <= 360._dp )
+
+         il_imid=il_ind(1)
+
+         IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. &
+         &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN
+
+            il_iinf = il_imid ;  il_isup = il_imid
+            il_jinf = il_jmid ;  il_jsup = il_jmid
+
+         ELSE
+            IF( ALL(dl_lon0(il_isup,il_jinf:il_jsup) >  dl_lon1 ) .AND. &
+            &   il_imid /= il_isup )THEN
+               ! 0 < lon1 < lon0(isup)
+               ! point east
+               il_iinf = il_imid+1
+               ll_continue=.TRUE.
+         
+            ELSE IF( ALL(dl_lon0(il_iinf,il_jinf:il_jsup) <  dl_lon1 ) .AND. &
+            &        il_imid /= il_iinf )THEN
+               ! lon0(iinf) < lon1 < 360
+               ! point west
+               il_isup = il_imid
+               ll_continue=.TRUE.
+
+            ENDIF
+
+            il_shape(1)= il_isup - il_iinf + 1
+            il_shape(2)= il_jsup - il_jinf + 1
+
+            il_imid = il_iinf + INT(il_shape(1)/2) 
+            il_jmid = il_jinf + INT(il_shape(2)/2)
+
+            ! exit when close enough of point
+            IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE.
+         ENDIF
       ENDIF
 
@@ -2976,4 +3089,5 @@
       DO WHILE( ll_continue .AND. .NOT. ll_north )
 
+         ll_continue=.FALSE.
          IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. &
          &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN
@@ -2982,28 +3096,30 @@
             il_jinf = il_jmid ;  il_jsup = il_jmid
 
-            ll_continue=.FALSE.
-
          ELSE
-            IF( dl_lon1 > dl_lon0(il_imid,il_jmid) )THEN
+            IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) <  dl_lon1) )THEN    
 
                ! point east
                il_iinf = il_imid
+               ll_continue=.TRUE.
         
-            ELSE IF(dl_lon1 < dl_lon0(il_imid,il_jmid) )THEN
+            ELSE IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) >  dl_lon1) )THEN    
 
                ! point west
                il_isup = il_imid
+               ll_continue=.TRUE.
 
             ENDIF
 
-            IF( dd_lat1 > dd_lat0(il_imid,il_jmid) )THEN
+            IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) <  dd_lat1) )THEN    
                
                ! point north
                il_jinf = il_jmid
-
-            ELSE IF(dd_lat1 < dd_lat0(il_imid,il_jmid) )THEN
+               ll_continue=.TRUE.
+
+            ELSE IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) > dd_lat1) )THEN    
 
                ! point south
                il_jsup = il_jmid
+               ll_continue=.TRUE.
             
             ENDIF
@@ -3014,7 +3130,4 @@
             il_imid = il_iinf + INT(il_shape(1)/2) 
             il_jmid = il_jinf + INT(il_shape(2)/2)
-
-            ! exit if too close from north fold (safer)
-            IF( dd_lat0(il_imid,il_jmid) > 50.0 ) ll_north=.TRUE.
 
             ! exit when close enough of point
@@ -3049,5 +3162,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_lon    grid longitude array
@@ -3055,7 +3168,8 @@
    !> @param[in] dd_lonA   longitude of point A
    !> @param[in] dd_latA   latitude  of point A
+   !> @param[in] dd_fill
    !> @return array of distance between point A and grid points.
    !-------------------------------------------------------------------
-   FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA)
+   FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA )
       IMPLICIT NONE
       ! Argument      
@@ -3110,9 +3224,10 @@
          DO ji=1,il_shape(1)
             IF( dl_lon(ji,jj) == dl_lonA .AND. &
-            &   dl_lat(ji,jj) == dl_laTA )THEN
+            &   dl_lat(ji,jj) == dl_latA )THEN
                grid_distance(ji,jj)=0.0
             ELSE
                dl_tmp= SIN(dl_latA)*SIN(dl_lat(ji,jj)) + &
-               &       COS(dl_latA)*COS(dl_lat(ji,jj))*COS(dl_lon(ji,jj)-dl_lonA)
+               &       COS(dl_latA)*COS(dl_lat(ji,jj)) * &
+               &       COS(dl_lon(ji,jj)-dl_lonA)
                ! check to avoid mistake with ACOS
                IF( dl_tmp < -1.0 ) dl_tmp = -1.0
@@ -3136,5 +3251,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -3170,16 +3285,17 @@
 
       ! local variable
-      INTEGER(i4) :: il_imin0
-      INTEGER(i4) :: il_jmin0
-      INTEGER(i4) :: il_imax0
-      INTEGER(i4) :: il_jmax0
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
       
-      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
       
-      INTEGER(i4), DIMENSION(2,2)         :: il_xghost0
-      INTEGER(i4), DIMENSION(2,2)         :: il_xghost1
-
-      CHARACTER(LEN= 1) :: cl_point
-      CHARACTER(LEN=lc) :: cl_name
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
+
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
 
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
@@ -3188,11 +3304,11 @@
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1
 
-      TYPE(TVAR) :: tl_lon0
-      TYPE(TVAR) :: tl_lat0
-      TYPE(TVAR) :: tl_lon1
-      TYPE(TVAR) :: tl_lat1
-
-      TYPE(TMPP) :: tl_coord0
-      TYPE(TMPP) :: tl_coord1
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+      TYPE(TVAR)                               :: tl_lon1
+      TYPE(TVAR)                               :: tl_lat1
+
+      TYPE(TMPP)                               :: tl_coord0
+      TYPE(TMPP)                               :: tl_coord1
       
       ! loop indices
@@ -3227,6 +3343,21 @@
          ! read coarse longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
          tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
          tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
          
@@ -3267,6 +3398,21 @@
          ! read fine longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
          tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
          tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
  
@@ -3318,5 +3464,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -3354,18 +3500,18 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
+      INTEGER(i4)                              :: il_ind
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
       
-      INTEGER(i4), DIMENSION(2,2)         :: il_xghost1
-
-      CHARACTER(LEN= 1) :: cl_point
-      CHARACTER(LEN=lc) :: cl_name
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
 
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1
 
-      TYPE(TVAR) :: tl_lon1
-      TYPE(TVAR) :: tl_lat1
-
-      TYPE(TMPP) :: tl_coord1
+      TYPE(TVAR)                               :: tl_lon1
+      TYPE(TVAR)                               :: tl_lat1
+
+      TYPE(TMPP)                               :: tl_coord1
       ! loop indices
       !----------------------------------------------------------------
@@ -3397,6 +3543,21 @@
          ! read fine longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
          tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
          tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
  
@@ -3446,5 +3607,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -3483,23 +3644,24 @@
 
       ! local variable
-      INTEGER(i4) :: il_imin0
-      INTEGER(i4) :: il_jmin0
-      INTEGER(i4) :: il_imax0
-      INTEGER(i4) :: il_jmax0
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
       
-      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
       
-      INTEGER(i4), DIMENSION(2,2)         :: il_xghost0
-
-      CHARACTER(LEN= 1) :: cl_point
-      CHARACTER(LEN=lc) :: cl_name
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
+
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
 
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0
 
-      TYPE(TVAR) :: tl_lon0
-      TYPE(TVAR) :: tl_lat0
-
-      TYPE(TMPP) :: tl_coord0
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+
+      TYPE(TMPP)                               :: tl_coord0
       ! loop indices
       !----------------------------------------------------------------
@@ -3530,6 +3692,21 @@
          ! read coarse longitue and latitude
          WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
          tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
          WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
          tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
          
@@ -3585,7 +3762,10 @@
    !
    !> @author J.Paul
-   !> - November, 2013 - Initial Version
-   !> @date September, 2014 - rename from grid_get_fine_offset
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - rename from grid_get_fine_offset
+   !> @date May, 2015 
+   !> - improve way to find offset
+   !>
    !> @param[in] dd_lon0   coarse grid longitude array 
    !> @param[in] dd_lat0   coarse grid latitude  array
@@ -3620,8 +3800,12 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(2) :: il_shape0
-      INTEGER(i4), DIMENSION(2) :: il_shape1
+      INTEGER(i4), DIMENSION(2)                :: il_shape0
+      INTEGER(i4), DIMENSION(2)                :: il_shape1
+
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
       REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
+
+      LOGICAL                                  :: ll_ii
+      LOGICAL                                  :: ll_ij
       
       ! loop indices
@@ -3657,11 +3841,14 @@
       grid__get_fine_offset_cc(:,:)=-1
 
-      IF( il_shape1(1) > 1 )THEN
-
-         ! look for i-direction left offset 
+      IF( il_shape1(jp_J) == 1 )THEN
+          
+         grid__get_fine_offset_cc(jp_J,:)=((id_rho(jp_J)-1)/2)
+
+         ! work on i-direction
+         ! look for i-direction left offset
          IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN
             DO ji=1,id_rho(jp_I)+2
                IF( dl_lon1(ji,1) > dl_lon0(id_imin0+1,id_jmin0) - dp_delta )THEN
-                  grid__get_fine_offset_cc(1,1)=(id_rho(jp_I)+1)-ji
+                  grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ji
                   EXIT
                ENDIF
@@ -3671,11 +3858,10 @@
             &                 " not match fine grid lower left corner.")
          ENDIF
-
          ! look for i-direction right offset
-         IF( dl_lon1(il_shape1(1),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN
+         IF( dl_lon1(il_shape1(jp_I),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN
             DO ji=1,id_rho(jp_I)+2
-               ii=il_shape1(1)-ji+1
+               ii=il_shape1(jp_I)-ji+1
                IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) + dp_delta )THEN
-                  grid__get_fine_offset_cc(1,2)=(id_rho(jp_I)+1)-ji
+                  grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ji
                   EXIT
                ENDIF
@@ -3686,9 +3872,9 @@
          ENDIF
 
-      ELSE
-         grid__get_fine_offset_cc(1,:)=((id_rho(jp_I)-1)/2)
-      ENDIF
-
-      IF( il_shape1(2) > 1 )THEN
+      ELSEIF( il_shape1(jp_I) == 1 )THEN
+         
+         grid__get_fine_offset_cc(jp_I,:)=((id_rho(jp_I)-1)/2)
+         
+         ! work on j-direction
 
          ! look for j-direction lower offset 
@@ -3696,5 +3882,5 @@
             DO jj=1,id_rho(jp_J)+2
                IF( dd_lat1(1,jj) > dd_lat0(id_imin0,id_jmin0+1) - dp_delta )THEN
-                  grid__get_fine_offset_cc(2,1)=(id_rho(jp_J)+1)-jj
+                  grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-jj
                   EXIT
                ENDIF
@@ -3706,9 +3892,9 @@
 
          ! look for j-direction upper offset 
-         IF( dd_lat1(1,il_shape1(2)) > dd_lat0(id_imin0,id_jmax0-1) )THEN
+         IF( dd_lat1(1,il_shape1(jp_J)) > dd_lat0(id_imin0,id_jmax0-1) )THEN
             DO jj=1,id_rho(jp_J)+2
-               ij=il_shape1(2)-jj+1
+               ij=il_shape1(jp_J)-jj+1
                IF( dd_lat1(1,ij) < dd_lat0(id_imin0,id_jmax0-1) + dp_delta )THEN
-                  grid__get_fine_offset_cc(2,2)=(id_rho(jp_J)+1)-jj
+                  grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-jj
                   EXIT
                ENDIF
@@ -3717,7 +3903,81 @@
             CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
             &                 " not match fine grid upper right corner.")
-         ENDIF
-      ELSE
-         grid__get_fine_offset_cc(2,:)=((id_rho(jp_J)-1)/2)
+         ENDIF         
+
+      ELSE ! il_shape1(1) > 1 .AND. il_shape1(2) > 1 
+
+         ! look for lower left offset
+         IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0+1) )THEN
+
+            ii=1
+            ij=1
+            DO ji=1,(id_rho(jp_I)+2)*(id_rho(jp_J)+2)
+
+               ll_ii=.FALSE.
+               ll_ij=.FALSE.
+
+               IF( dl_lon1(ii,ij) >= dl_lon0(id_imin0+1,id_jmin0+1)-dp_delta .AND. &
+               &   dd_lat1(ii,ij) >= dd_lat0(id_imin0+1,id_jmin0+1)-dp_delta )THEN
+                  grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
+                  grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij
+                  EXIT
+               ENDIF
+
+               IF( dl_lon1(ii+1,ij) <= dl_lon0(id_imin0+1,id_jmin0+1)+dp_delta .AND. &
+               &   dd_lat1(ii+1,ij) <= dd_lat0(id_imin0+1,id_jmin0+1)+dp_delta )THEN
+                  ll_ii=.TRUE.
+               ENDIF
+               IF( dl_lon1(ii,ij+1) <= dl_lon0(id_imin0+1,id_jmin0+1)+dp_delta .AND. &
+               &   dd_lat1(ii,ij+1) <= dd_lat0(id_imin0+1,id_jmin0+1)+dp_delta )THEN
+                  ll_ij=.TRUE.
+               ENDIF
+
+               IF( ll_ii ) ii=ii+1
+               IF( ll_ij ) ij=ij+1
+
+            ENDDO
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
+            &                 " not match fine grid lower left corner.")
+         ENDIF
+
+         ! look for upper right offset
+         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > &
+            & dl_lon0(id_imax0-1,id_jmax0-1) )THEN
+
+            ii=il_shape1(jp_I)
+            ij=il_shape1(jp_J)
+            DO ji=1,(id_rho(jp_I)+2)*(id_rho(jp_J)+2)
+
+               ll_ii=.FALSE.
+               ll_ij=.FALSE.
+
+               IF( dl_lon1(ii,ij) <= dl_lon0(id_imax0-1,id_jmax0-1)+dp_delta .AND. &
+               &   dd_lat1(ii,ij) <= dd_lat0(id_imax0-1,id_jmax0-1)+dp_delta )THEN
+                  grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-(il_shape1(jp_I)+1-ii)
+                  grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-(il_shape1(jp_J)+1-ij)
+                  EXIT
+               ENDIF
+
+               IF( dl_lon1(ii-1,ij) >= dl_lon0(id_imax0-1,id_jmax0-1)-dp_delta .AND. &
+               &   dd_lat1(ii-1,ij) >= dd_lat0(id_imax0-1,id_jmax0-1)-dp_delta )THEN
+                  ll_ii=.TRUE.
+               ENDIF
+               IF( dl_lon1(ii,ij-1) >= dl_lon0(id_imax0-1,id_jmax0-1)-dp_delta .AND. &
+               &   dd_lat1(ii,ij-1) >= dd_lat0(id_imax0-1,id_jmax0-1)-dp_delta )THEN
+                  ll_ij=.TRUE.
+               ENDIF
+
+               IF( ll_ii ) ii=ii-1
+               IF( ll_ij ) ij=ij-1
+
+            ENDDO
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
+            &                 " not match fine grid upper right corner.")
+         ENDIF
+
       ENDIF
 
@@ -3732,5 +3992,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013- Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -3742,5 +4002,5 @@
    !> @param[in] id_jmin0  coarse grid lower left  corner j-indice of fine grid domain 
    !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain  
-   !> @param[in] id_rho    array of refinement factor (default 1) 
+   !> @param[in] id_rho    array of refinement factor 
    !-------------------------------------------------------------------
    SUBROUTINE grid_check_coincidence( td_coord0, td_coord1, &
@@ -4042,5 +4302,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_lon0   array of coarse grid longitude
@@ -4103,5 +4363,4 @@
       dl_lon1 = dd_lon1(il_imin1, il_jmin1)
       dl_lat1 = dd_lat1(il_imin1, il_jmin1)
-
 
       IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0 ) .OR. & 
@@ -4202,5 +4461,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] dd_lat0   array of coarse grid latitude 
@@ -4272,5 +4531,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013-Initial version
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_var array of variable structure 
@@ -4348,5 +4607,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013-Initial version
+   !> @date November, 2013 - Initial version
    !
    !> @param[inout] td_var array of variable structure 
@@ -4374,6 +4633,8 @@
       IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
 
-         CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//&
-         &              TRIM(td_var%c_name) )
+         IF( ANY(id_ghost(:,:)/=0) )THEN
+            CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//&
+            &              TRIM(td_var%c_name) )
+         ENDIF
 
          ! copy variable
@@ -4425,5 +4686,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[in] td_var variable sturcture 
@@ -4555,5 +4816,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014 - Initial Version
+   !> @date September, 2014 - Initial Version
    !> @date October, 2014
    !> - work on mpp file structure instead of file structure
@@ -4592,4 +4853,5 @@
           tl_mpp=mpp_copy(td_mpp)
 
+          CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio)))
           IF( tl_mpp%i_perio < 0 )THEN
              ! compute NEMO periodicity index
@@ -4627,5 +4889,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var    variable strucutre 
@@ -4694,4 +4956,5 @@
                         il_tmp(jim:jip,jjm:jjp)=1
                      END WHERE
+
                   ENDIF
                ENDDO
@@ -4720,10 +4983,10 @@
    !>
    !> @details
-   !> the minimum size (nbumber of point) of closed sea to be kept could be
+   !> the minimum size (number of point) of closed sea to be kept could be
    !> sepcify with id_minsize.
    !> By default only the biggest sea is preserve.
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var    variable structure
@@ -4782,4 +5045,101 @@
 
    END SUBROUTINE grid_fill_small_dom
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill small domain inside bigger one. 
+   !>
+   !> @details
+   !> the minimum size (number of point) of domain sea to be kept could be
+   !> is sepcified with id_minsize.
+   !> smaller domain are included in the one they are embedded.
+   !>
+   !> @author J.Paul
+   !> @date Ferbruay, 2015 - Initial Version
+   !>
+   !> @param[inout] id_mask      domain mask (from grid_split_domain)
+   !> @param[in] id_minsize   minimum size of sea to be kept
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_fill_small_msk(id_mask, id_minsize)
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4), DIMENSION(:,:), INTENT(INOUT) :: id_mask
+      INTEGER(i4),                 INTENT(IN   ) :: id_minsize
+
+      ! local variable
+      INTEGER(i4)                              :: il_ndom
+      INTEGER(i4)                              :: il_minsize
+      INTEGER(i4)                              :: il_msk
+      
+      INTEGER(i4)                              :: jim
+      INTEGER(i4)                              :: jjm
+      INTEGER(i4)                              :: jip
+      INTEGER(i4)                              :: jjp
+
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ii
+      INTEGER(i4) :: ij
+
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      il_shape(:)=SHAPE(id_mask(:,:))
+      il_ndom=MINVAL(id_mask(:,:))
+
+      ALLOCATE( il_tmp(il_shape(1),il_shape(2)) )
+      il_tmp(:,:)=0
+      DO ji=-1,il_ndom,-1
+         WHERE( id_mask(:,:)==ji ) 
+            il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji
+         END WHERE
+      ENDDO
+
+      DO WHILE( id_minsize > MINVAL(il_tmp(:,:)) )
+
+         DO jj=1,il_shape(2)
+            DO ji=1,il_shape(1)
+
+               IF( il_tmp(ji,jj) < il_minsize )THEN
+                  jim=MAX(1,ji-1)   ;  jip=MIN(il_shape(1),ji+1)
+                  jjm=MAX(1,jj-1)   ;  jjp=MIN(il_shape(2),jj+1)
+                  
+                  il_msk=0
+                  DO ij=jjm,jjp
+                     DO ii=jim,jip
+                        IF( id_mask(ii,ij) /= id_mask(ji,jj) )THEN
+                           IF( il_msk == 0 )THEN
+                              il_msk=id_mask(ii,ij)
+                           ELSEIF( il_msk /= id_mask(ii,ij) )THEN
+                              CALL logger_error("GRID FILL SMALL MSK: "//&
+                              &  "small domain not embedded in bigger one"//&
+                              &  ". point should be between two different"//&
+                              &  " domain.")
+                           ENDIF
+                        ENDIF
+                     ENDDO
+                  ENDDO
+                  IF( il_msk /= 0 ) id_mask(ji,jj)=il_msk
+
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+
+         il_tmp(:,:)=0
+         DO ji=-1,il_ndom,-1
+            WHERE( id_mask(:,:)==ji ) 
+               il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji
+            END WHERE
+         ENDDO            
+
+      ENDDO
+
+      DEALLOCATE( il_tmp )
+
+
+   END SUBROUTINE grid_fill_small_msk
 END MODULE grid
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/interp.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/interp.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/interp.f90	(revision 5682)
@@ -27,5 +27,5 @@
 !>    defining string character _cn\_varinfo_.<br/>
 !>    Example:
-!>       - cn_varinfo='varname1:cubic/rhoi', 'varname2:linear' 
+!>       - cn_varinfo='varname1:int=cubic/rhoi', 'varname2:int=linear' 
 !>
 !>    to create mixed grid (with coarse grid point needed to compute
@@ -137,5 +137,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_method interpolation method
@@ -179,5 +179,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_mix mixed grid variable (to interpolate)
@@ -244,5 +244,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_mix mixed grid variable (to interpolate)
@@ -363,5 +363,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_var    coarse grid variable (should be extrapolated)
@@ -449,5 +449,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_mix mixed grid variable
@@ -610,5 +610,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - use offset to save useful domain
@@ -716,5 +716,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -828,5 +828,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - use interpolation method modules
@@ -947,4 +947,5 @@
 
       DEALLOCATE(il_detect)
+
       !4- save useful domain (remove offset)
       CALL interp_clean_mixed_grid( tl_mix, td_var, &
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90	(revision 5682)
@@ -26,4 +26,6 @@
 ! REVISION HISTORY:
 !> @date September, 2014 -Initial version
+!> @date June, 2015
+!> - use math module
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -36,5 +38,5 @@
    USE logger                          ! log file manager
    USE fct                             ! basic useful function
-   USE extrap                          ! extrapolation manager
+   USE math                            ! mathematical function
 
    IMPLICIT NONE
@@ -61,5 +63,7 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
+   !> @date July, 2015 
+   !> - reinitialise detect array for each level
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -82,11 +86,13 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(4)                :: il_shape
-
-      LOGICAL                                  :: ll_discont
-
-      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_IJ
-      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_I
-      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_J
+      INTEGER(i4), DIMENSION(4)                  :: il_shape
+
+      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
+
+      LOGICAL                                    :: ll_discont
+
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_IJ
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_I
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_J
       
       ! loop indices
@@ -113,5 +119,8 @@
       &                               id_rho(jp_J), ld_even(jp_J))
 
+      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3)))
+
       DO jl=1,il_shape(4)
+         il_detect(:,:,:)=id_detect(:,:,:)
          ! loop on vertical level
          DO jk=1,il_shape(3)
@@ -119,17 +128,17 @@
             ! I-J plan
             CALL interp_cubic__2D(dd_value(:,:,jk,jl), dd_fill, &
-            &                     id_detect(:,:,jk),            &
+            &                     il_detect(:,:,jk),            &
             &                     dl_weight_IJ(:,:),            &
             &                     id_rho(jp_I), id_rho(jp_J),   &
             &                     ll_discont)            
-            IF( ANY(id_detect(:,:,jk)==1) )THEN
+            IF( ANY(il_detect(:,:,jk)==1) )THEN
                ! I direction
                DO jj=1,il_shape(2)
                   CALL interp_cubic__1D( dd_value(:,jj,jk,jl), dd_fill, &
-                  &                      id_detect(:,jj,jk),            &
+                  &                      il_detect(:,jj,jk),            &
                   &                      dl_weight_I(:,:),              &
                   &                      id_rho(jp_I), ll_discont )
                ENDDO
-               IF( ALL(id_detect(:,:,jk)==0) )THEN
+               IF( ALL(il_detect(:,:,jk)==0) )THEN
                   CYCLE
                ELSE
@@ -137,5 +146,5 @@
                   DO ji=1,il_shape(1)
                      CALL interp_cubic__1D( dd_value(ji,:,jk,jl), dd_fill, &
-                     &                      id_detect(ji,:,jk),            &
+                     &                      il_detect(ji,:,jk),            &
                      &                      dl_weight_J(:,:),              &
                      &                      id_rho(jp_J), ll_discont )
@@ -147,4 +156,7 @@
       ENDDO
 
+      id_detect(:,:,:)=il_detect(:,:,:)
+      DEALLOCATE(il_detect)
+
       DEALLOCATE(dl_weight_IJ)
       DEALLOCATE(dl_weight_I)
@@ -159,5 +171,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -181,5 +193,5 @@
       REAL(dp)                        , INTENT(IN   ) :: dd_fill 
       INTEGER(I4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect
-      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight 
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
       INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
       INTEGER(I4)                     , INTENT(IN   ) :: id_rhoj
@@ -230,9 +242,9 @@
 
          ! compute derivative on coarse grid
-         dl_dfdx(:,:)=extrap_deriv_2D(dl_coarse(:,:), dd_fill, 'I', ld_discont)
-         dl_dfdy(:,:)=extrap_deriv_2D(dl_coarse(:,:), dd_fill, 'J', ld_discont)
+         dl_dfdx(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'I', ld_discont)
+         dl_dfdy(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'J', ld_discont)
 
          ! compute cross derivative on coarse grid
-         dl_d2fdxy(:,:)=extrap_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont)
+         dl_d2fdxy(:,:)=math_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont)
 
          ALLOCATE( dl_tmp(2,2) )
@@ -319,5 +331,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  1D array of variable value 
@@ -339,5 +351,5 @@
       REAL(dp)                        , INTENT(IN   ) :: dd_fill 
       INTEGER(I4)     , DIMENSION(:)  , INTENT(INOUT) :: id_detect
-      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight 
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
       INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
       LOGICAL                         , INTENT(IN   ) :: ld_discont
@@ -376,5 +388,5 @@
 
          ! compute derivative on coarse grid
-         dl_dfdx(:)=extrap_deriv_1D(dl_coarse(:), dd_fill, ld_discont)
+         dl_dfdx(:)=math_deriv_1D(dl_coarse(:), dd_fill, ld_discont)
 
          ALLOCATE( dl_tmp(2) )
@@ -440,5 +452,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_value  2D array of value
@@ -503,5 +515,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  2D array of mixed grid value
@@ -565,5 +577,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_value  1D array of value
@@ -608,5 +620,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  1D array of mixed grid value
@@ -659,5 +671,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_weight interpolation weight of 2D array
@@ -740,5 +752,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_weight interpolation weight of 1D array
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90	(revision 5682)
@@ -24,5 +24,5 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date September, 2014 -Initial version
+!> @date September, 2014 - Initial version
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -63,5 +63,6 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
+   !> @date July, 2015 - reinitialise detect array for each level
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -84,11 +85,13 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(4)                :: il_shape
-
-      LOGICAL                                  :: ll_discont
-      
-      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_IJ
-      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_I
-      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_J
+      INTEGER(i4), DIMENSION(4)                  :: il_shape
+
+      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
+
+      LOGICAL                                    :: ll_discont
+ 
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_IJ
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_I
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_J
       
       ! loop indices
@@ -104,10 +107,10 @@
 
       ! compute vect2D
-      ALLOCATE(dl_weight_IJ(16,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) )
+      ALLOCATE(dl_weight_IJ(4,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) )
       CALL interp_linear__get_weight2D(dl_weight_IJ(:,:), &
       &                               id_rho(:), ld_even(:))
 
-      ALLOCATE( dl_weight_I( 4,((id_rho(jp_I)+1)                 )) )
-      ALLOCATE( dl_weight_J( 4,(                 (id_rho(jp_J)+1))) )
+      ALLOCATE( dl_weight_I( 2,((id_rho(jp_I)+1)                 )) )
+      ALLOCATE( dl_weight_J( 2,(                 (id_rho(jp_J)+1))) )
       CALL interp_linear__get_weight1D(dl_weight_I(:,:), &
       &                               id_rho(jp_I), ld_even(jp_I))
@@ -115,5 +118,8 @@
       &                               id_rho(jp_J), ld_even(jp_J))
 
+      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3)))
+
       DO jl=1,il_shape(4)
+         il_detect(:,:,:)=id_detect(:,:,:)
          ! loop on vertical level
          DO jk=1,il_shape(3)
@@ -121,17 +127,17 @@
             ! I-J plan
             CALL interp_linear__2D(dd_value(:,:,jk,jl), dd_fill,&
-            &                     id_detect(:,:,jk),            &
+            &                     il_detect(:,:,jk),            &
             &                     dl_weight_IJ(:,:),            &
             &                     id_rho(jp_I), id_rho(jp_J),   &
             &                     ll_discont)            
-            IF( ANY(id_detect(:,:,jk)==1) )THEN
+            IF( ANY(il_detect(:,:,jk)==1) )THEN
                ! I direction
                DO jj=1,il_shape(2)
                   CALL interp_linear__1D( dd_value(:,jj,jk,jl), dd_fill,&
-                  &                       id_detect(:,jj,jk),           &
+                  &                       il_detect(:,jj,jk),           &
                   &                       dl_weight_I(:,:),             &
                   &                       id_rho(jp_I), ll_discont )
                ENDDO
-               IF( ALL(id_detect(:,:,jk)==0) )THEN
+               IF( ALL(il_detect(:,:,jk)==0) )THEN
                   CYCLE
                ELSE
@@ -139,5 +145,5 @@
                   DO ji=1,il_shape(1)
                      CALL interp_linear__1D( dd_value(ji,:,jk,jl), dd_fill,&
-                     &                       id_detect(ji,:,jk),           &
+                     &                       il_detect(ji,:,jk),           &
                      &                       dl_weight_J(:,:),             &
                      &                       id_rho(jp_J), ll_discont )
@@ -149,8 +155,11 @@
       ENDDO
 
+      id_detect(:,:,:)=il_detect(:,:,:)
+      DEALLOCATE(il_detect)
+
       DEALLOCATE(dl_weight_IJ)
       DEALLOCATE(dl_weight_I)
       DEALLOCATE(dl_weight_J)
-      
+ 
    END SUBROUTINE interp_linear_fill
    !-------------------------------------------------------------------
@@ -161,5 +170,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -235,5 +244,5 @@
                IF( ALL(id_detect(ji:ji+id_rhoi,   &
                &                 jj:jj+id_rhoj)==0) ) CYCLE
-               ! check data to needed to interpolate
+               ! check data needed to interpolate
                IF( ANY(dl_coarse(ii:ii+1,ij:ij+1)==dd_fill) ) CYCLE
                ! check longitude discontinuity
@@ -296,5 +305,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  1D array of variable value 
@@ -408,5 +417,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_value  2D array of value
@@ -445,6 +454,6 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
-   !> 
+   !> @date September, 2014 - Initial Version
+   !>
    !> @param[inout] dd_value  2D array of mixed grid value
    !> @param[inout] id_detect 2D array of point to be interpolated
@@ -477,25 +486,25 @@
       !----------------------------------------------------------------
 
-         IF( ANY( dd_coef(:)==dd_fill ) )THEN
-            CALL logger_error("INTERP LINEAR FILL: fill value detected in coef. "//&
-            &              "can not compute interpolation.")
-         ELSE
-
-            ii=0
-            DO jj=1,id_rhoj+1
-               DO ji=1,id_rhoi+1
-
-                  ii=ii+1
-                  IF(id_detect(ji,jj)==1)THEN
-
-                     dd_value(ji,jj)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ii))
-                     id_detect(ji,jj)=0
-
-                  ENDIF
-
-               ENDDO
+      IF( ANY( dd_coef(:)==dd_fill ) )THEN
+         CALL logger_error("INTERP LINEAR FILL: fill value detected in coef. "//&
+         &              "can not compute interpolation.")
+      ELSE
+
+         ii=0
+         DO jj=1,id_rhoj+1
+            DO ji=1,id_rhoi+1
+
+               ii=ii+1
+               IF(id_detect(ji,jj)==1)THEN
+
+                  dd_value(ji,jj)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ii))
+                  id_detect(ji,jj)=0
+
+               ENDIF
+
             ENDDO
-
-         ENDIF
+         ENDDO
+
+      ENDIF
 
    END SUBROUTINE interp_linear__2D_fill
@@ -505,5 +514,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_value  1D array of value
@@ -540,5 +549,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !> 
    !> @param[inout] dd_value  1D array of mixed grid value
@@ -591,5 +600,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_weight interpolation weight of 2D array
@@ -660,5 +669,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] dd_weight interpolation weight of 1D array
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90	(revision 5682)
@@ -24,5 +24,5 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date September, 2014 -Initial version
+!> @date September, 2014 - Initial version
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -55,5 +55,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -69,5 +69,7 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(4)                :: il_shape
+      INTEGER(i4), DIMENSION(4)                  :: il_shape
+
+      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
 
       ! loop indices
@@ -80,5 +82,7 @@
       il_shape(:)=SHAPE(dd_value)
 
+      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3)))
       DO jl=1,il_shape(4)
+         il_detect(:,:,:)=id_detect(:,:,:)
          ! loop on vertical level
          DO jk=1,il_shape(3)
@@ -86,14 +90,14 @@
             ! I-J plan
             CALL interp_nearest__2D(dd_value(:,:,jk,jl),&
-            &                       id_detect(:,:,jk),  &
+            &                       il_detect(:,:,jk),  &
             &                       id_rho(jp_I), id_rho(jp_J) )            
-            IF( ANY(id_detect(:,:,jk)==1) )THEN
+            IF( ANY(il_detect(:,:,jk)==1) )THEN
                ! I direction
                DO jj=1,il_shape(2)
                   CALL interp_nearest__1D( dd_value(:,jj,jk,jl),&
-                  &                        id_detect(:,jj,jk),  &
+                  &                        il_detect(:,jj,jk),  &
                   &                        id_rho(jp_I) )
                ENDDO
-               IF( ALL(id_detect(:,:,jk)==0) )THEN
+               IF( ALL(il_detect(:,:,jk)==0) )THEN
                   CYCLE
                ELSE
@@ -101,5 +105,5 @@
                   DO ji=1,il_shape(1)
                      CALL interp_nearest__1D( dd_value(ji,:,jk,jl),&
-                     &                        id_detect(ji,:,jk),  &
+                     &                        il_detect(ji,:,jk),  &
                      &                        id_rho(jp_J) )
                   ENDDO
@@ -110,4 +114,7 @@
       ENDDO
 
+      id_detect(:,:,:)=il_detect(:,:,:)
+      DEALLOCATE(il_detect)
+
    END SUBROUTINE interp_nearest_fill
    !-------------------------------------------------------------------
@@ -116,5 +123,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  2D array of variable value 
@@ -171,5 +178,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  1D array of variable value 
@@ -216,5 +223,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  2D array of mixed grid value
@@ -300,5 +307,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[inout] dd_value  1D array of mixed grid value
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom.f90	(revision 5682)
@@ -156,5 +156,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file file structure
@@ -186,5 +186,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file file structure
@@ -223,5 +223,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file file structure
@@ -252,5 +252,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file      file structure
@@ -300,5 +300,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -338,5 +338,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file      file structure
@@ -386,5 +386,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file      file structure
@@ -422,5 +422,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -452,5 +452,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -485,5 +485,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -529,5 +529,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -564,21 +564,27 @@
    !-------------------------------------------------------------------
    !> @brief This subroutine write file structure in an opened file.
-   !
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !>
+   !> @details
+   !> optionally, you could specify dimension order (default 'xyzt')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 - add dimension order option
    !
    !> @param[in] td_file   file structure
    !-------------------------------------------------------------------
-   SUBROUTINE iom_write_file(td_file)
-      IMPLICIT NONE
-      ! Argument      
-      TYPE(TFILE), INTENT(INOUT) :: td_file
-      !----------------------------------------------------------------
-
-      ! open file
-      SELECT CASE(TRIM(td_file%c_type))
-         CASE('cdf')
-            CALL iom_cdf_write_file(td_file)
-         CASE('dimg')
+   SUBROUTINE iom_write_file(td_file, cd_dimorder)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            CALL iom_cdf_write_file(td_file, cd_dimorder)
+         CASE('dimg')
+            ! note: can not change dimension order in restart dimg file
             CALL iom_rstdimg_write_file(td_file)
          CASE DEFAULT
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90	(revision 5682)
@@ -144,16 +144,24 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date May, 2015 - add optional message to netcdf error message
+   !>
    !> @param[in] id_status error status
-   !-------------------------------------------------------------------
-   SUBROUTINE iom_cdf__check(id_status)
-      IMPLICIT NONE
-      ! Argument      
-      INTEGER(i4), INTENT(IN) :: id_status
-      !----------------------------------------------------------------
+   !> @param[in] cd_msg    message
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__check(id_status, cd_msg)
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4)     , INTENT(IN)           :: id_status
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_msg
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_msg
+      !----------------------------------------------------------------
+
+      cl_msg=""
+      IF( PRESENT(cd_msg) ) cl_msg=cd_msg
 
       IF( id_status /= NF90_NOERR )THEN
-         CALL logger_error(TRIM(NF90_STRERROR(id_status)))
+         CALL logger_error(TRIM(cl_msg)//TRIM(NF90_STRERROR(id_status)))
       ENDIF
 
@@ -173,5 +181,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -203,8 +211,9 @@
             CALL logger_info( " IOM CDF CREATE: file "//TRIM(td_file%c_name) )
 
-            il_status = NF90_CREATE( TRIM(td_file%c_name),&
-            &                        NF90_WRITE,               &
-            &                        td_file%i_id)
-            CALL iom_cdf__check(il_status)
+            il_status = NF90_CREATE(TRIM(td_file%c_name),&
+            &                       cmode=NF90_64BIT_OFFSET,&
+            &                       ncid=td_file%i_id)
+         !NF90_WRITE,               &
+            CALL iom_cdf__check(il_status," IOM CDF CREATE: ")
 
             td_file%l_def=.TRUE.
@@ -228,7 +237,8 @@
                &                      NF90_NOWRITE,         &
                &                      td_file%i_id)
-               CALL iom_cdf__check(il_status)
-
-               CALL logger_trace("IOM CDF OPEN "//TRIM(td_file%c_name)//" "//TRIM(fct_str(td_file%i_id)))
+               CALL iom_cdf__check(il_status," IOM CDF OPEN: ")
+
+               CALL logger_trace("IOM CDF OPEN "//TRIM(td_file%c_name)//" "//&
+                  &  TRIM(fct_str(td_file%i_id)))
             ELSE
 
@@ -239,5 +249,5 @@
                &                      NF90_WRITE,           &
                &                      td_file%i_id)
-               CALL iom_cdf__check(il_status)
+               CALL iom_cdf__check(il_status,"IOM CDF OPEN: ")
 
             ENDIF
@@ -267,5 +277,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -291,5 +301,5 @@
 
          il_status = NF90_CLOSE(td_file%i_id)
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF CLOSE: ")
 
          td_file%i_id = 0
@@ -307,5 +317,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -326,5 +336,5 @@
       il_status=NF90_INQUIRE(td_file%i_id, td_file%i_ndim, &
       &     td_file%i_nvar, td_file%i_natt, td_file%i_uldid, il_fmt)
-      CALL iom_cdf__check(il_status)
+      CALL iom_cdf__check(il_status,"IOM CDF GET INFO: ")
 
       SELECT CASE(il_fmt)
@@ -345,5 +355,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -396,5 +406,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - use attribute periodicity read from the file if present.
@@ -439,5 +449,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -480,12 +490,12 @@
 
             ! look for depth id
-            IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'depth') /= 0 )THEN
+            IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'depth')/=0 )THEN
                IF( td_file%i_depthid == 0 )THEN
                   td_file%i_depthid=ji
                ELSE
                   IF( td_file%i_depthid /= ji )THEN
-                     CALL logger_error("IOM CDF GET FILE VAR: find more than one "//&
-                     &                 "depth variable in file "//&
-                     &                 TRIM(td_file%c_name) )
+                     CALL logger_error("IOM CDF GET FILE VAR: find more"//&
+                        &  " than one depth variable in file "//&
+                        &  TRIM(td_file%c_name) )
                   ENDIF
                ENDIF
@@ -493,5 +503,5 @@
 
             ! look for time id
-            IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'time') /= 0 )THEN
+            IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'time')/=0 )THEN
                IF( td_file%i_timeid == 0 )THEN
                   td_file%i_timeid=ji
@@ -504,7 +514,6 @@
                      td_file%i_timeid=ji
                   !ELSE
-                  !   print *,'error'
-                  !   CALL logger_error("IOM OPEN: find more than one "//&
-                  !   &                 "time variable in file "//&
+                  !   CALL logger_error("IOM CDF GET FILE VAR: find more "//&
+                  !   &                 "than one time variable in file "//&
                   !   &                 TRIM(td_file%c_name) )
                   ENDIF
@@ -526,5 +535,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -567,5 +576,7 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 - create unused dimension, when reading dimension
+   !> of length less or equal to zero
    !
    !> @param[in] td_file   file structure
@@ -583,4 +594,5 @@
       INTEGER(i4)       :: il_len
       CHARACTER(LEN=lc) :: cl_name
+      LOGICAL           :: ll_use
       !----------------------------------------------------------------
 
@@ -601,7 +613,15 @@
          il_status=NF90_INQUIRE_DIMENSION(td_file%i_id, id_dimid, &
          &                                cl_name, il_len )
-         CALL iom_cdf__check(il_status)
-
-         iom_cdf__read_dim_id=dim_init(cl_name, il_len)
+         CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ")
+
+         ll_use=.TRUE.
+         IF( il_len <= 0 )THEN
+            CALL logger_warn( &
+         &  " IOM CDF READ DIM: dimension "//TRIM(fct_str(id_dimid))//&
+         &  " in file "//TRIM(td_file%c_name)//" is less or equel to zero")
+            il_len=1
+            ll_use=.FALSE.
+         ENDIF
+         iom_cdf__read_dim_id=dim_init(cl_name, il_len, ld_use=ll_use)
 
       ENDIF
@@ -613,5 +633,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -634,5 +654,6 @@
 
          CALL logger_error( &
-         &  " IOM CDF READ DIM: no id associated to file "//TRIM(td_file%c_name))
+         &  " IOM CDF READ DIM: no id associated to file "//&
+         &  TRIM(td_file%c_name))
 
       ELSE      
@@ -640,5 +661,5 @@
          il_status=NF90_INQ_DIMID( td_file%i_id, TRIM(ADJUSTL(cd_name)), &
          &                         il_dimid)
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ")
 
          iom_cdf__read_dim_name=iom_cdf_read_dim(td_file, il_dimid)
@@ -652,5 +673,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -714,9 +735,9 @@
          &                                il_len, &
          &                                il_attid )
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
 
          !! get attribute value
-         CALL logger_debug( " IOM CDF READ ATT: get attribute "//TRIM(cl_name)//&
-         &               " in file "//TRIM(td_file%c_name))
+         CALL logger_debug( " IOM CDF READ ATT: get attribute "//&
+            &            TRIM(cl_name)//" in file "//TRIM(td_file%c_name))
 
          SELECT CASE( il_type )
@@ -728,6 +749,6 @@
 
                   CALL logger_error( &
-                  &  " IOM CDF READ ATT: not enough space to put attribute "//&
-                  &  TRIM(cl_name) )
+                  &  " IOM CDF READ ATT: not enough space to put "//&
+                  &  "attribute "//TRIM(cl_name) )
 
                ELSE
@@ -737,5 +758,5 @@
                   &                      cl_name, &
                   &                      cl_value )
-                  CALL iom_cdf__check(il_status)
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
 
                   iom_cdf__read_att_name=att_init(cl_name, cl_value)
@@ -758,5 +779,5 @@
                   &                      cl_name, &
                   &                      bl_value(:))
-                  CALL iom_cdf__check(il_status)   
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
 
                   iom_cdf__read_att_name=att_init(cl_name, bl_value(:))
@@ -773,6 +794,6 @@
 
                   CALL logger_error( &
-                  &  " IOM CDF READ ATT: not enough space to put attribute "//&
-                  &  TRIM(cl_name) )
+                  &  " IOM CDF READ ATT: not enough space to put "//&
+                  &  "attribute "//TRIM(cl_name) )
 
                ELSE
@@ -782,5 +803,5 @@
                   &                      cl_name, &
                   &                      sl_value(:))
-                  CALL iom_cdf__check(il_status)   
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
 
                   iom_cdf__read_att_name=att_init(cl_name, sl_value(:))
@@ -797,6 +818,6 @@
 
                   CALL logger_error( &
-                  &  " IOM CDF READ ATT: not enough space to put attribute "//&
-                  &  TRIM(cl_name) )
+                  &  " IOM CDF READ ATT: not enough space to put "//&
+                  &  "attribute "//TRIM(cl_name) )
 
                ELSE
@@ -806,5 +827,5 @@
                   &                      cl_name, &
                   &                      il_value(:))
-                  CALL iom_cdf__check(il_status)   
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
 
                   iom_cdf__read_att_name=att_init(cl_name, il_value(:))
@@ -820,6 +841,6 @@
 
                   CALL logger_error( &
-                  &  " IOM CDF READ ATT: not enough space to put attribute "//&
-                  &  TRIM(cl_name) )
+                  &  " IOM CDF READ ATT: not enough space to put "//&
+                  &  "attribute "//TRIM(cl_name) )
 
                ELSE
@@ -829,5 +850,5 @@
                   &                      cl_name, &
                   &                      fl_value(:))
-                  CALL iom_cdf__check(il_status)   
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
 
                   iom_cdf__read_att_name=att_init(cl_name, fl_value(:))
@@ -844,6 +865,6 @@
 
                   CALL logger_error( &
-                  &  " IOM CDF READ ATT: not enough space to put attribute "//&
-                  &  TRIM(cl_name) )
+                  &  " IOM CDF READ ATT: not enough space to put "//&
+                  &  "attribute "//TRIM(cl_name) )
 
                ELSE
@@ -853,5 +874,5 @@
                   &                      cl_name, &
                   &                      dl_value(:))
-                  CALL iom_cdf__check(il_status)   
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
 
                   iom_cdf__read_att_name=att_init(cl_name, dl_value(:))
@@ -873,5 +894,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -902,5 +923,5 @@
          ! get attribute name
          il_status=NF90_INQ_ATTNAME(td_file%i_id, id_varid, id_attid, cl_name)
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
 
          ! read attribute
@@ -918,5 +939,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -976,5 +997,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1043,5 +1064,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1085,5 +1106,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1148,5 +1169,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1199,5 +1220,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - force to use FillValue=1.e20 if no FillValue for coordinate variable.
@@ -1240,5 +1261,5 @@
 
          ! inquire variable
-         CALL logger_trace( &
+         CALL logger_debug( &
          &  " IOM CDF READ VAR META: inquire variable "//&
          &  TRIM(fct_str(id_varid))//&
@@ -1253,7 +1274,8 @@
          &                                il_dimid(:),&
          &                                il_natt )
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF READ VAR META: ")
          !!! fill variable dimension structure
          tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, il_dimid(:) )
+
          IF( il_natt /= 0 )THEN
             ALLOCATE( tl_att(il_natt) )
@@ -1276,10 +1298,10 @@
                ELSE
                   ! create attribute _FillValue
-                  SELECT CASE(TRIM(cl_name))
+                  SELECT CASE(TRIM(fct_lower(cl_name)))
                      CASE DEFAULT
                         CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
                         &                "zero for variable "//TRIM(cl_name) )
                         tl_fill=att_init('_FillValue',0.)
-                     CASE('nav_lon','nav_lat', &
+                     CASE('nav_lon','nav_lat', 'nav_lev', &
                         &  'glamt','glamu','glamv','glamf', &
                         &  'gphit','gphiu','gphiv','gphif')
@@ -1311,5 +1333,5 @@
             ALLOCATE(tl_att(il_natt+1) )
             ! create attribute _FillValue
-            SELECT CASE(TRIM(cl_name))
+            SELECT CASE(TRIM(fct_lower(cl_name)))
                CASE DEFAULT
                   CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
@@ -1353,6 +1375,8 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - Bug fix: use order to disorder table (see dim_init)
+   !>
    !> @param[in] td_file   file structure
    !> @param[in] id_ndim   number of dimension
@@ -1371,5 +1395,5 @@
 
       ! local variable
-      INTEGER(i4), DIMENSION(ip_maxdim) :: il_2xyzt
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_xyzt2
 
       TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
@@ -1395,17 +1419,17 @@
 
          DO ji = 1, id_ndim
-            CALL logger_trace( " IOM CDF READ VAR DIM: get variable dimension "//&
-            &               TRIM(fct_str(ji)) )
-
-            il_2xyzt(ji)=td_file%t_dim(id_dimid(ji))%i_2xyzt
+            CALL logger_debug( " IOM CDF READ VAR DIM: get variable "//&
+               &  "dimension "//TRIM(fct_str(ji)) )
+
+            il_xyzt2(ji)=td_file%t_dim(id_dimid(ji))%i_xyzt2
 
             ! read dimension information
-            tl_dim(ji) = dim_init( td_file%t_dim(il_2xyzt(ji))%c_name, &
-            &                      td_file%t_dim(il_2xyzt(ji))%i_len )
+            tl_dim(ji) = dim_init( td_file%t_dim(il_xyzt2(ji))%c_name, &
+            &                      td_file%t_dim(il_xyzt2(ji))%i_len )
          ENDDO
 
          ! reorder dimension to ('x','y','z','t')
          CALL dim_reorder(tl_dim(:))
-      
+ 
          iom_cdf__read_var_dim(:)=dim_copy(tl_dim(:))
 
@@ -1426,5 +1450,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1475,5 +1499,7 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - use scale factor and offset, as soon as read variable value
    !
    !> @param[in] td_file   file structure
@@ -1482,7 +1508,4 @@
    !> @param[in] id_count  number of indices selected along each dimension
    !> @return variable structure completed 
-   !
-   !> @todo
-   !> - warning do not change fill value when use scale factor..
    !-------------------------------------------------------------------
    SUBROUTINE iom_cdf__read_var_value(td_file, td_var, &
@@ -1496,12 +1519,13 @@
 
       ! local variable
-      INTEGER(i4)                       :: il_status
-      INTEGER(i4)                       :: il_tmp1
-      INTEGER(i4)                       :: il_tmp2
-      INTEGER(i4)                       :: il_varid
-      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
-      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
-      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start_ord
-      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count_ord
+      INTEGER(i4)                                    :: il_status
+      INTEGER(i4)                                    :: il_tmp1
+      INTEGER(i4)                                    :: il_tmp2
+      INTEGER(i4)                                    :: il_varid
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start_ord
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count_ord
+
       REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
       REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_tmp
@@ -1518,6 +1542,6 @@
          IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. &
              ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN
-            CALL logger_warn( &
-            &  "IOM CDF READ VAR VALUE: id_start and id_count should be both specify")
+            CALL logger_warn( "IOM CDF READ VAR VALUE: id_start and id_count"//&
+               & " should be both specify")
          ENDIF
          IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
@@ -1525,7 +1549,7 @@
             IF( SIZE(id_start(:)) /= ip_maxdim .OR. &
             &   SIZE(id_count(:)) /= ip_maxdim )THEN
-               CALL logger_error("IOM CDF READ VAR: dimension of array start or count "//&
-               &      " are invalid to read variable "//TRIM(td_var%c_name)//&
-               &      " in file "//TRIM(td_file%c_name) )
+               CALL logger_error("IOM CDF READ VAR: dimension of array start"//&
+                  &  " or count are invalid to read variable "//&
+                  &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name) )
             ENDIF
 
@@ -1564,7 +1588,4 @@
             &    td_var%t_dim( 4 )%i_len &
             &                                            /)) )THEN
-
-            CALL logger_error( "IOM CDF READ VAR VALUE: start + count exceed "//&
-            &  "variable dimension for "//TRIM(td_var%c_name) )
 
             DO ji = 1, ip_maxdim
@@ -1575,8 +1596,10 @@
                &  TRIM(fct_str(il_tmp2)))
             ENDDO
+            CALL logger_error( "IOM CDF READ VAR VALUE: start + count exceed "//&
+            &  "variable dimension for "//TRIM(td_var%c_name) )
 
          ELSE
 
-            ! Allocate space to hold variable value (unorder)
+            ! Allocate space to hold variable value (disorder)
             ALLOCATE(dl_value( il_count(1), &
                &               il_count(2), &
@@ -1601,5 +1624,5 @@
             &                                       start = il_start(:),&
             &                                       count = il_count(:) )
-            CALL iom_cdf__check(il_status)
+            CALL iom_cdf__check(il_status,"IOM CDF READ VAR VALUE: ")
 
             ! Allocate space to hold variable value in structure
@@ -1663,4 +1686,11 @@
                CALL var_chg_FillValue(td_var)
             ENDIF
+
+            ! use scale factor and offset
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:)*td_var%d_scf + td_var%d_ofs
+            END WHERE
+
          ENDIF
       ELSE
@@ -1673,17 +1703,25 @@
    !-------------------------------------------------------------------
    !> @brief This subroutine write file structure in an opened netcdf file.
-   !
-   !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !>
+   !> @details
+   !> optionally, you could specify dimension order (default 'xyzt')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - add dimension order option 
    !
    !> @param[inout] td_file   file structure
    !-------------------------------------------------------------------
-   SUBROUTINE iom_cdf_write_file(td_file)
-      IMPLICIT NONE
-      ! Argument      
-      TYPE(TFILE), INTENT(INOUT) :: td_file
+   SUBROUTINE iom_cdf_write_file(td_file, cd_dimorder)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
 
       ! local variable
       INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_value
+
+      CHARACTER(LEN=lc)                      :: cl_dimorder
 
       TYPE(TVAR)                             :: tl_var
@@ -1694,5 +1732,9 @@
       INTEGER(i4) :: ji
       INTEGER(i4) :: jj
-      !----------------------------------------------------------------
+      INTEGER(i4) :: jvar
+      !----------------------------------------------------------------
+
+      cl_dimorder='xyzt'
+      IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(cd_dimorder)
 
       ! check if file opened
@@ -1726,4 +1768,13 @@
             ENDIF
 
+            ! change dimension order
+            IF( TRIM(cl_dimorder) /= 'xyzt' )THEN
+               CALL dim_reorder(td_file%t_dim(:),TRIM(cl_dimorder))
+               DO jvar=1,td_file%i_nvar
+                  CALL logger_debug("VAR REORDER: "//TRIM(td_file%t_var(jvar)%c_name))
+                  CALL var_reorder(td_file%t_var(jvar),TRIM(cl_dimorder))
+               ENDDO
+            ENDIF
+
             ! write dimension in file
             DO ji = 1, ip_maxdim
@@ -1776,5 +1827,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1798,5 +1849,5 @@
          ! Enter define mode
          il_status=NF90_REDEF(td_file%i_id)
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
 
          td_file%l_def=.TRUE.
@@ -1813,9 +1864,9 @@
             il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), &
             &                      NF90_UNLIMITED, td_dim%i_id)
-            CALL iom_cdf__check(il_status)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
 
          ELSE
             ! write not unlimited dimension
-            CALL logger_trace( &
+            CALL logger_debug( &
             &  "IOM CDF WRITE FILE DIM: write dimension "//TRIM(td_dim%c_name)//&
             &  " in file "//TRIM(td_file%c_name))
@@ -1823,5 +1874,5 @@
             il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), &
             &                      td_dim%i_len, td_dim%i_id)
-            CALL iom_cdf__check(il_status)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
 
          ENDIF
@@ -1834,5 +1885,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1859,5 +1910,5 @@
          ! Enter define mode
          il_status=NF90_REDEF(td_file%i_id)
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
 
          td_file%l_def=.TRUE.
@@ -1876,5 +1927,5 @@
             il_status = NF90_PUT_ATT(td_file%i_id, id_varid, &
             &  td_att%c_name, td_att%c_value )
-            CALL iom_cdf__check(il_status)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
 
          CASE(NF90_BYTE, NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE)
@@ -1882,5 +1933,5 @@
             il_status = NF90_PUT_ATT(td_file%i_id, id_varid, &
             &  td_att%c_name, td_att%d_value )
-            CALL iom_cdf__check(il_status)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
 
       END SELECT
@@ -1891,5 +1942,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1917,10 +1968,10 @@
          ! Enter define mode
          il_status=NF90_REDEF(td_file%i_id)
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ")
 
          td_file%l_def=.TRUE.
 
       ENDIF
-      
+ 
       ! check if file and variable dimension conform
       IF( file_check_var_dim(td_file, td_var) )THEN
@@ -1938,10 +1989,15 @@
             ENDIF
          ENDDO
+         ! ugly patch until NEMO do not force to use 0. as FillValue 
          IF( ll_chg )THEN
             ! not a dimension variable
             ! change FillValue
-
-            ! ugly patch until NEMO do not force to use 0. as FillValue 
-            CALL var_chg_FillValue(td_var,0._dp)
+            SELECT CASE( TRIM(fct_lower(td_var%c_name)) )
+               CASE DEFAULT
+                  CALL var_chg_FillValue(td_var,0._dp)
+               CASE('nav_lon','nav_lat', &
+                  & 'glamt','glamu','glamv','glamf', &
+                  & 'gphit','gphiu','gphiv','gphif')
+            END SELECT
          ENDIF
 
@@ -1957,5 +2013,5 @@
             ! Leave define mode
             il_status=NF90_ENDDEF(td_file%i_id)
-            CALL iom_cdf__check(il_status)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ")
 
             td_file%l_def=.FALSE.
@@ -1975,5 +2031,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -2002,9 +2058,17 @@
       tl_var=var_copy(td_var)
 
+      ! forced to use float type
+      IF( tl_var%d_unf /= 1. .AND. tl_var%i_type==NF90_SHORT )THEN
+         tl_var%i_type=NF90_FLOAT
+      ENDIF
+
       IF( ALL( .NOT. tl_var%t_dim(:)%l_use ) )THEN
+         CALL logger_debug( &
+         &  "IOM CDF WRITE VAR DEF scalar: define variable "//&
+         &  TRIM(tl_var%c_name)//" in file "//TRIM(td_file%c_name))
          ! scalar value
          il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name), &
          &                        tl_var%i_type, varid=iom_cdf__write_var_def) 
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
       ELSE
 
@@ -2020,16 +2084,17 @@
          ENDDO
 
-         CALL logger_trace( &
+         CALL logger_debug( &
          &  "IOM CDF WRITE VAR DEF: define dimension to be used for variable "//&
          &  TRIM(tl_var%c_name)//" in file "//TRIM(td_file%c_name))
 
          DO ji=1,jj
-            CALL logger_trace("IOM CDF WRITE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) )
+            CALL logger_debug("IOM CDF WRITE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) )
          ENDDO
+
          il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name),     &
          &                        tl_var%i_type,                         &
          &                        il_dimid(1:jj),                        &
          &                        varid=iom_cdf__write_var_def           )
-         CALL iom_cdf__check(il_status)
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
       ENDIF
 
@@ -2043,8 +2108,13 @@
 
       DO ji = 1, tl_var%i_natt
-         CALL logger_trace( &
+         CALL logger_debug( &
          &  " IOM CDF WRITE VAR DEF: put attribute "//TRIM(tl_var%t_att(ji)%c_name)//&
          &  " for variable "//TRIM(tl_var%c_name)//&
          &  " in file "//TRIM(td_file%c_name) )
+
+         ! forced FillValue to have same type than variable
+         IF( TRIM(tl_var%t_att(ji)%c_name) == '_FillValue' )THEN
+            tl_var%t_att(ji)%i_type=tl_var%i_type
+         ENDIF
 
          IF( tl_var%t_att(ji)%i_type == NF90_CHAR )THEN
@@ -2053,5 +2123,5 @@
                &                        TRIM(tl_var%t_att(ji)%c_name),        &
                &                        TRIM(tl_var%t_att(ji)%c_value)        )
-               CALL iom_cdf__check(il_status)
+               CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
             ENDIF
          ELSE
@@ -2082,6 +2152,6 @@
                   &                        TRIM(tl_var%t_att(ji)%c_name),  &
                   &                        REAL(tl_var%t_att(ji)%d_value(:),dp))
-               END SELECT
-            CALL iom_cdf__check(il_status)
+            END SELECT
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
          ENDIF
       ENDDO
@@ -2097,5 +2167,7 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - reuse scale factor and offset, before writing variable
    !
    !> @param[in] td_file   file structure
@@ -2122,5 +2194,11 @@
       &  "IOM CDF WRITE VAR VALUE: get dimension to be used for variable "//&
       &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name))
-
+   
+      ! use scale factor and offset
+      WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+         td_var%d_value(:,:,:,:) = &
+         &  (td_var%d_value(:,:,:,:)-td_var%d_ofs)/td_var%d_scf
+      END WHERE
+      
       jj=0
       DO ji = 1, ip_maxdim
@@ -2153,5 +2231,5 @@
 
       il_status = NF90_PUT_VAR( td_file%i_id, td_var%i_id, dl_value(:,:,:,:))
-      CALL iom_cdf__check(il_status)
+      CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE: ")
 
       DEALLOCATE( dl_value )
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90	(revision 5682)
@@ -71,5 +71,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[inout] td_mpp mpp structure
@@ -106,5 +106,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[in] td_mpp mpp structure
@@ -130,5 +130,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @param[in] td_mpp    mpp structure
@@ -194,5 +194,5 @@
    !
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -246,5 +246,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @todo
@@ -411,5 +411,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -465,5 +465,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @param[in] td_mpp    mpp structure
@@ -524,5 +524,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !>
    !> @param[in] td_mpp    mpp structure
@@ -636,5 +636,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -663,5 +663,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -691,5 +691,5 @@
    !>
    !> @author J.Paul
-   !> - October, 2014- Initial Version
+   !> @date October, 2014 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90	(revision 5682)
@@ -87,5 +87,5 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date Nov, 2013 - Initial Version
+!> @date November, 2013 - Initial Version
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -137,5 +137,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_mpp mpp structure
@@ -161,4 +161,7 @@
 
       ELSE
+         ! 
+         td_mpp%i_id=1
+
          ! if no processor file selected
          ! force to open all files 
@@ -221,5 +224,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_mpp mpp structure
@@ -248,5 +251,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_mpp mpp structure
@@ -267,4 +270,7 @@
 
       ELSE
+         ! 
+         td_mpp%i_id=0         
+
          DO ji=1,td_mpp%i_nproc
             IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN
@@ -285,5 +291,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - use start and count array instead of domain structure.
@@ -314,5 +320,11 @@
          &               " in mpp strcuture "//TRIM(td_mpp%c_name))
 
+      ELSEIF( td_mpp%i_id == 0 )THEN
+
+         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//&
+         &               " can not read variable in "//TRIM(td_mpp%c_name))   
+      
       ELSE
+
 
          IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN
@@ -355,5 +367,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - use start and count array instead of domain structure.
@@ -384,4 +396,9 @@
          &               " in mpp strcuture "//TRIM(td_mpp%c_name))
 
+      ELSEIF( td_mpp%i_id == 0 )THEN
+
+         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//&
+         &               " can not read variable in "//TRIM(td_mpp%c_name))   
+      
       ELSE
 
@@ -400,5 +417,5 @@
                CALL logger_error( &
                &  " IOM MPP READ VAR: there is no variable with "//&
-               &  "name or standard name"//TRIM(cd_name)//&
+               &  "name or standard name "//TRIM(cd_name)//&
                &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name))
             ENDIF
@@ -416,5 +433,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - use start and count array instead of domain structure.
@@ -467,4 +484,15 @@
       IF( PRESENT(id_count) ) il_count(:)=id_count(:)
 
+      CALL logger_debug("IOM MPP READ VAR VALUE: start "//&
+               &  TRIM(fct_str(il_start(jp_I)))//","//&
+               &  TRIM(fct_str(il_start(jp_J)))//","//&
+               &  TRIM(fct_str(il_start(jp_K)))//","//&
+               &  TRIM(fct_str(il_start(jp_L))) )
+      CALL logger_debug("IOM MPP READ VAR VALUE: count "//&
+               &  TRIM(fct_str(il_count(jp_I)))//","//&
+               &  TRIM(fct_str(il_count(jp_J)))//","//&
+               &  TRIM(fct_str(il_count(jp_K)))//","//&
+               &  TRIM(fct_str(il_count(jp_L))) )
+
       DO jk=1,ip_maxdim
          IF( .NOT. td_var%t_dim(jk)%l_use )THEN
@@ -476,6 +504,15 @@
       ENDDO
 
-
       IF( ANY(il_end(:) > td_mpp%t_dim(:)%i_len) )THEN
+            CALL logger_debug("IOM MPP READ VAR VALUE: start + count "//&
+               &  TRIM(fct_str(il_end(jp_I)))//","//&
+               &  TRIM(fct_str(il_end(jp_J)))//","//&
+               &  TRIM(fct_str(il_end(jp_K)))//","//&
+               &  TRIM(fct_str(il_end(jp_L))) )
+            CALL logger_debug("IOM MPP READ VAR VALUE: dimension "//&
+               &  TRIM(fct_str(td_mpp%t_dim(jp_I)%i_len))//","//&
+               &  TRIM(fct_str(td_mpp%t_dim(jp_J)%i_len))//","//&
+               &  TRIM(fct_str(td_mpp%t_dim(jp_K)%i_len))//","//&
+               &  TRIM(fct_str(td_mpp%t_dim(jp_L)%i_len)) )
             CALL logger_fatal("IOM MPP READ VAR VALUE: start + count "//&
             &                 "exceed dimension bound.")
@@ -583,14 +620,18 @@
    !
    !> @details
+   !> optionally, you could specify the dimension order (default 'xyzt')
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 - add dimension order option 
    !
    !> @param[inout] td_mpp mpp structure
-   !-------------------------------------------------------------------
-   SUBROUTINE iom_mpp_write_file(td_mpp)
+   !> @param[In] cd_dimorder dimension order
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_mpp_write_file(td_mpp, cd_dimorder)
       IMPLICIT NONE
       ! Argument      
-      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp
+      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
 
       ! local variable
@@ -610,5 +651,5 @@
                !CALL file_del_att(td_mpp%t_proc(ji), 'ew_overlap')
 
-               CALL iom_write_file(td_mpp%t_proc(ji))
+               CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder)
             ELSE
                CALL logger_debug( " MPP WRITE: no id associated to file "//&
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90	(revision 5682)
@@ -131,5 +131,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -284,5 +284,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -328,5 +328,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -394,5 +394,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -544,5 +544,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -636,5 +636,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -688,5 +688,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -733,5 +733,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -778,5 +778,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -820,5 +820,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -863,5 +863,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -907,5 +907,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -972,5 +972,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1037,5 +1037,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file structure
@@ -1058,4 +1058,5 @@
       INTEGER(i4), DIMENSION(ip_maxdim)            :: il_start
       INTEGER(i4), DIMENSION(ip_maxdim)            :: il_count
+
       REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
 
@@ -1204,4 +1205,16 @@
       ENDIF
 
+      ! force to change _FillValue to avoid mistake 
+      ! with dummy zero _FillValue
+      IF( td_var%d_fill == 0._dp )THEN
+         CALL var_chg_FillValue(td_var)
+      ENDIF
+
+      ! use scale factor and offset
+      WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+         td_var%d_value(:,:,:,:) = &
+         &  td_var%d_value(:,:,:,:)*td_var%d_scf + td_var%d_ofs
+      END WHERE
+
    END SUBROUTINE iom_rstdimg__read_var_value
    !-------------------------------------------------------------------
@@ -1212,5 +1225,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date September, 2014
    !> - use iom_rstdimg__get_rec
@@ -1308,5 +1321,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1413,5 +1426,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_file   file structure
@@ -1630,7 +1643,9 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015
+   !> - bug fix: do not use scale factor an offset for case no0d, no1d...
    !>
-   !> @param[in] id_fileid file id
+   !> @param[in] td_file file structure
    !-------------------------------------------------------------------
    SUBROUTINE iom_rstdimg__write_var(td_file)
@@ -1667,4 +1682,14 @@
             CASE('no0d','no1d','no2d','no3d')
             CASE DEFAULT
+               
+               ! use scale factor and offset
+               WHERE( td_file%t_var(ji)%d_value(:,:,:,:) /= &
+               &      td_file%t_var(ji)%d_fill )
+                  td_file%t_var(ji)%d_value(:,:,:,:) = &
+                  &   ( td_file%t_var(ji)%d_value(:,:,:,:) - &
+                  &     td_file%t_var(ji)%d_ofs ) / &
+                  &   td_file%t_var(ji)%d_scf
+               END WHERE
+
                DO jk=1,td_file%t_var(ji)%t_dim(3)%i_len
                   SELECT CASE (td_file%t_var(ji)%i_ndim)
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/logger.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/logger.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/logger.f90	(revision 5682)
@@ -16,6 +16,7 @@
 !> but not necessarily "wrong". 
 !>    - error : Other runtime errors or unexpected conditions.
-!>    - fatal : Severe errors that cause premature termination.<br />
+!>    - fatal : Severe errors that cause premature termination.
 !>  default verbosity is warning
+!>    - none  : to not create and write any information in logger file.<br />
 !
 !> If total number of error exceeded maximum number 
@@ -24,5 +25,5 @@
 !> to open/create logger file:<br/>
 !> @code
-!>    CALL logger_open(cd_file, [cd_verbosity,] [id_loggerid,] [id_maxerror])
+!>    CALL logger_open(cd_file, [cd_verbosity,] [id_maxerror,] [id_loggerid])
 !> @endcode
 !> - cd_file is logger file name
@@ -120,5 +121,8 @@
 !> J.Paul
 ! REVISION HISTORY:
-!> @date November, 2013- Initial Version
+!> @date November, 2013 - Initial Version
+!> @date February, 2015
+!> - check verbosity validity
+!> - add 'none' verbosity level to not used logger file
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -151,7 +155,9 @@
 
    PRIVATE :: logger__write     ! cut message to get maximum of 80 character by line in log file
+   PRIVATE :: logger__check_verb! check verbosity validity
 
    TYPE TLOGGER   !< logger structure
       INTEGER(i4)       :: i_id = 0                 !< log file id
+      LOGICAL           :: l_use=.TRUE.             !< use logger or not
       CHARACTER(LEN=lc) :: c_name                   !< log file name
       CHARACTER(LEN=lc) :: c_verbosity = "warning"  !< verbosity choose
@@ -163,5 +169,5 @@
 
    !  module variable
-   INTEGER(i4), PARAMETER :: im_nverbosity=6     !< number of log level
+   INTEGER(i4), PARAMETER :: im_nverbosity=7     !< number of log level
    CHARACTER(len=*), DIMENSION(im_nverbosity), PARAMETER :: cm_verbosity= & !< verbosity array 
    &               (/ 'trace   ',&
@@ -170,5 +176,6 @@
    &                  'warning ',&
    &                  'error   ',&
-   &                  'fatal   '/)
+   &                  'fatal   ',&
+   &                  'none    '/)
 
    TYPE(TLOGGER), SAVE :: tm_logger      !< logger structure
@@ -184,62 +191,74 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_file      log file name
    !> @param[in] cd_verbosity log file verbosity
+   !> @param[in] id_maxerror  maximum number of error
    !> @param[in] id_logid     log file id (use to flush)
-   !> @param[in] id_maxerror  maximum number of error
-   !-------------------------------------------------------------------
-   SUBROUTINE logger_open(cd_file, cd_verbosity, id_logid, id_maxerror)
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_open(cd_file, cd_verbosity, id_maxerror, id_logid)
       IMPLICIT NONE
       ! Argument
       CHARACTER(len=*), INTENT(IN) :: cd_file                ! log file name
       CHARACTER(len=*), INTENT(IN), OPTIONAL :: cd_verbosity ! log file verbosity
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_maxerror  ! log max error
       INTEGER(i4),      INTENT(IN), OPTIONAL :: id_logid     ! log file id
-      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_maxerror  ! log max error
 
       ! local variable
       INTEGER(i4) :: il_status
 
+      LOGICAL     :: ll_valid
+
       ! loop
       INTEGER(i4) :: ji
       !----------------------------------------------------------------
-      ! get id if not already define
-      IF( PRESENT(id_logid) )THEN
-         tm_logger%i_id=id_logid
-      ELSE
-         tm_logger%i_id=fct_getunit()
-      ENDIF
-
-      ! open log file
-      OPEN( tm_logger%i_id, &
-      &     STATUS="unknown",    &
-      &     FILE=TRIM(ADJUSTL(cd_file)),  &
-      &     ACTION="write",      &
-      &     POSITION="append",   &
-      &     IOSTAT=il_status)
-      CALL fct_err(il_status)
-
-      ! keep filename
-      tm_logger%c_name=TRIM(ADJUSTL(cd_file))
 
       ! if present, change verbosity value
       IF( PRESENT(cd_verbosity) )THEN
-         tm_logger%c_verbosity=TRIM(ADJUSTL(cd_verbosity))
-      ENDIF
-
-      ! compute "tab" of verbosity to be used
-      IF( TRIM(ADJUSTL(tm_logger%c_verb)) == "" )THEN
-         DO ji=im_nverbosity,1,-1
-            tm_logger%c_verb = &
-            &  TRIM(tm_logger%c_verb)//" "//TRIM(ADJUSTL(cm_verbosity(ji)))
-            IF( TRIM(tm_logger%c_verbosity) == TRIM(cm_verbosity(ji)) )THEN
-               EXIT
-            ENDIF
-         ENDDO
-      ENDIF
-
-      IF( PRESENT(id_maxerror) )THEN
-         tm_logger%i_maxerror=id_maxerror
+         ll_valid=logger__check_verb(TRIM(ADJUSTL(cd_verbosity)))
+         IF( ll_valid )THEN
+            tm_logger%c_verbosity=TRIM(ADJUSTL(cd_verbosity))
+         ENDIF
+      ENDIF
+
+      IF( TRIM(tm_logger%c_verbosity) == 'none' ) tm_logger%l_use=.FALSE.
+      
+      IF( tm_logger%l_use )THEN
+
+         ! get id if not already define
+         IF( PRESENT(id_logid) )THEN
+            tm_logger%i_id=id_logid
+         ELSE
+            tm_logger%i_id=fct_getunit()
+         ENDIF
+
+         ! open log file
+         OPEN( tm_logger%i_id, &
+         &     STATUS="unknown",    &
+         &     FILE=TRIM(ADJUSTL(cd_file)),  &
+         &     ACTION="write",      &
+         &     POSITION="append",   &
+         &     IOSTAT=il_status)
+         CALL fct_err(il_status)
+
+         ! keep filename
+         tm_logger%c_name=TRIM(ADJUSTL(cd_file))
+
+         ! compute "tab" of verbosity to be used
+         IF( TRIM(ADJUSTL(tm_logger%c_verb)) == "" )THEN
+            DO ji=im_nverbosity,1,-1
+               tm_logger%c_verb = &
+               &  TRIM(tm_logger%c_verb)//" "//TRIM(ADJUSTL(cm_verbosity(ji)))
+               IF( TRIM(tm_logger%c_verbosity) == TRIM(cm_verbosity(ji)) )THEN
+                  EXIT
+               ENDIF
+            ENDDO
+         ENDIF
+
+         IF( PRESENT(id_maxerror) )THEN
+            tm_logger%i_maxerror=id_maxerror
+         ENDIF
+
       ENDIF
 
@@ -249,5 +268,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !-------------------------------------------------------------------
    SUBROUTINE logger_close()
@@ -256,13 +275,15 @@
       INTEGER(i4) :: il_status
       !----------------------------------------------------------------
-      IF( tm_logger%i_id /= 0 )THEN
-         tm_logger%i_id = 0
-         CLOSE( tm_logger%i_id, &
-         &      IOSTAT=il_status)      
-         CALL fct_err(il_status)
-      ELSE
-          CALL logger_open('logger.log')
-          CALL logger_header()
-          CALL logger_fatal('you must have create logger to use logger_close')
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            tm_logger%i_id = 0
+            CLOSE( tm_logger%i_id, &
+            &      IOSTAT=il_status)      
+            CALL fct_err(il_status)
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_close')
+         ENDIF
       ENDIF
 
@@ -272,17 +293,19 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !-------------------------------------------------------------------
    SUBROUTINE logger_flush()
       IMPLICIT NONE
       !----------------------------------------------------------------
-      IF( tm_logger%i_id /= 0 )THEN
-         CALL logger_close()
-         CALL logger_open( tm_logger%c_name, tm_logger%c_verbosity, tm_logger%i_id, &
-         &              tm_logger%i_maxerror )     
-      ELSE
-          CALL logger_open('logger.log')
-          CALL logger_header()
-          CALL logger_fatal('you must have create logger to use logger_flush')
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            CALL logger_close()
+            CALL logger_open( tm_logger%c_name, tm_logger%c_verbosity, &
+            &                 tm_logger%i_maxerror, tm_logger%i_id )     
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_flush')
+         ENDIF
       ENDIF
 
@@ -292,5 +315,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !-------------------------------------------------------------------
    RECURSIVE SUBROUTINE logger_header()
@@ -299,17 +322,19 @@
       INTEGER(i4)       :: il_status
       !----------------------------------------------------------------
-      IF( tm_logger%i_id /= 0 )THEN
-         WRITE( tm_logger%i_id,    &
-            &   FMT='(4(a/))',     &
-            &   IOSTAT=il_status ) &
-            &   "--------------------------------------------------",&
-            &   "INIT     : verbosity "//TRIM(tm_logger%c_verbosity),&
-            &   "INIT     : max error "//TRIM(fct_str(tm_logger%i_maxerror)), &
-            &   "--------------------------------------------------"
-         CALL fct_err(il_status)
-      ELSE
-          CALL logger_open('logger.log')
-          CALL logger_header()
-          CALL logger_fatal('you must have create logger to use logger_header')
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            WRITE( tm_logger%i_id,    &
+               &   FMT='(4(a/))',     &
+               &   IOSTAT=il_status ) &
+               &   "--------------------------------------------------",&
+               &   "INIT     : verbosity "//TRIM(tm_logger%c_verbosity),&
+               &   "INIT     : max error "//TRIM(fct_str(tm_logger%i_maxerror)), &
+               &   "--------------------------------------------------"
+            CALL fct_err(il_status)
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_header')
+         ENDIF
       ENDIF
 
@@ -319,5 +344,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !-------------------------------------------------------------------
    SUBROUTINE logger_footer()
@@ -326,20 +351,22 @@
       INTEGER(i4)       :: il_status
       !----------------------------------------------------------------
-      IF( tm_logger%i_id /= 0 )THEN
-         WRITE( tm_logger%i_id,    &
-            &   FMT='(4(/a))',     &
-            &   IOSTAT=il_status ) &
-            &   "--------------------------------------------------",&
-            &   "END      : log ended ",              &
-            &   "END      : "//TRIM(fct_str(tm_logger%i_nerror))//   &
-            &   " ERROR detected ",                                  &
-            &   "END      : "//TRIM(fct_str(tm_logger%i_nfatal))//   &
-            &   " FATAL detected ",                                  &
-            &   "--------------------------------------------------"
-         CALL fct_err(il_status)
-      ELSE
-          CALL logger_open('logger.log')
-          CALL logger_header()
-          CALL logger_fatal('you must have create logger to use logger_footer')
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            WRITE( tm_logger%i_id,    &
+               &   FMT='(4(/a))',     &
+               &   IOSTAT=il_status ) &
+               &   "--------------------------------------------------",&
+               &   "END      : log ended ",              &
+               &   "END      : "//TRIM(fct_str(tm_logger%i_nerror))//   &
+               &   " ERROR detected ",                                  &
+               &   "END      : "//TRIM(fct_str(tm_logger%i_nfatal))//   &
+               &   " FATAL detected ",                                  &
+               &   "--------------------------------------------------"
+            CALL fct_err(il_status)
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_footer')
+         ENDIF
       ENDIF
    END SUBROUTINE logger_footer
@@ -350,5 +377,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -361,19 +388,21 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
       !----------------------------------------------------------------
-      IF( tm_logger%i_id /= 0 )THEN
-         IF( INDEX(TRIM(tm_logger%c_verb),'trace')/=0 )THEN
-
-            CALL logger__write("TRACE   :",cd_msg)
-
-            IF( PRESENT(ld_flush) )THEN
-               IF( ld_flush )THEN
-                  CALL logger_flush()
-               ENDIF
-            ENDIF      
-         ENDIF
-      ELSE
-          CALL logger_open('logger.log')
-          CALL logger_header()
-          CALL logger_fatal('you must have create logger to use logger_trace')
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'trace')/=0 )THEN
+
+               CALL logger__write("TRACE   :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_trace')
+         ENDIF
       ENDIF
    END SUBROUTINE logger_trace
@@ -384,5 +413,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -395,19 +424,21 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
       !----------------------------------------------------------------
-      IF( tm_logger%i_id /= 0 )THEN
-         IF( INDEX(TRIM(tm_logger%c_verb),'debug')/=0 )THEN
-
-            CALL logger__write("DEBUG   :",cd_msg)
-
-            IF( PRESENT(ld_flush) )THEN
-               IF( ld_flush )THEN
-                  CALL logger_flush()
-               ENDIF
-            ENDIF      
-         ENDIF
-      ELSE
-          CALL logger_open('logger.log')
-          CALL logger_header()
-          CALL logger_fatal('you must have create logger to use logger_debug')
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'debug')/=0 )THEN
+
+               CALL logger__write("DEBUG   :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_debug')
+         ENDIF
       ENDIF
    END SUBROUTINE logger_debug
@@ -418,5 +449,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -429,19 +460,21 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
       !----------------------------------------------------------------
-      IF( tm_logger%i_id /= 0 )THEN
-         IF( INDEX(TRIM(tm_logger%c_verb),'info')/=0 )THEN
-
-            CALL logger__write("INFO    :",cd_msg)
-
-            IF( PRESENT(ld_flush) )THEN
-               IF( ld_flush )THEN
-                  CALL logger_flush()
-               ENDIF
-            ENDIF      
-         ENDIF
-      ELSE
-          CALL logger_open('logger.log')
-          CALL logger_header()
-          CALL logger_fatal('you must have create logger to use logger_info')
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'info')/=0 )THEN
+
+               CALL logger__write("INFO    :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_info')
+         ENDIF
       ENDIF
    END SUBROUTINE logger_info
@@ -452,5 +485,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -463,19 +496,21 @@
       LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
       !----------------------------------------------------------------
-      IF( tm_logger%i_id /= 0 )THEN
-         IF( INDEX(TRIM(tm_logger%c_verb),'warn')/=0 )THEN
-
-            CALL logger__write("WARNING :",cd_msg)
-
-            IF( PRESENT(ld_flush) )THEN
-               IF( ld_flush )THEN
-                  CALL logger_flush()
-               ENDIF
-            ENDIF      
-         ENDIF
-      ELSE
-          CALL logger_open('logger.log')
-          CALL logger_header()
-          CALL logger_fatal('you must have create logger to use logger_warn')
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'warn')/=0 )THEN
+
+               CALL logger__write("WARNING :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_warn')
+         ENDIF
       ENDIF
    END SUBROUTINE logger_warn
@@ -486,5 +521,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg    message to write
@@ -500,30 +535,33 @@
       CHARACTER(LEN=lc) :: cl_nerror
       !----------------------------------------------------------------
-      IF( tm_logger%i_id /= 0 )THEN
-         ! increment the error number
-         tm_logger%i_nerror=tm_logger%i_nerror+1
-
-         IF( INDEX(TRIM(tm_logger%c_verb),'error')/=0 )THEN
-
-            CALL logger__write("ERROR   :",cd_msg)
-
-            IF( PRESENT(ld_flush) )THEN
-               IF( ld_flush )THEN
-                  CALL logger_flush()
-               ENDIF
-            ENDIF      
-         ENDIF
-
-         IF( tm_logger%i_nerror >= tm_logger%i_maxerror )THEN
-            WRITE(cl_nerror,*) tm_logger%i_maxerror
-            CALL logger_fatal(&
-            &  'Error count reached limit of '//TRIM(ADJUSTL(cl_nerror)) )
-         ENDIF
-      ELSE
-          CALL logger_open('logger.log')
-          CALL logger_header()
-          CALL logger_fatal('you must have create logger to use logger_error')
-      ENDIF
-
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( TRIM(tm_logger%c_verb) /= 'none' )THEN
+               ! increment the error number
+               tm_logger%i_nerror=tm_logger%i_nerror+1
+            ENDIF
+
+            IF( INDEX(TRIM(tm_logger%c_verb),'error')/=0 )THEN
+
+               CALL logger__write("ERROR   :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+
+            IF( tm_logger%i_nerror >= tm_logger%i_maxerror )THEN
+               WRITE(cl_nerror,*) tm_logger%i_maxerror
+               CALL logger_fatal(&
+               &  'Error count reached limit of '//TRIM(ADJUSTL(cl_nerror)) )
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_error')
+         ENDIF
+      ENDIF
    END SUBROUTINE logger_error
    !-------------------------------------------------------------------
@@ -532,5 +570,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_msg message to write
@@ -541,21 +579,23 @@
       CHARACTER(LEN=*),           INTENT(IN) :: cd_msg
       !----------------------------------------------------------------
-      IF( tm_logger%i_id /= 0 )THEN
-         IF( INDEX(TRIM(tm_logger%c_verb),'fatal')/=0 )THEN
-            ! increment the error number
-            tm_logger%i_nfatal=tm_logger%i_nfatal+1
-
-            CALL logger__write("FATAL   :",cd_msg)
-
-            CALL logger_footer()
-            CALL logger_close()
-
-            WRITE(*,*) 'FATAL ERROR'
-            STOP
-         ENDIF
-      ELSE
-          CALL logger_open('logger.log')
-          CALL logger_header()
-          CALL logger_fatal('you must have create logger to use logger_fatal')
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'fatal')/=0 )THEN
+               ! increment the error number
+               tm_logger%i_nfatal=tm_logger%i_nfatal+1
+
+               CALL logger__write("FATAL   :",cd_msg)
+
+               CALL logger_footer()
+               CALL logger_close()
+
+               WRITE(*,*) 'FATAL ERROR'
+               STOP
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_fatal')
+         ENDIF
       ENDIF
    END SUBROUTINE logger_fatal
@@ -565,5 +605,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_verb   verbosity of the message to write
@@ -615,4 +655,43 @@
 
    END SUBROUTINE logger__write
+   !-------------------------------------------------------------------
+   !> @brief This function check validity of verbosity.
+   !>
+   !> @author J.Paul
+   !> @date February, 2015 - Initial Version
+   !
+   !> @param[in] cd_verb   verbosity of the message to write
+   !> @return verbosity is valid or not
+   !-------------------------------------------------------------------
+   FUNCTION logger__check_verb(cd_verb)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),           INTENT(IN) :: cd_verb
+
+      !function
+      LOGICAL           :: logger__check_verb
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+
+      !----------------------------------------------------------------
+      logger__check_verb=.FALSE.
+
+      DO ji=1,im_nverbosity
+         IF( TRIM(cd_verb) == TRIM(cm_verbosity(ji)) )THEN
+            logger__check_verb=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+      IF( .NOT. logger__check_verb )THEN
+         CALL logger_open('logger.log')
+         CALL logger_header()
+         CALL logger_fatal('LOGGER : invalid verbosity, check namelist.'//&
+         &                 ' default one will be used.')
+         CALL logger_footer()
+      ENDIF
+   END FUNCTION logger__check_verb
 END MODULE logger
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/math.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/math.f90	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/math.f90	(revision 5682)
@@ -0,0 +1,1285 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: math
+!
+! DESCRIPTION:
+!> @brief
+!> This module groups some useful mathematical function.
+!>
+!> @details
+!> 
+!>    to compute the mean of an array:<br/>
+!> @code
+!>    dl_value=math_mean( dl_value, dd_fill )
+!> @endcode
+!>       - dl_value is 1D or 2D array
+!>       - dd_fill is FillValue
+!>
+!>    to compute the median of an array:<br/>
+!> @code
+!>    dl_value=math_median( dl_value, dd_fill )
+!> @endcode
+!>       - dl_value is 1D or 2D array
+!>       - dd_fill is FillValue
+!>
+!>    to compute the mean without extremum of an array:<br/>
+!> @code
+!>    dl_value=math_mwe( dl_value, id_next, dd_fill )
+!> @endcode
+!>       - dl_value is 1D or 2D array
+!>       - id_next is the number of extremum to be removed
+!>       - dd_fill is FillValue
+!>
+!>    to sort an 1D array:<br/>
+!> @code
+!>    CALL math_QsortC(dl_value)
+!> @endcode
+!>       - dl_value is 1D array
+!>
+!>    to correct phase angles to produce smoother phase:<br/>
+!> @code
+!>    CALL math_unwrap(dl_value, [dl_discont])
+!> @endcode
+!>       - dl_value is 1D array
+!>       - dl_discont maximum discontinuity between values, default pi
+!>
+!>    to compute simple operation
+!> @code
+!>    dl_res=math_compute(cl_var)
+!> @endcode
+!>       - cl_var operation to compute (string of character)
+!>       - dl_res result of the operation, real(dp)
+!>
+!>    to compute first derivative of 1D array:<br/>
+!> @code
+!>    dl_value(:)=math_deriv_1D( dd_value(:), dd_fill, [ld_discont] )
+!> @endcode
+!>       - dd_value is 1D array of variable
+!>       - dd_fill is FillValue of variable
+!>       - ld_discont is logical to take into account longitudinal 
+!>         East-West discontinuity [optional]
+!>
+!>    to compute first derivative of 2D array:<br/>
+!> @code
+!>    dl_value(:,:)=math_deriv_2D( dd_value(:,:), dd_fill, cd_dim, 
+!>                  [ld_discont] )
+!> @endcode
+!>       - dd_value is 2D array of variable
+!>       - dd_fill is FillValue of variable
+!>       - cd_dim is character to compute derivative on first (I) or
+!>         second (J) dimension
+!>       - ld_discont is logical to take into account longitudinal 
+!>         East-West discontinuity [optional]
+!>
+!>    to compute first derivative of 3D array:<br/>
+!> @code
+!>    dl_value(:,:,:)=math_deriv_3D( dd_value(:,:,:), dd_fill, cd_dim,
+!>                    [ld_discont] )
+!> @endcode
+!>       - dd_value is 3D array of variable
+!>       - dd_fill is FillValue of variable
+!>       - cd_dim is character to compute derivative on first (I), second (J),
+!>         or third (K) dimension
+!>       - ld_discont is logical to take into account longitudinal East-West 
+!>         discontinuity [optional]
+!>
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date January, 2015 - Initial version
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE math
+   USE kind                            ! F90 kind parameter
+   USE global                          ! global variable
+   USE phycst                          ! physical constant
+   USE fct                             ! basic useful function
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: math_mean      !< return mean of an array
+   PUBLIC :: math_median    !< return median of an array
+   PUBLIC :: math_mwe       !< return mean without extremum of an array
+   PUBLIC :: math_QsortC    !< sort an 1D array
+   PUBLIC :: math_unwrap    !< correct phase angles to produce smoother phase
+   PUBLIC :: math_compute   !< compute simple operation
+   PUBLIC :: math_deriv_1D  !< compute first derivative of 1D array 
+   PUBLIC :: math_deriv_2D  !< compute first derivative of 2D array 
+   PUBLIC :: math_deriv_3D  !< compute first derivative of 3D array
+
+
+   PRIVATE :: math__Partition
+   PRIVATE :: math__mean_1d
+   PRIVATE :: math__mean_2d
+   PRIVATE :: math__median_1d
+   PRIVATE :: math__median_2d
+   PRIVATE :: math__mwe_1d
+   PRIVATE :: math__mwe_2d
+   PRIVATE :: math__parentheses
+
+
+   INTERFACE math_mean
+      MODULE PROCEDURE math__mean_1d ! return mean of an array 1D
+      MODULE PROCEDURE math__mean_2d ! return mean of an array 2D
+   END INTERFACE math_mean
+
+   INTERFACE math_median
+      MODULE PROCEDURE math__median_1d ! return median of an array 1D
+      MODULE PROCEDURE math__median_2d ! return median of an array 2D
+   END INTERFACE math_median
+
+   INTERFACE math_mwe
+      MODULE PROCEDURE math__mwe_1d ! return mean without extremum of an array 1D
+      MODULE PROCEDURE math__mwe_2d ! return mean without extremum of an array 2D
+   END INTERFACE math_mwe
+
+CONTAINS
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the mean of a 1D array. 
+   ! 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   ! 
+   !> @param[in] dd_array  1D array 
+   !> @param[in] dd_fill   fillValue
+   !> @return mean value, real(dp)
+   !------------------------------------------------------------------- 
+   PURE REAL(dp) FUNCTION math__mean_1d(dd_array, dd_fill)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_array
+      REAL(dp),               INTENT(IN), OPTIONAL :: dd_fill
+
+      ! local variable
+      INTEGER(i4)  :: il_count
+      REAL(dp)     :: dl_sum
+      REAL(dp)     :: dl_count
+      !----------------------------------------------------------------
+      
+      IF( PRESENT(dd_fill) )THEN
+         il_count=COUNT(dd_array(:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            dl_sum  =SUM ( dd_array(:), dd_array(:)/= dd_fill )
+            dl_count=REAL( il_count, dp)
+
+            math__mean_1d=dl_sum/dl_count
+         ELSE
+            math__mean_1d=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:))
+         IF( il_count > 0 )THEN
+            dl_sum  =SUM ( dd_array(:) )
+            dl_count=REAL( il_count, dp)
+
+            math__mean_1d=dl_sum/dl_count
+         ELSE
+            math__mean_1d=0
+         ENDIF
+      ENDIF
+
+   END FUNCTION math__mean_1d
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the mean of a 2D array. 
+   ! 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   ! 
+   !> @param[in] dd_array  2D array 
+   !> @param[in] dd_fill   fillValue
+   !> @return mean value, real(dp)
+   !------------------------------------------------------------------- 
+   PURE REAL(dp) FUNCTION math__mean_2d(dd_array, dd_fill)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_array
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
+
+      ! local variable
+      INTEGER(i4)                         :: il_count
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:,:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:),dd_array(:,:)/=dd_fill)
+         ELSE
+            math__mean_2d=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:), MASK=.TRUE.)
+         ELSE
+            math__mean_2d=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) )THEN
+         math__mean_2d=math_mean(dl_list(:))
+         DEALLOCATE( dl_list )
+      ENDIF
+
+   END FUNCTION math__mean_2d
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the median of a 1D array. 
+   ! 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   ! 
+   !> @param[in] dd_array  1D array 
+   !> @param[in] dd_fill   fillValue
+   !> @return median value, real(dp)
+   !-------------------------------------------------------------------
+   PURE REAL(dp) FUNCTION math__median_1d(dd_array, dd_fill)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_array
+      REAL(dp),               INTENT(IN), OPTIONAL :: dd_fill
+
+      ! local variable
+      INTEGER(i4)                         :: il_count
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+      
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:),dd_array(:)/=dd_fill)
+         ELSE
+            math__median_1d=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:))
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=dd_array(:)
+         ELSE
+            math__median_1d=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) )THEN
+         CALL math_QsortC(dl_list(:))
+
+         IF( MOD(il_count,2) == 0 )THEN
+            math__median_1d=(dl_list(il_count/2+1)+dl_list(il_count/2))/2_dp
+         ELSE
+            math__median_1d=dl_list(il_count/2+1)
+         ENDIF
+
+         DEALLOCATE(dl_list)
+      ENDIF
+
+   END FUNCTION math__median_1d
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the median of a 2D array. 
+   ! 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   ! 
+   !> @param[in] dd_array  2D array 
+   !> @param[in] dd_fill   fillValue
+   !> @return median value, real(dp)
+   !-------------------------------------------------------------------
+   PURE REAL(dp) FUNCTION math__median_2d(dd_array, dd_fill)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_array
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
+
+      ! local variable
+      INTEGER(i4)                         :: il_count
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+      
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:,:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:),dd_array(:,:)/=dd_fill)
+         ELSE
+            math__median_2d=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:,:))
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:), MASK=.TRUE.)
+         ELSE
+            math__median_2d=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) )THEN
+         math__median_2d=math_median(dl_list(:))
+         DEALLOCATE(dl_list)
+      ENDIF
+
+   END FUNCTION math__median_2d
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the mean without extremum of a 1D array. 
+   ! 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   ! 
+   !> @param[in] dd_array  1D array 
+   !> @param[in] id_next   number of extremum to be removed
+   !> @param[in] dd_fill   fillValue
+   !> @return median value, real(dp)
+   !-------------------------------------------------------------------
+   PURE REAL(dp) FUNCTION math__mwe_1d(dd_array, id_next, dd_fill)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_array
+      INTEGER(i4)           , INTENT(IN), OPTIONAL :: id_next
+      REAL(dp),               INTENT(IN), OPTIONAL :: dd_fill
+
+      ! local variable
+      INTEGER(i4)                         :: il_next
+      INTEGER(i4)                         :: il_count
+      INTEGER(i4)                         :: il_size
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+
+      il_next=2
+      IF( PRESENT(id_next) ) il_next=id_next
+      
+      il_size=SIZE(dd_array(:))
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:),dd_array(:)/=dd_fill)
+         ELSE
+            math__mwe_1d=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:))
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=dd_array(:)
+         ELSE
+            math__mwe_1d=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) )THEN
+         CALL math_QsortC(dl_list(:))
+
+         IF( il_count == il_size )THEN
+            ! no fillValue
+            math__mwe_1d=math_mean(dl_list(il_next+1:il_size-il_next))
+         ELSEIF( il_count > il_size-2*il_next )THEN
+            ! remove one extremum each side
+            math__mwe_1d=math_mean(dl_list(2:il_size-1))
+         ELSE ! il_count <= il_size-2*il_next
+            ! more than 2*il_next fillValue
+            ! compute mean only
+            math__mwe_1d=math_mean(dl_list(:))
+         ENDIF
+
+         DEALLOCATE(dl_list)
+      ENDIF
+
+   END FUNCTION math__mwe_1d
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the mean without extremum of a 2D array. 
+   ! 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   ! 
+   !> @param[in] dd_array  2D array 
+   !> @param[in] id_next   number of extremum to be removed
+   !> @param[in] dd_fill   fillValue
+   !> @return median value, real(dp)
+   !-------------------------------------------------------------------
+   PURE REAL(dp) FUNCTION math__mwe_2d(dd_array, id_next, dd_fill)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_array
+      INTEGER(i4)             , INTENT(IN), OPTIONAL :: id_next
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
+
+      ! local variable
+      INTEGER(i4)                         :: il_count
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+      
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:,:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:),dd_array(:,:)/=dd_fill)
+
+            math__mwe_2d=math_mwe(dl_list(:), id_next)
+         ELSE
+            math__mwe_2d=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:,:))
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:), MASK=.TRUE.)
+
+            math__mwe_2d=math_mwe(dl_list(:), id_next)
+         ELSE
+            math__mwe_2d=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) ) DEALLOCATE(dl_list)
+
+   END FUNCTION math__mwe_2d
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine sort a 1D array. 
+   !>
+   !> @details
+   !> Recursive Fortran 95 quicksort routine
+   !> sorts real numbers into ascending numerical order
+   !> Author: Juli Rew, SCD Consulting (juliana@ucar.edu), 9/03
+   !> Based on algorithm from Cormen et al., Introduction to Algorithms,
+   !> 1997 printing
+   !> 
+   !> @author J.Paul 
+   !> @date January, 2015 - Rewrite with SIREN coding rules 
+   ! 
+   !> @param[inout] dd_array  1D array 
+   !-------------------------------------------------------------------
+   PURE RECURSIVE SUBROUTINE math_QsortC(dd_array)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_array
+
+      ! local variable
+      INTEGER(i4) :: il_iq
+      !----------------------------------------------------------------
+     
+      IF( SIZE(dd_array(:)) > 1 )THEN
+         CALL math__Partition(dd_array, il_iq)
+         CALL math_QsortC(dd_array(:il_iq-1))
+         CALL math_QsortC(dd_array(il_iq:))
+      ENDIF
+
+   END SUBROUTINE math_QsortC
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine partition a 1D array. 
+   !>
+   !> @details
+   !> Author: Juli Rew, SCD Consulting (juliana@ucar.edu), 9/03
+   !> Based on algorithm from Cormen et al., Introduction to Algorithms,
+   !> 1997 printing
+   !> 
+   !> @author J.Paul 
+   !> @date January, 2015 - Rewrite with SIREN coding rules 
+   ! 
+   !> @param[inout] dd_array  1D array 
+   !> @param[in] id_marker 
+   !-------------------------------------------------------------------
+   PURE SUBROUTINE math__Partition(dd_array, id_marker)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:), INTENT(INOUT) :: dd_array
+      INTEGER(i4),               INTENT(  OUT) :: id_marker
+
+      ! local variable
+      REAL(dp)    :: dl_temp
+      REAL(dp)    :: dl_x     ! pivot point
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      dl_x = dd_array(1)
+      ji= 0
+      jj= SIZE(dd_array(:)) + 1
+
+      DO 
+         jj=jj-1
+         DO
+            IF( dd_array(jj) <= dl_x ) EXIT
+            jj=jj-1
+         ENDDO
+         ji=ji+1
+         DO
+            IF( dd_array(jj) >= dl_x ) EXIT
+            ji=ji+1
+         ENDDO
+         IF( ji < jj )THEN
+            ! exchange dd_array(ji) and dd_array(jj)
+            dl_temp= dd_array(ji)
+            dd_array(ji) = dd_array(jj)
+            dd_array(jj) = dl_temp
+         ELSEIF( ji==jj )THEN
+            id_marker=ji+1
+            RETURN
+         ELSE
+            id_marker=ji
+            RETURN
+         ENDIF
+      ENDDO
+
+   END SUBROUTINE math__Partition
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine correct phase angles to produce smoother 
+   !> phase plots. 
+   !>
+   !> @details
+   !> This code is based on numpy unwrap function
+   !>
+   !> Unwrap by changing deltas between values to 2*pi complement.
+   !>
+   !> Unwrap radian phase `dd_array` by changing absolute jumps greater than
+   !> `dd_discont` to their 2*pi complement.
+   !>
+   !> @note If the discontinuity in `dd_array` is smaller than ``pi``, 
+   !> but larger than `dd_discont`, no unwrapping is done because taking
+   !> the 2*pi complement would only make the discontinuity larger.
+   !>
+   !> @author J.Paul 
+   !> @date Marsh, 2015 - Rewrite in fortran, with SIREN coding rules 
+   ! 
+   !> @param[inout] dd_array  1D array 
+   !> @param[in] dd_discont maximum discontinuity between values, default pi
+   !-------------------------------------------------------------------
+   PURE SUBROUTINE math_unwrap(dd_array, dd_discont)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:), INTENT(INOUT) :: dd_array
+      REAL(dp)   ,               INTENT(IN   ), OPTIONAL :: dd_discont
+
+      ! local variable
+      INTEGER(i4)                         :: il_size
+
+      REAL(dp)                            :: dl_discont
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_diff
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_mod
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_correct
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      dl_discont=dp_pi
+      IF( PRESENT(dd_discont) ) dl_discont=dd_discont
+
+      il_size=SIZE(dd_array)
+      ALLOCATE(dl_diff(il_size-1))
+      DO ji=1,il_size-1
+         dl_diff(ji)=dd_array(ji+1)-dd_array(ji)
+      ENDDO
+
+      ALLOCATE(dl_mod(il_size-1))
+      DO ji=1,il_size-1
+         dl_mod(ji) = MOD(dl_diff(ji) + dp_pi, 2*dp_pi) - dp_pi
+      ENDDO
+
+      WHERE( (dl_mod(:) == -dp_pi) .AND. (dl_diff(:) > 0._dp ) )
+         dl_mod(:)=dp_pi
+      END WHERE
+
+      ALLOCATE(dl_correct(il_size-1))
+      dl_correct(:)=dl_mod(:)-dl_diff(:)
+
+      DEALLOCATE(dl_mod)
+
+      WHERE( ABS(dl_diff(:)) < dl_discont )
+         dl_correct(:)=0._dp
+      END WHERE
+
+      DEALLOCATE(dl_diff)
+      
+      ALLOCATE(dl_tmp(il_size))
+      dl_tmp(:)=dd_array(:)
+
+      DO ji=1,il_size-1
+         dd_array(ji+1)=dl_tmp(ji+1)+SUM(dl_correct(1:ji))
+      ENDDO
+
+      DEALLOCATE(dl_correct)
+      DEALLOCATE(dl_tmp)
+
+   END SUBROUTINE math_unwrap
+   !------------------------------------------------------------------- 
+   !> @brief This function compute simple operation 
+   !>
+   !> @details
+   !> - operation should be write as a string of character.
+   !> - operators allowed are : +,-,*,/ 
+   !> - to ordered operation you should use parentheses
+   !>
+   !> exemples: '1e6/(16/122)', '(3/2)*(2+1)' 
+   !>
+   !> @author J.Paul 
+   !> @date June, 2015 - initial version
+   ! 
+   !> @param[in] cd_var operation to compute (string of character)  
+   !> @return result of the operation, real(dp)
+   !-------------------------------------------------------------------
+   REAL(dp) RECURSIVE FUNCTION math_compute(cd_var) RESULT(dd_res)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_var
+   
+      ! local variables
+      CHARACTER(LEN=lc) :: cl_var
+      CHARACTER(LEN=lc) :: cl_str1
+      CHARACTER(LEN=lc) :: cl_str2
+   
+      INTEGER(i4)       :: il_ind
+      ! loop indices
+      !----------------------------------------------------------------
+   
+   
+      IF(fct_is_real(cd_var))THEN
+         READ(cd_var,*) dd_res
+      ELSE
+      
+   
+         CALL math__parentheses(cd_var, cl_var)
+         
+         IF(fct_is_real(cl_var))THEN
+            READ(cl_var,*) dd_res
+         ELSE
+            il_ind=SCAN(TRIM(cl_var),'*')
+            IF( il_ind /= 0 )THEN
+               cl_str1=cl_var(1:il_ind-1)
+               cl_str2=cl_var(il_ind+1:)
+               dd_res=math_compute(cl_str1)*math_compute(cl_str2)
+            ELSE
+               il_ind=SCAN(TRIM(cl_var),'/')
+               IF( il_ind /= 0 )THEN
+                  cl_str1=cl_var(1:il_ind-1)
+                  cl_str2=cl_var(il_ind+1:)
+                  dd_res=math_compute(cl_str1)/math_compute(cl_str2)
+               ELSE
+                  il_ind=SCAN(TRIM(cl_var),'+')
+                  IF( il_ind /= 0 )THEN
+                     cl_str1=cl_var(1:il_ind-1)
+                     cl_str2=cl_var(il_ind+1:)
+                     dd_res=math_compute(cl_str1)+math_compute(cl_str2)
+                  ELSE
+                     il_ind=SCAN(TRIM(cl_var),'-')
+                     IF( il_ind /= 0 )THEN
+                        cl_str1=cl_var(1:il_ind-1)
+                        cl_str2=cl_var(il_ind+1:)
+                        dd_res=math_compute(cl_str1)-math_compute(cl_str2)
+                     ELSE
+                        dd_res=dp_fill
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+   
+   END FUNCTION math_compute
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine replace sub string inside parentheses
+   !> by the value of the operation inside.
+   !>
+   !> @details
+   !> exemple : 
+   !> - '2.6+(3/2)' => '2.6+1.5000'
+   !>
+   !> @author J.Paul 
+   !> @date June, 2015 - initial version
+   ! 
+   !> @param[in] cd_varin  string of character with operation inside
+   !> parentheses 
+   !> @param[out] cd_varout string of character with result of 
+   !> operation inside parentheses
+   !-------------------------------------------------------------------   
+   SUBROUTINE math__parentheses(cd_varin, cd_varout)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*) , INTENT(IN)  :: cd_varin
+      CHARACTER(LEN=lc), INTENT(OUT) :: cd_varout
+      ! local variables
+      CHARACTER(LEN=lc)     :: cl_cpt
+      INTEGER(i4)           :: il_ind
+      INTEGER(i4)           :: il_count
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      il_ind=INDEX(cd_varin,'(')
+      IF( il_ind /= 0 )THEN
+         il_count=0
+         DO ji=il_ind+1,LEN(cd_varin)
+            IF( cd_varin(ji:ji) == '(' )THEN
+               il_count=il_count+1
+            ELSEIF( cd_varin(ji:ji) == ')' )THEN
+               IF( il_count == 0 )THEN
+                  WRITE(cl_cpt,*) math_compute(cd_varin(il_ind+1:ji-1))
+                  cd_varout=TRIM(cd_varin(1:il_ind-1))//TRIM(ADJUSTL(cl_cpt))//&
+                     &        TRIM(cd_varin(ji+1:))
+                  EXIT
+               ELSE
+                  il_count=il_count-1
+               ENDIF
+            ENDIF
+         ENDDO
+      ELSE
+         cd_varout=TRIM(cd_varin)
+      ENDIF
+   
+   END SUBROUTINE math__parentheses
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute derivative of 1D array.
+   !> 
+   !> @details 
+   !> optionaly you could specify to take into account east west discontinuity
+   !> (-180° 180° or 0° 360° for longitude variable)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_value     1D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] ld_discont   logical to take into account east west discontinuity 
+   !-------------------------------------------------------------------
+   PURE FUNCTION math_deriv_1D( dd_value, dd_fill, ld_discont )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:), INTENT(IN) :: dd_value
+      REAL(dp)                 , INTENT(IN) :: dd_fill
+      LOGICAL                  , INTENT(IN), OPTIONAL :: ld_discont
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1) ) :: math_deriv_1D
+
+      ! local variable
+      INTEGER(i4)                            :: il_imin
+      INTEGER(i4)                            :: il_imax
+      INTEGER(i4), DIMENSION(1)              :: il_shape
+
+      REAL(dp)                               :: dl_min
+      REAL(dp)                               :: dl_max
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value
+
+      LOGICAL                                :: ll_discont
+
+      ! loop indices
+      INTEGER(i4) :: ji
+
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+      !----------------------------------------------------------------
+      ! init
+      math_deriv_1D(:)=dd_fill
+
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value(:))
+
+      ALLOCATE( dl_value(3))
+
+      ! compute derivative in i-direction
+      DO ji=1,il_shape(1)
+         
+            il_imin=MAX(ji-1,1)
+            il_imax=MIN(ji+1,il_shape(1))
+
+            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=3
+            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=2
+            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
+               i1=2  ; i2=3
+            ENDIF
+
+            dl_value(i1:i2)=dd_value(il_imin:il_imax)
+            IF( il_imin == 1 )THEN
+               dl_value(:)=EOSHIFT( dl_value(:), &
+               &                    DIM=1,         &
+               &                    SHIFT=-1,      &
+               &                    BOUNDARY=dl_value(1) )
+            ENDIF
+            IF( il_imax == il_shape(1) )THEN
+               dl_value(:)=EOSHIFT( dl_value(:), &
+               &                    DIM=1,         &
+               &                    SHIFT=1,       &
+               &                    BOUNDARY=dl_value(3))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:), dl_value(:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:), dl_value(:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:) < 0._dp ) 
+                     dl_value(:) = dl_value(:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:) > 180._dp ) 
+                     dl_value(:) = dl_value(:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+         IF( dl_value( 2) /= dd_fill .AND. & ! ji
+         &   dl_value( 3) /= dd_fill .AND. & ! ji+1
+         &   dl_value( 1) /= dd_fill )THEN   ! ji-1
+
+            math_deriv_1D(ji)=&
+            &  ( dl_value(3) - dl_value(1) ) / &
+            &  REAL( il_imax-il_imin ,dp)
+
+         ENDIF
+
+      ENDDO
+
+      DEALLOCATE( dl_value )
+
+   END FUNCTION math_deriv_1D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute derivative of 2D array.
+   !> you have to specify in which direction derivative have to be computed:
+   !> first (I) or second (J) dimension. 
+   !>
+   !> @details 
+   !> optionaly you could specify to take into account east west discontinuity
+   !> (-180° 180° or 0° 360° for longitude variable)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_value     2D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] cd_dim       compute derivative on first (I) or second (J) dimension 
+   !> @param[in] ld_discont   logical to take into account east west discontinuity 
+   !-------------------------------------------------------------------
+   FUNCTION math_deriv_2D( dd_value, dd_fill, cd_dim, ld_discont )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_value
+      REAL(dp)                   , INTENT(IN) :: dd_fill
+      CHARACTER(LEN=*)           , INTENT(IN) :: cd_dim
+      LOGICAL                    , INTENT(IN), OPTIONAL :: ld_discont
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), &
+      &                   SIZE(dd_value,DIM=2) ) :: math_deriv_2D
+
+      ! local variable
+      INTEGER(i4)                              :: il_imin
+      INTEGER(i4)                              :: il_imax
+      INTEGER(i4)                              :: il_jmin
+      INTEGER(i4)                              :: il_jmax
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+
+      REAL(dp)                                 :: dl_min
+      REAL(dp)                                 :: dl_max
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_value
+
+      LOGICAL                                  :: ll_discont
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+
+      INTEGER(i4) :: j1
+      INTEGER(i4) :: j2
+      !----------------------------------------------------------------
+      ! init
+      math_deriv_2D(:,:)=dd_fill
+
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value(:,:))
+
+      SELECT CASE(TRIM(fct_upper(cd_dim)))
+
+      CASE('I')
+
+         ALLOCATE( dl_value(3,il_shape(2)) )
+         ! compute derivative in i-direction
+         DO ji=1,il_shape(1)
+
+            ! init
+            dl_value(:,:)=dd_fill
+            
+            il_imin=MAX(ji-1,1)
+            il_imax=MIN(ji+1,il_shape(1))
+
+            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=3
+            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=2
+            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
+               i1=2  ; i2=3
+            ENDIF
+
+            dl_value(i1:i2,:)=dd_value(il_imin:il_imax,:)
+            IF( il_imin == 1 )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+               &                      DIM=1,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(1,:) )
+            ENDIF
+            IF( il_imax == il_shape(1) )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+               &                      DIM=1,         &
+               &                      SHIFT=1,       &
+               &                      BOUNDARY=dl_value(3,:))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:) < 0_dp ) 
+                     dl_value(:,:) = dl_value(:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:) > 180 ) 
+                     dl_value(:,:) = dl_value(:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+            
+            WHERE( dl_value(2,:) /= dd_fill .AND. &  ! ji
+            &      dl_value(3,:) /= dd_fill .AND. &  ! ji+1
+            &      dl_value(1,:) /= dd_fill )        ! ji-1
+
+               math_deriv_2D(ji,:)=&
+               &  ( dl_value(3,:) - dl_value(1,:) ) / &
+               &    REAL( il_imax-il_imin,dp)
+
+            END WHERE
+
+         ENDDO
+
+      CASE('J')
+
+         ALLOCATE( dl_value(il_shape(1),3) )
+         ! compute derivative in j-direction
+         DO jj=1,il_shape(2)
+         
+            il_jmin=MAX(jj-1,1)
+            il_jmax=MIN(jj+1,il_shape(2))
+
+            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=3
+            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=2
+            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN
+               j1=2  ; j2=3
+            ENDIF
+
+            dl_value(:,j1:j2)=dd_value(:,il_jmin:il_jmax)
+            IF( il_jmin == 1 )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+               &                      DIM=2,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(:,1))
+            ENDIF
+            IF( il_jmax == il_shape(2) )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+               &                      DIM=2,         &
+               &                      SHIFT=1,       &
+               &                      BOUNDARY=dl_value(:,3))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:) < 0_dp ) 
+                     dl_value(:,:) = dl_value(:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:) > 180 ) 
+                     dl_value(:,:) = dl_value(:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+            WHERE( dl_value(:, 2) /= dd_fill .AND. & ! jj
+            &      dl_value(:, 3) /= dd_fill .AND. & ! jj+1
+            &      dl_value(:, 1) /= dd_fill )       ! jj-1
+
+               math_deriv_2D(:,jj)=&
+               &  ( dl_value(:,3) - dl_value(:,1) ) / &
+               &   REAL(il_jmax-il_jmin,dp)         
+
+            END WHERE
+
+         ENDDO
+         
+      END SELECT
+
+      DEALLOCATE( dl_value )
+
+   END FUNCTION math_deriv_2D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute derivative of 3D array.
+   !> you have to specify in which direction derivative have to be computed:
+   !> first (I), second (J) or third (K) dimension.
+   !> 
+   !> @details 
+   !> optionaly you could specify to take into account east west discontinuity
+   !> (-180° 180° or 0° 360° for longitude variable)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] dd_value  3D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] cd_dim       compute derivative on first (I) second (J) or third (K) dimension   
+   !> @param[in] ld_discont   logical to take into account east west discontinuity
+   !-------------------------------------------------------------------
+   PURE FUNCTION math_deriv_3D( dd_value, dd_fill, cd_dim, ld_discont )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:,:), INTENT(IN) :: dd_value
+      REAL(dp)                          , INTENT(IN) :: dd_fill
+      CHARACTER(LEN=*)                  , INTENT(IN) :: cd_dim
+      LOGICAL                           , INTENT(IN), OPTIONAL :: ld_discont
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), &
+      &                   SIZE(dd_value,DIM=2), &
+      &                   SIZE(dd_value,DIM=3)) :: math_deriv_3D
+
+      ! local variable
+      INTEGER(i4)                                :: il_imin
+      INTEGER(i4)                                :: il_imax
+      INTEGER(i4)                                :: il_jmin
+      INTEGER(i4)                                :: il_jmax
+      INTEGER(i4)                                :: il_kmin
+      INTEGER(i4)                                :: il_kmax
+      INTEGER(i4), DIMENSION(3)                  :: il_shape
+
+      REAL(dp)                                   :: dl_min
+      REAL(dp)                                   :: dl_max
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_value
+
+      LOGICAL                                    :: ll_discont
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+
+      INTEGER(i4) :: j1
+      INTEGER(i4) :: j2
+      
+      INTEGER(i4) :: k1
+      INTEGER(i4) :: k2      
+      !----------------------------------------------------------------
+      ! init
+      math_deriv_3D(:,:,:)=dd_fill
+
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value(:,:,:))
+
+
+      SELECT CASE(TRIM(fct_upper(cd_dim)))
+
+      CASE('I')
+
+         ALLOCATE( dl_value(3,il_shape(2),il_shape(3)) )
+         ! compute derivative in i-direction
+         DO ji=1,il_shape(1)
+            
+            il_imin=MAX(ji-1,1)
+            il_imax=MIN(ji+1,il_shape(1))
+
+            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=3
+            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=2
+            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
+               i1=2  ; i2=3
+            ENDIF
+
+            dl_value(i1:i2,:,:)=dd_value(il_imin:il_imax,:,:)
+            IF( il_imin == 1 )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=1,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(1,:,:) )
+            ENDIF
+            IF( il_imax == il_shape(1) )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=1,         &
+               &                      SHIFT=1,       &
+               &                      BOUNDARY=dl_value(3,:,:))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:,:) < 0_dp ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:,:) > 180 ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+            WHERE( dl_value(2,:,:) /= dd_fill .AND. & ! ji
+            &      dl_value(3,:,:) /= dd_fill .AND. & !ji+1 
+            &      dl_value(1,:,:) /= dd_fill )       !ji-1
+
+               math_deriv_3D(ji,:,:)= &
+               &  ( dl_value(3,:,:) - dl_value(1,:,:) ) / &
+               &  REAL( il_imax-il_imin ,dp)
+
+            END WHERE
+
+         ENDDO
+
+      CASE('J')
+
+         ALLOCATE( dl_value(il_shape(1),3,il_shape(3)) )
+         ! compute derivative in j-direction
+         DO jj=1,il_shape(2)
+         
+            il_jmin=MAX(jj-1,1)
+            il_jmax=MIN(jj+1,il_shape(2))
+
+            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=3
+            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=2
+            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN
+               j1=2  ; j2=3
+            ENDIF
+
+            dl_value(:,j1:j2,:)=dd_value(:,il_jmin:il_jmax,:)
+            IF( il_jmin == 1 )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=2,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(:,1,:) )
+            ENDIF
+            IF( il_jmax == il_shape(2) )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=2,         &
+               &                      SHIFT=1,       &
+               &                      BOUNDARY=dl_value(:,3,:))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:,:) < 0_dp ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:,:) > 180 ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+            WHERE( dl_value(:, 2,:) /= dd_fill .AND. & ! jj
+               &   dl_value(:, 3,:) /= dd_fill .AND. & ! jj+1
+            &      dl_value(:, 1,:) /= dd_fill )       ! jj-1
+
+               math_deriv_3D(:,jj,:)=&
+               &  ( dl_value(:,3,:) - dl_value(:,1,:) ) / &
+               &  REAL( il_jmax - il_jmin ,dp)         
+
+            END WHERE
+
+         ENDDO
+         
+      CASE('K')
+         ! compute derivative in k-direction
+         DO jk=1,il_shape(3)
+
+            il_kmin=MAX(jk-1,1)
+            il_kmax=MIN(jk+1,il_shape(3))
+
+            IF( il_kmin==jk-1 .AND. il_kmax==jk+1 )THEN
+               k1=1  ; k2=3
+            ELSEIF( il_kmin==jk .AND. il_kmax==jk+1 )THEN
+               k1=1  ; k2=2
+            ELSEIF( il_kmin==jk-1 .AND. il_kmax==jk )THEN
+               k1=2  ; k2=3
+            ENDIF
+
+            dl_value(:,:,k1:k2)=dd_value(:,:,il_kmin:il_kmax)
+            IF( il_kmin == 1 )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=3,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(:,:,1) )
+            ENDIF
+            IF( il_kmax == il_shape(3) )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                        DIM=3,         &
+               &                        SHIFT=1,       &
+               &                        BOUNDARY=dl_value(:,:,3))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:,:) < 0_dp ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:,:) > 180 ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF         
+
+            WHERE( dl_value(:,:, 2) /= dd_fill .AND. & ! jk
+               &   dl_value(:,:, 3) /= dd_fill .AND. & ! jk+1
+               &   dl_value(:,:, 1) /= dd_fill )       ! jk-1
+
+               math_deriv_3D(:,:,jk)=&
+               &  ( dl_value(:,:,3) - dl_value(:,:,1) ) / &
+               &  REAL( il_kmax-il_kmin,dp)         
+
+            END WHERE
+
+         ENDDO
+
+      END SELECT
+
+      DEALLOCATE( dl_value )
+
+   END FUNCTION math_deriv_3D
+END MODULE math
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90	(revision 5682)
@@ -28,4 +28,7 @@
 !> @endcode
 !>    
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
 !>    merge_bathy.nam comprise 8 namelists:
 !>       - logger namelist (namlog)
@@ -45,5 +48,5 @@
 !>       - cn_logfile   : logger filename
 !>       - cn_verbosity : verbosity ('trace','debug','info',
-!>  'warning','error','fatal')
+!>  'warning','error','fatal','none')
 !>       - in_maxerror  : maximum number of error allowed
 !>
@@ -62,10 +65,10 @@
 !>    * _variable namelist (namvar)_:
 !>       - cn_varinfo : list of variable and extra information about request(s) 
-!>       to be used.<br/>
+!>       to be used (separated by ',').<br/>
 !>          each elements of *cn_varinfo* is a string character.<br/>
 !>          it is composed of the variable name follow by ':', 
 !>          then request(s) to be used on this variable.<br/> 
 !>          request could be:
-!>             - interpolation method
+!>             - int = interpolation method
 !> 
 !>                requests must be separated by ';'.<br/>
@@ -74,5 +77,5 @@
 !>          informations about available method could be find in 
 !>          @ref interp modules.<br/>
-!>          Example: 'bathymetry: cubic'
+!>          Example: 'bathymetry: int=cubic'
 !>          @note 
 !>             If you do not specify a method which is required, 
@@ -95,9 +98,9 @@
 !>          segments are separated by '|'.<br/>
 !>          each segments of the boundary is composed of:
-!>             - orthogonal indice (.ie. for north boundary,
-!>             J-indice where boundary are). 
-!>             - first indice of boundary (I-indice for north boundary) 
-!>             - last  indice of boundary (I-indice for north boundary)<br/>
-!>                indices must be separated by ',' .<br/>
+!>             - indice of velocity (orthogonal to boundary .ie. 
+!>                for north boundary, J-indice). 
+!>             - indice of segment start (I-indice for north boundary) 
+!>             - indice of segment end   (I-indice for north boundary)<br/>
+!>                indices must be separated by ':' .<br/>
 !>             - optionally, boundary size could be added between '(' and ')' 
 !>             in the first segment defined.
@@ -106,6 +109,7 @@
 !>
 !>          Examples:
-!>             - cn_north='index1,first1,last1(width)'
-!>             - cn_north='index1(width),first1,last1|index2,first2,last2'
+!>             - cn_north='index1,first1:last1(width)'
+!>             - cn_north='index1(width),first1:last1|index2,first2:last2'
+!>
 !>       - cn_south : south boundary indices on fine grid<br/>
 !>       - cn_east  : east  boundary indices on fine grid<br/>
@@ -121,4 +125,7 @@
 !> @date Sepember, 2014 
 !> - add header for user
+!> @date July, 2015 
+!> - extrapolate all land points
+!> - add attributes with boundary string character (as in namelist)
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -153,4 +160,5 @@
    CHARACTER(LEN=lc)                                  :: cl_namelist
    CHARACTER(LEN=lc)                                  :: cl_date
+   CHARACTER(LEN=lc)                                  :: cl_tmp
 
    INTEGER(i4)                                        :: il_narg
@@ -162,4 +170,5 @@
    INTEGER(i4)                                        :: il_jmin0
    INTEGER(i4)                                        :: il_jmax0
+   INTEGER(i4)                                        :: il_shift
    INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho
    INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
@@ -231,5 +240,6 @@
    NAMELIST /namlog/ &  !< logger namelist
    &  cn_logfile,    &  !< log file
-   &  cn_verbosity      !< log verbosity
+   &  cn_verbosity,  &  !< log verbosity
+   &  in_maxerror       !< logger maximum error
 
    NAMELIST /namcfg/ &  !< config namelist
@@ -298,5 +308,5 @@
       READ( il_fileid, NML = namlog )
       ! define log file
-      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity), in_maxerror)
+      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
       CALL logger_header()
 
@@ -510,4 +520,78 @@
    ENDIF
 
+
+   IF( tl_bdy(jp_north)%l_use )THEN
+      ! add shift on north boundary
+      ! boundary compute on T point but express on U or V point
+      il_shift=1
+
+      cl_tmp=TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_index-il_shift))//','//&
+         &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_first))//':'//&
+         &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_last))//&
+         &   '('//TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_width))//')'
+      DO ji=2,tl_bdy(jp_north)%i_nseg
+         cl_tmp=TRIM(cl_tmp)//'|'//&
+            &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_index-il_shift))//','//&
+            &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_first))//':'//&
+            &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_last))
+      ENDDO
+      tl_att=att_init("bdy_north",TRIM(cl_tmp))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
+   IF( tl_bdy(jp_south)%l_use )THEN
+      
+      cl_tmp=TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_index))//','//&
+         &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_first))//':'//&
+         &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_last))//&
+         &   '('//TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_width))//')'
+      DO ji=2,tl_bdy(jp_south)%i_nseg
+         cl_tmp=TRIM(cl_tmp)//'|'//&
+            &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_index))//','//&
+            &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_first))//':'//&
+            &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_last))
+      ENDDO
+
+      tl_att=att_init("bdy_south",TRIM(cl_tmp))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
+   IF( tl_bdy(jp_east)%l_use )THEN
+      ! add shift on east boundary
+      ! boundary compute on T point but express on U or V point
+      il_shift=1
+
+      cl_tmp=TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_index-il_shift))//','//&
+         &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_first))//':'//&
+         &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_last))//&
+         &   '('//TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_width))//')'
+      DO ji=2,tl_bdy(jp_east)%i_nseg
+         cl_tmp=TRIM(cl_tmp)//'|'//&
+            &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_index-il_shift))//','//&
+            &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_first))//':'//&
+            &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_last))
+      ENDDO
+
+      tl_att=att_init("bdy_east",TRIM(cl_tmp))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
+   IF( tl_bdy(jp_west)%l_use )THEN
+
+      cl_tmp=TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_index))//','//&
+         &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_first))//':'//&
+         &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_last))//&
+         &   '('//TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_width))//')'
+      DO ji=2,tl_bdy(jp_west)%i_nseg
+         cl_tmp=TRIM(cl_tmp)//'|'//&
+            &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_index))//','//&
+            &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_first))//':'//&
+            &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_last))
+      ENDDO
+
+      tl_att=att_init("bdy_west",TRIM(cl_tmp))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
    ! create file
    CALL iom_create(tl_fileout)
@@ -525,4 +609,5 @@
    CALL mpp_clean(tl_bathy0)
    DEALLOCATE(dl_weight)
+   CALL boundary_clean(tl_bdy(:))
 
    ! close log file
@@ -908,7 +993,5 @@
 
       ! extrapolate variable
-      CALL extrap_fill_value( td_var, id_offset=id_offset(:,:), &
-      &                               id_rho=id_rho(:),         &
-      &                               id_iext=il_iext, id_jext=il_jext )
+      CALL extrap_fill_value( td_var )
 
       ! interpolate Bathymetry
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/mpp.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/mpp.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/mpp.f90	(revision 5682)
@@ -165,13 +165,11 @@
 !>    to get processors to be used:<br/>
 !> @code
-!>    CALL mpp_get_use( td_mpp, id_imin, id_imax, id_idim, & 
-!>    &                         id_jmin, id_jmax, id_jdim )
+!>    CALL mpp_get_use( td_mpp, id_imin, id_imax, & 
+!>    &                         id_jmin, id_jmax )
 !> @endcode
 !>       - id_imin 
 !>       - id_imax 
-!>       - id_idim 
 !>       - id_jmin 
 !>       - id_jmax 
-!>       - id_jdim 
 !>
 !>    to get sub domains which form global domain contour:<br/>
@@ -352,5 +350,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date November, 2014
    !>    - use function instead of overload assignment operator 
@@ -379,4 +377,5 @@
       ! copy mpp variable
       mpp__copy_unit%c_name     = TRIM(td_mpp%c_name)
+      mpp__copy_unit%i_id       = td_mpp%i_id
       mpp__copy_unit%i_niproc   = td_mpp%i_niproc
       mpp__copy_unit%i_njproc   = td_mpp%i_njproc
@@ -425,5 +424,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date November, 2014
    !>    - use function instead of overload assignment operator 
@@ -454,5 +453,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_mpp mpp structure
@@ -495,5 +494,5 @@
       ! print dimension
       IF(  td_mpp%i_ndim /= 0 )THEN
-         WRITE(*,'(/a)') " File dimension"
+         WRITE(*,'(/a)') " MPP dimension"
          DO ji=1,ip_maxdim
             IF( td_mpp%t_dim(ji)%l_use )THEN
@@ -698,5 +697,5 @@
       CALL dim_clean(tl_dim)
 
-      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_niproc))) .OR. &
+      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_njproc))) .OR. &
           ((.NOT. PRESENT(id_niproc)) .AND.        PRESENT(id_njproc) ) )THEN
           CALL logger_warn( "MPP INIT: number of processors following I and J "//&
@@ -912,5 +911,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file strcuture
@@ -1028,29 +1027,29 @@
             ! create some attributes for domain decomposition (use with dimg file)
             tl_att=att_init( "DOMAIN_number_total", mpp__init_file%i_nproc )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_I_position_first", mpp__init_file%t_proc(:)%i_impp )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_J_position_first", mpp__init_file%t_proc(:)%i_jmpp )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_I_position_last", mpp__init_file%t_proc(:)%i_lci )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_J_position_last", mpp__init_file%t_proc(:)%i_lcj )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_I_halo_size_start", mpp__init_file%t_proc(:)%i_ldi )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_J_halo_size_start", mpp__init_file%t_proc(:)%i_ldj )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_I_halo_size_end", mpp__init_file%t_proc(:)%i_lei )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
 
             tl_att=att_init( "DOMAIN_J_halo_size_end", mpp__init_file%t_proc(:)%i_lej )
-            CALL mpp_add_att(mpp__init_file, tl_att)
+            CALL mpp_move_att(mpp__init_file, tl_att)
             
             ! clean
@@ -1122,5 +1121,4 @@
       CALL file_clean(tl_file)
 
-      CALL logger_debug("MPP INIT READ: fin init_read ")
    END FUNCTION mpp__init_file
    !-------------------------------------------------------------------
@@ -1131,5 +1129,6 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 - add only use dimension in MPP structure
    !>
    !> @param[in] td_file   file strcuture
@@ -1163,6 +1162,6 @@
          IF( td_file%i_id == 0 )THEN
             CALL logger_info(" id "//TRIM(fct_str(td_file%i_id))) 
-            CALL logger_error("MPP INIT READ: netcdf file "//TRIM(td_file%c_name)//&
-            &  " not opened")
+            CALL logger_error("MPP INIT READ: netcdf file "//&
+               &  TRIM(td_file%c_name)//" not opened")
          ELSE
 
@@ -1191,9 +1190,14 @@
                CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
             ENDIF
-            tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len)
-            CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
-
-            tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len)
-            CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
+
+            IF( td_file%t_dim(3)%l_use )THEN
+               tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len)
+               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
+            ENDIF
+
+            IF( td_file%t_dim(4)%l_use )THEN
+               tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len)
+               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
+            ENDIF
 
             ! initialise file/processor
@@ -1312,5 +1316,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   file strcuture
@@ -1532,5 +1536,5 @@
    !
    !> @author J.Paul
-   !> - Nov, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -1624,8 +1628,4 @@
             IF( il_varid /= 0 )THEN
 
-               CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//&
-               &  ", standard name "//TRIM(td_var%c_stdname)//&
-               &  ", already in mpp "//TRIM(td_mpp%c_name) )
-
                DO ji=1,td_mpp%t_proc(1)%i_nvar
                   CALL logger_debug( " MPP ADD VAR: in mpp structure : &
@@ -1634,4 +1634,7 @@
                   &  TRIM(td_mpp%t_proc(1)%t_var(ji)%c_stdname) )
                ENDDO
+               CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//&
+               &  ", standard name "//TRIM(td_var%c_stdname)//&
+               &  ", already in mpp "//TRIM(td_mpp%c_name) )
 
             ELSE
@@ -1675,5 +1678,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_mpp    mpp structure
@@ -1840,4 +1843,6 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial version
+   !> @date February, 2015 
+   !> - define local variable structure to avoid mistake with pointer
    !
    !> @param[inout] td_mpp    mpp strcuture
@@ -1852,4 +1857,5 @@
       ! local variable
       INTEGER(i4)       :: il_varid
+      TYPE(TVAR)        :: tl_var
       !----------------------------------------------------------------
       ! check if mpp exist
@@ -1882,5 +1888,6 @@
             ELSE
 
-               CALL mpp_del_var(td_mpp, td_mpp%t_proc(1)%t_var(il_varid)) 
+               tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid))
+               CALL mpp_del_var(td_mpp, tl_var)
 
             ENDIF
@@ -2193,5 +2200,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - rewrite the same as way var_add_dim
    !>
    !> @param[inout] td_mpp mpp structure
@@ -2208,51 +2217,33 @@
 
       ! loop indices
-      INTEGER(i4) :: ji
       !----------------------------------------------------------------
       IF( td_mpp%i_ndim <= ip_maxdim )THEN
 
-         ! check if dimension already in mpp structure
-         il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname)
-         IF( il_ind /= 0 )THEN
-
-            IF( td_mpp%t_dim(il_ind)%l_use )THEN
-               CALL logger_error( &
-               &  "MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//&
-               &  ", short name "//TRIM(td_dim%c_sname)//&
-               &  ", already used in mpp "//TRIM(td_mpp%c_name) )
-            ELSE
-               ! replace dimension
-               td_mpp%t_dim(il_ind)=dim_copy(td_dim)
-               td_mpp%t_dim(il_ind)%i_id=il_ind
-               td_mpp%t_dim(il_ind)%l_use=.TRUE.
-            ENDIF
-
+         ! check if dimension already used in mpp structure
+         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
+         IF( il_ind == 0 )THEN
+            CALL logger_warn( &
+            &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//&
+            &  ", short name "//TRIM(td_dim%c_sname)//&
+            &  ", will not be added in mpp "//TRIM(td_mpp%c_name) )
+         ELSEIF( td_mpp%t_dim(il_ind)%l_use )THEN
+            CALL logger_error( &
+            &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//&
+            &  ", short name "//TRIM(td_dim%c_sname)//&
+            &  ", already used in mpp "//TRIM(td_mpp%c_name) )
          ELSE
 
-            IF( td_mpp%i_ndim == ip_maxdim )THEN
-               CALL logger_error( &
-               &  "MPP ADD DIM: can not add dimension "//TRIM(td_dim%c_name)//&
-               &  ", short name "//TRIM(td_dim%c_sname)//&
-               &  ", in mpp "//TRIM(td_mpp%c_name)//". Already "//&
-               &  TRIM(fct_str(ip_maxdim))//" dimensions." )
-            ELSE
-               ! search empty dimension
-               DO ji=1,ip_maxdim
-                  IF( td_mpp%t_dim(ji)%i_id == 0 )THEN
-                     il_ind=ji 
-                     EXIT
-                  ENDIF
-               ENDDO
- 
-               ! add new dimension    
-               td_mpp%t_dim(il_ind)=dim_copy(td_dim)
-               ! update number of attribute
-               td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use)
-
-               td_mpp%t_dim(il_ind)%l_use=.TRUE.
-               td_mpp%t_dim(il_ind)%i_id=td_mpp%i_ndim
-            ENDIF
+            ! back to disorder dimension array 
+            CALL dim_disorder(td_mpp%t_dim(:))
+
+            ! add new dimension
+            td_mpp%t_dim(td_mpp%i_ndim+1)=dim_copy(td_dim)
+
+            ! update number of attribute
+            td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use)
 
          ENDIF
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(td_mpp%t_dim(:))
 
       ELSE
@@ -2268,5 +2259,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - rewrite the same as way var_del_dim
    !>
    !> @param[inout] td_mpp mpp structure
@@ -2280,55 +2273,34 @@
 
       ! local variable
-      INTEGER(i4) :: il_status
       INTEGER(i4) :: il_ind
-      TYPE(TDIM), DIMENSION(:), ALLOCATABLE  :: tl_dim
+      TYPE(TDIM)  :: tl_dim
 
       ! loop indices
-      INTEGER(i4) :: ji
-      !----------------------------------------------------------------
-      ! check if dimension already in mpp structure
-      il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname)
-      IF( il_ind == 0 )THEN
-
-         CALL logger_error( &
-         &  "MPP DEL DIM: no dimension "//TRIM(td_dim%c_name)//&
+      !----------------------------------------------------------------
+
+
+      IF( td_mpp%i_ndim <= ip_maxdim )THEN
+
+         CALL logger_trace( &
+         &  " MPP DEL DIM: delete dimension "//TRIM(td_dim%c_name)//&
          &  ", short name "//TRIM(td_dim%c_sname)//&
          &  ", in mpp "//TRIM(td_mpp%c_name) )
+         
+         ! check if dimension already in variable structure
+         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
+
+         ! replace dimension by empty one
+         td_mpp%t_dim(il_ind)=dim_copy(tl_dim)
+
+         ! update number of dimension
+         td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use)
+
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(td_mpp%t_dim)
 
       ELSE
-
-         ALLOCATE( tl_dim(td_mpp%i_ndim-1), stat=il_status )
-         IF(il_status /= 0 )THEN
-
-            CALL logger_error( &
-            &  "MPP DEL DIM: not enough space to put dimensions from "//&
-            &  TRIM(td_mpp%c_name)//" in temporary dimension structure")
-
-         ELSE
-
-            ! save temporary dimension's mpp structure
-            tl_dim( 1 : il_ind-1 ) = dim_copy(td_mpp%t_dim( 1 : il_ind-1 ))
-            tl_dim( il_ind : td_mpp%i_ndim-1 ) = &
-            &           dim_copy(td_mpp%t_dim( il_ind+1 : td_mpp%i_ndim ))
-
-            ! remove dimension from file
-            CALL dim_clean(td_mpp%t_dim(:))
-            ! copy dimension in file, except one
-            td_mpp%t_dim(1:td_mpp%i_ndim)=dim_copy(tl_dim(:))
-
-            ! update number of dimension
-            td_mpp%i_ndim=td_mpp%i_ndim-1
-
-            ! update dimension id
-            DO ji=1,td_mpp%i_ndim
-               td_mpp%t_dim(ji)%i_id=ji
-            ENDDO
-
-            ! clean
-            CALL dim_clean(tl_dim(:))
-            DEALLOCATE(tl_dim)
-
-         ENDIF
-
+         CALL logger_error( &
+         &  " MPP DEL DIM: too much dimension in mpp "//&
+         &  TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")")
       ENDIF
 
@@ -2340,5 +2312,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_mpp mpp structure
@@ -2488,8 +2460,8 @@
             &  ", in mpp structure "//TRIM(td_mpp%c_name) )
 
-            IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN
                DO ji=1,td_mpp%t_proc(1)%i_natt
                   CALL logger_debug( "MPP DEL ATT: in mpp structure : &
-                  &  attribute : "//TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name) )
+                  &  attribute : "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) )
                ENDDO
             ENDIF
@@ -2516,4 +2488,6 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial version
+   !> @date February, 2015 
+   !> - define local attribute structure to avoid mistake with pointer
    !
    !> @param[inout] td_mpp    mpp strcuture
@@ -2527,5 +2501,6 @@
 
       ! local variable
-      INTEGER(i4)       :: il_attid
+      INTEGER(i4) :: il_attid
+      TYPE(TATT)  :: tl_att
       !----------------------------------------------------------------
       ! check if mpp exist
@@ -2551,5 +2526,5 @@
             IF( il_attid == 0 )THEN
 
-               CALL logger_warn( &
+               CALL logger_debug( &
                &  "MPP DEL ATT : there is no attribute with "//&
                &  "name "//TRIM(cd_name)//" in mpp structure "//&
@@ -2558,5 +2533,6 @@
             ELSE
 
-               CALL mpp_del_att(td_mpp, td_mpp%t_proc(1)%t_att(il_attid)) 
+               tl_att=att_copy(td_mpp%t_proc(1)%t_att(il_attid))
+               CALL mpp_del_att(td_mpp, tl_att) 
 
             ENDIF
@@ -2863,8 +2839,13 @@
 
             CALL logger_info("MPP OPTIMIZ: number of processor "//&
-            &  TRIM(fct_str(tl_mpp%i_nproc)) )
+            &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//&
+            &   TRIM(fct_str(tl_mpp%i_nproc)) )
             IF( tl_mpp%i_nproc > td_mpp%i_nproc .AND. &
             &   tl_mpp%i_nproc <= il_maxproc )THEN
                ! save optimiz decomposition 
+
+               CALL logger_info("MPP OPTIMIZ:save this decomposition "//&
+               &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//&
+               &   TRIM(fct_str(tl_mpp%i_nproc)) )
 
                ! clean mpp
@@ -3146,5 +3127,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !>
    !> @param[inout] td_mpp mpp strcuture
@@ -3184,5 +3165,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !>
    !> @param[in] td_mpp    mpp strcuture
@@ -3249,5 +3230,5 @@
    !
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !
    !> @param[in] td_mpp    mpp strcuture
@@ -3311,5 +3292,5 @@
    !>
    !> @author J.Paul
-   !> @date November, 2013
+   !> @date November, 2013 - Initial version
    !>
    !> @param[inout] td_mpp mpp strcuture
@@ -3404,5 +3385,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[in] td_mpp mpp structure
@@ -3417,5 +3398,4 @@
 
       ! local variable
-      INTEGER(i4) :: il_ndim
 
       ! loop indices
@@ -3429,14 +3409,8 @@
          mpp__check_var_dim=.FALSE.
 
-         CALL logger_error( &
-         &  "MPP CHECK DIM: variable and mpp dimension differ"//&
-         &  " for variable "//TRIM(td_var%c_name)//&
-         &  " and mpp "//TRIM(td_mpp%c_name))
-
          CALL logger_debug( &
          &  " mpp dimension: "//TRIM(fct_str(td_mpp%i_ndim))//&
          &  " variable dimension: "//TRIM(fct_str(td_var%i_ndim)) )
-         il_ndim=MIN(td_var%i_ndim, td_mpp%i_ndim )
-         DO ji = 1, il_ndim
+         DO ji = 1, ip_maxdim
             CALL logger_debug( &
             &  "MPP CHECK DIM: for dimension "//&
@@ -3448,4 +3422,10 @@
             &  ", variable used "//TRIM(fct_str(td_var%t_dim(ji)%l_use)))
          ENDDO
+
+         CALL logger_error( &
+         &  "MPP CHECK DIM: variable and mpp dimension differ"//&
+         &  " for variable "//TRIM(td_var%c_name)//&
+         &  " and mpp "//TRIM(td_mpp%c_name))
+
       ENDIF
 
@@ -3456,5 +3436,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_file   array of file structure
@@ -3496,5 +3476,5 @@
    !
    !> @author J.Paul
-   !> - Ocotber, 2014- Initial Version
+   !> @date Ocotber, 2014 - Initial Version
    !
    !> @param[in] td_mpp   mpp file structure
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/multi.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/multi.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/multi.f90	(revision 5682)
@@ -61,5 +61,6 @@
 !> @date October, 2014
 !> - use mpp file structure instead of file
-!> @date November, 2014 - Fix memory leaks bug
+!> @date November, 2014 
+!> - Fix memory leaks bug
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -118,5 +119,5 @@
    !>   
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date November, 2014
    !>    - use function instead of overload assignment operator (to avoid memory leak)
@@ -169,5 +170,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - check if variable to be read is in file
    !>
    !> @param[in] cd_varfile   variable location information (from namelist) 
@@ -190,4 +193,5 @@
 
       INTEGER(i4)       :: il_nvar
+      INTEGER(i4)       :: il_varid
 
       LOGICAL           :: ll_dim
@@ -242,4 +246,12 @@
                   ! define variable
                   IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN
+
+                     ! check if variable is in file
+                     il_varid=var_get_index(tl_mpp%t_proc(1)%t_var(:),cl_lower)
+                     IF( il_varid == 0 )THEN
+                        CALL logger_fatal("MULTI INIT: variable "//&
+                           & TRIM(cl_name)//" not in file "//&
+                           & TRIM(cl_file) )
+                     ENDIF
 
                      ! clean var
@@ -317,5 +329,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_multi  multi file structure
@@ -348,5 +360,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_multi multi file structure
@@ -391,5 +403,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date October, 2014
    !> - use mpp file structure instead of file
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/phycst.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/phycst.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/phycst.f90	(revision 5682)
@@ -25,4 +25,5 @@
    PUBLIC :: dp_rearth  !< earth radius (km)
    PUBLIC :: dp_deg2rad !< degree to radian ratio 
+   PUBLIC :: dp_rad2deg !< radian to degree ratio 
    PUBLIC :: dp_delta   !<  
 
@@ -31,6 +32,7 @@
    REAL(dp), PARAMETER :: dp_rearth = 6871._dp
    REAL(dp), PARAMETER :: dp_deg2rad = dp_pi/180.0
+   REAL(dp), PARAMETER :: dp_rad2deg = 180.0/dp_pi
 
-   REAL(dp), PARAMETER :: dp_delta=1.e-2
+   REAL(dp), PARAMETER :: dp_delta=1.e-6
 END MODULE phycst
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/variable.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/variable.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/variable.f90	(revision 5682)
@@ -281,4 +281,8 @@
 !> @date November, 2014 
 !> - Fix memory leaks bug
+!> @date June, 2015
+!> - change way to get variable information in namelist
+!> @date July, 2015 
+!> - add subroutine var_chg_unit to change unit of output variable
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -293,4 +297,5 @@
    USE att                             ! attribute manager
    USE dim                             ! dimension manager
+   USE math                            ! mathematical function
    IMPLICIT NONE
    ! NOTE_avoid_public_variables_if_possible
@@ -318,4 +323,5 @@
    PUBLIC :: var_concat        !< concatenate two variables
    PUBLIC :: var_limit_value   !< forced min and max value
+   PUBLIC :: var_chg_unit      !< change variable unit and value
    PUBLIC :: var_max_dim       !< get array of maximum dimension use
    PUBLIC :: var_reorder       !< reorder table of value in variable structure
@@ -382,4 +388,6 @@
    PRIVATE :: var__get_max       ! get maximum value from namelist 
    PRIVATE :: var__get_min       ! get minimum value from namelist
+   PRIVATE :: var__get_unf       ! get scale factor value from namelist
+   PRIVATE :: var__get_unt       ! get unit from namelist
    PRIVATE :: var__get_interp    ! get interpolation method from namelist
    PRIVATE :: var__get_extrap    ! get extrapolation method from namelist
@@ -401,5 +409,5 @@
       TYPE(TATT), DIMENSION(:), POINTER :: t_att => NULL() !< variable attributes
       TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim           !< variable dimension
-      
+ 
       LOGICAL           :: l_file = .FALSE.  !< variable read in a file
 
@@ -414,5 +422,8 @@
       REAL(dp)          :: d_min = dp_fill      !< minimum value 
       REAL(dp)          :: d_max = dp_fill      !< maximum value 
-      
+ 
+      CHARACTER(LEN=lc) :: c_unt = ''           !< new variables units (linked to units factor)
+      REAL(dp)          :: d_unf = 1._dp        !< units factor
+
       !!! netcdf4
       LOGICAL           :: l_contiguous = .FALSE. !< use contiguous storage or not
@@ -518,5 +529,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date November, 2014
    !> - use function instead of overload assignment operator (to avoid memory leak)
@@ -548,4 +559,7 @@
       var__copy_unit%d_min      = td_var%d_min
       var__copy_unit%d_max      = td_var%d_max
+
+      var__copy_unit%c_unt      = TRIM(td_var%c_unt)
+      var__copy_unit%d_unf      = td_var%d_unf
 
       var__copy_unit%i_type     = td_var%i_type
@@ -577,4 +591,5 @@
       var__copy_unit%c_units    = TRIM(td_var%c_units)
       var__copy_unit%c_axis     = TRIM(td_var%c_axis)
+      var__copy_unit%d_unf      = td_var%d_unf
       var__copy_unit%d_scf      = td_var%d_scf
       var__copy_unit%d_ofs      = td_var%d_ofs
@@ -627,5 +642,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !> @date November, 2014
    !> - use function instead of overload assignment operator 
@@ -656,5 +671,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable strucutre
@@ -695,5 +710,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[inout] td_var array of variable strucutre
@@ -718,5 +733,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[inout] td_var array of variable strucutre
@@ -744,5 +759,5 @@
    !
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[inout] td_var array of variable strucutre
@@ -788,4 +803,5 @@
    !>   - id_id : variable id (read from a file).
    !>   - id_ew : number of point composing east west wrap band.
+   !>   - dd_unf : real(8) value for units factor attribute.
    !>   - dd_scf : real(8) value for scale factor attribute.
    !>   - dd_ofs : real(8) value for add offset attribute.
@@ -801,4 +817,6 @@
    !>   - cd_extrap  : a array of character defining extrapolation method.
    !>   - cd_filter  : a array of character defining filtering method.
+   !>   - cd_unt : a string character to define output unit
+   !>   - dd_unf : real(8) factor applied to change unit
    !>
    !>  @note most of these optionals arguments will be inform automatically,
@@ -806,5 +824,9 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - Bug fix: conversion of the FillValue type (float case)
+   !> @date June, 2015 
+   !> - add unit factor (to change unit)
    !>
    !> @param[in] cd_name         variable name
@@ -833,4 +855,6 @@
    !> @param[in] cd_extrap       extrapolation method
    !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -843,5 +867,6 @@
    &                              ld_contiguous, ld_shuffle,&
    &                              ld_fletcher32, id_deflvl, id_chunksz, &
-   &                              cd_interp, cd_extrap, cd_filter )
+   &                              cd_interp, cd_extrap, cd_filter, &
+   &                              cd_unt, dd_unf )
       IMPLICIT NONE
       ! Argument
@@ -871,4 +896,6 @@
       CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
       CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
 
@@ -933,7 +960,7 @@
                tl_att=att_init('_FillValue', INT(dd_fill,i4) )
             CASE(NF90_FLOAT)
-               tl_att=att_init('_FillValue', INT(dd_fill,sp) )
+               tl_att=att_init('_FillValue', REAL(dd_fill,sp) )
             CASE DEFAULT ! NF90_DOUBLE
-                     tl_att=att_init('_FillValue', dd_fill )
+               tl_att=att_init('_FillValue', dd_fill )
          END SELECT
          CALL var_move_att(var__init, tl_att)
@@ -1038,4 +1065,16 @@
       ENDIF
 
+      ! units factor
+      IF( PRESENT(dd_unf) )THEN
+         tl_att=att_init('units_factor',dd_unf)
+         CALL var_move_att(var__init, tl_att)
+      ENDIF
+
+      ! new units (linked to units factor)
+      IF( PRESENT(cd_unt) )THEN
+         tl_att=att_init('new_units',cd_units)
+         CALL var_move_att(var__init, tl_att)
+      ENDIF
+
       ! add extra information
       CALL var__get_extra(var__init)
@@ -1047,4 +1086,6 @@
       CALL var_del_att(var__init, 'filter')
       CALL var_del_att(var__init, 'src_file')
+      CALL var_del_att(var__init, 'src_i_indices')
+      CALL var_del_att(var__init, 'src_j_indices')
       CALL var_del_att(var__init, 'valid_min')
       CALL var_del_att(var__init, 'valid_max')
@@ -1072,6 +1113,10 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !>
    !> @param[in] cd_name         variable name
    !> @param[in] dd_value        1D array of real(8) value
@@ -1100,4 +1145,9 @@
    !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -1110,5 +1160,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
       IMPLICIT NONE
       ! Argument
@@ -1138,4 +1190,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -1193,5 +1250,9 @@
       &                          ld_fletcher32=ld_fletcher32,        &
       &                          id_deflvl=id_deflvl,                &
-      &                          id_chunksz=id_chunksz(:))
+      &                          id_chunksz=id_chunksz(:),           &
+      &                          cd_interp=cd_interp(:),             &
+      &                          cd_extrap=cd_extrap(:),             &
+      &                          cd_filter=cd_filter(:),             &
+      &                          cd_unt=cd_unt, dd_unf=dd_unf )
    
       ! add value
@@ -1239,5 +1300,13 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - bug fix: array initialise with dimension
+   !> array not only one value
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> - Bux fix: dimension array initialise not only one value
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -1269,4 +1338,9 @@
    !> no deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -1279,5 +1353,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
       IMPLICIT NONE
       ! Argument
@@ -1307,4 +1383,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -1350,5 +1431,5 @@
       ENDIF
 
-      il_count(:)=tl_dim(1)%i_len
+      il_count(:)=tl_dim(:)%i_len
       IF( PRESENT(id_count) )THEN
          IF( SIZE(id_count(:)) /= 2 )THEN
@@ -1381,5 +1462,9 @@
       &                          ld_fletcher32=ld_fletcher32,        &
       &                          id_deflvl=id_deflvl,                &
-      &                          id_chunksz=id_chunksz(:))
+      &                          id_chunksz=id_chunksz(:),           &
+      &                          cd_interp=cd_interp(:),             &
+      &                          cd_extrap=cd_extrap(:),             &
+      &                          cd_filter=cd_filter(:),             &
+      &                          cd_unt=cd_unt, dd_unf=dd_unf )
    
       ! add value
@@ -1431,6 +1516,10 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !>
    !> @param[in] cd_name         variable name
    !> @param[in] dd_value        1D array of real(8) value
@@ -1461,4 +1550,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -1471,5 +1565,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
       IMPLICIT NONE
       ! Argument
@@ -1499,4 +1595,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -1577,5 +1678,9 @@
       &                          ld_fletcher32=ld_fletcher32,        &
       &                          id_deflvl=id_deflvl,                &
-      &                          id_chunksz=id_chunksz(:))
+      &                          id_chunksz=id_chunksz(:),           &
+      &                          cd_interp=cd_interp(:),             &
+      &                          cd_extrap=cd_extrap(:),             &
+      &                          cd_filter=cd_filter(:),             &
+      &                          cd_unt=cd_unt, dd_unf=dd_unf )
    
       ! add value
@@ -1623,6 +1728,10 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !>
    !> @param[in] cd_name         variable name
    !> @param[in] dd_value        4D array of real(8) value
@@ -1653,4 +1762,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -1663,5 +1777,7 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf )
       IMPLICIT NONE
       ! Argument
@@ -1691,4 +1807,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -1723,5 +1844,9 @@
       &                       ld_fletcher32=ld_fletcher32,        &
       &                       id_deflvl=id_deflvl,                &
-      &                       id_chunksz=id_chunksz(:))
+      &                       id_chunksz=id_chunksz(:),           &
+      &                       cd_interp=cd_interp(:),             &
+      &                       cd_extrap=cd_extrap(:),             &
+      &                       cd_filter=cd_filter(:),             &
+      &                       cd_unt=cd_unt, dd_unf=dd_unf )
  
       ! add value
@@ -1758,5 +1883,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -1788,4 +1917,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -1798,5 +1932,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -1827,4 +1963,10 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
 
       ! local variable
@@ -1870,5 +2012,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf )
  
       DEALLOCATE( dl_value )
@@ -1892,5 +2038,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         : variable name
@@ -1922,4 +2072,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      : chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -1932,5 +2087,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -1961,4 +2118,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -2006,5 +2168,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf )
       
       DEALLOCATE( dl_value )
@@ -2028,5 +2194,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         : variable name
@@ -2058,4 +2228,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      : chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -2068,5 +2243,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2097,4 +2274,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -2143,5 +2325,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -2165,5 +2351,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -2195,4 +2385,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -2205,5 +2400,7 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2234,4 +2431,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -2281,5 +2483,9 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:))
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -2303,5 +2509,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         : variable name
@@ -2333,4 +2543,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      : chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -2343,5 +2558,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2372,4 +2589,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -2415,5 +2637,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
  
       DEALLOCATE( dl_value )
@@ -2437,5 +2663,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -2465,4 +2695,9 @@
    !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -2475,5 +2710,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2504,4 +2741,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -2549,5 +2791,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -2571,5 +2817,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -2601,4 +2851,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -2611,5 +2866,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2640,4 +2897,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -2686,5 +2948,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -2708,5 +2974,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -2738,4 +3008,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -2748,5 +3023,7 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2777,4 +3054,10 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
 
       ! local variable
@@ -2824,5 +3107,9 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:))
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -2846,5 +3133,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -2876,4 +3167,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -2886,5 +3182,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -2915,4 +3213,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -2958,5 +3261,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
  
       DEALLOCATE( dl_value )
@@ -2980,5 +3287,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3010,4 +3321,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3020,5 +3336,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3049,4 +3367,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -3094,5 +3417,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -3116,5 +3443,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3146,4 +3477,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3156,5 +3492,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3185,4 +3523,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -3231,5 +3574,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -3253,5 +3600,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3283,4 +3634,10 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3293,5 +3650,7 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3322,4 +3681,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -3369,5 +3733,9 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:))
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -3391,5 +3759,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3421,4 +3793,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3431,5 +3808,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3460,4 +3839,10 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
 
       ! local variable
@@ -3503,5 +3888,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
  
       DEALLOCATE( dl_value )
@@ -3525,5 +3914,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3555,4 +3948,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3565,5 +3963,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3594,4 +3994,10 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
 
       ! local variable
@@ -3639,5 +4045,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -3661,5 +4071,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3691,4 +4105,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3701,5 +4120,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3730,4 +4151,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -3776,5 +4202,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -3798,5 +4228,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3828,4 +4262,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3838,5 +4277,7 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -3867,4 +4308,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -3914,5 +4360,9 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:))
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -3936,5 +4386,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -3966,4 +4420,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -3976,5 +4435,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -4005,4 +4466,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -4048,5 +4514,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
  
       DEALLOCATE( dl_value )
@@ -4070,5 +4540,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -4100,4 +4574,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -4110,5 +4589,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -4139,4 +4620,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -4184,5 +4670,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -4206,5 +4696,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -4236,4 +4730,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -4246,5 +4745,7 @@
    &                                    dd_min, dd_max,           &
    &                                    ld_contiguous, ld_shuffle,&
-   &                                    ld_fletcher32, id_deflvl, id_chunksz)
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -4275,4 +4776,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -4321,5 +4827,9 @@
       &                         ld_fletcher32=ld_fletcher32,        &
       &                         id_deflvl=id_deflvl,                &
-      &                         id_chunksz=id_chunksz(:))
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -4343,5 +4853,9 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
    !
    !> @param[in] cd_name         variable name
@@ -4373,4 +4887,9 @@
    !> deflation is in use
    !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
    !> @return variable structure
    !-------------------------------------------------------------------
@@ -4383,5 +4902,7 @@
    &                                 dd_min, dd_max,           &
    &                                 ld_contiguous, ld_shuffle,&
-   &                                 ld_fletcher32, id_deflvl, id_chunksz)
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
 
       IMPLICIT NONE
@@ -4412,4 +4933,9 @@
       INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
       INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
 
       ! local variable
@@ -4459,5 +4985,9 @@
       &                      ld_fletcher32=ld_fletcher32,        &
       &                      id_deflvl=id_deflvl,                &
-      &                      id_chunksz=id_chunksz(:))
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
       
       DEALLOCATE( dl_value )
@@ -4473,5 +5003,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4523,5 +5053,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4595,5 +5125,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4670,5 +5200,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4745,5 +5275,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var1   variable structure
@@ -4820,5 +5350,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - add all element of the array in the same time
    !>
    !> @param[inout] td_var variable structure
@@ -4833,4 +5365,7 @@
       ! local variable
       INTEGER(i4) :: il_natt
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
 
       ! loop indices
@@ -4840,7 +5375,103 @@
       il_natt=SIZE(td_att(:))
 
+      IF( td_var%i_natt > 0 )THEN
+      ! already other attribute in variable structure
+         ALLOCATE( tl_att(td_var%i_natt), stat=il_status )
+         IF(il_status /= 0 )THEN
+
+            CALL logger_error( &
+            &  " VAR ADD ATT: not enough space to put attributes from "//&
+            &  TRIM(td_var%c_name)//" in temporary attribute structure")
+
+         ELSE
+
+            ! save temporary global attribute's variable structure
+            tl_att(:)=att_copy(td_var%t_att(:))
+
+            CALL att_clean(td_var%t_att(:))
+            DEALLOCATE( td_var%t_att )
+            ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( &
+               &  " VAR ADD ATT: not enough space to put attributes "//&
+               &  "in variable structure "//TRIM(td_var%c_name) )
+
+            ENDIF
+
+            ! copy attribute in variable before
+            td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:))
+
+            ! clean
+            CALL att_clean(tl_att(:))
+            DEALLOCATE(tl_att)
+            
+         ENDIF
+      ELSE
+      ! no attribute in variable structure
+         IF( ASSOCIATED(td_var%t_att) )THEN
+            CALL att_clean(td_var%t_att(:))
+            DEALLOCATE(td_var%t_att)
+         ENDIF
+         ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status )
+         IF(il_status /= 0 )THEN
+
+            CALL logger_error( &
+            &  " VAR ADD ATT: not enough space to put attributes "//&
+            &  "in variable structure "//TRIM(td_var%c_name) )
+
+         ENDIF
+      ENDIF
+
+      ALLOCATE( tl_att(il_natt) )
+      tl_att(:)=att_copy(td_att(:))
+
+      ! check if attribute already in variable structure
       DO ji=1,il_natt
-         CALL var_add_att(td_var, td_att(ji))
+         il_ind=0
+         il_ind=att_get_index( td_var%t_att(:), tl_att(ji)%c_name )
+         IF( il_ind /= 0 )THEN
+            CALL logger_error( &
+            &  " VAR ADD ATT: attribute "//TRIM(tl_att(ji)%c_name)//&
+            &  ", already in variable "//TRIM(td_var%c_name) )
+            CALL att_clean(tl_att(ji))
+         ENDIF
       ENDDO
+
+      ! add new attributes
+      td_var%t_att(td_var%i_natt+1:td_var%i_natt+il_natt)=att_copy(tl_att(:))
+
+      DEALLOCATE(tl_att)
+
+      DO ji=1,il_natt
+         ! highlight some attribute
+         IF( ASSOCIATED(td_var%t_att(td_var%i_natt+ji)%d_value) .OR. &
+           & td_var%t_att(td_var%i_natt+ji)%c_value /= 'none' )THEN
+            SELECT CASE(TRIM(td_var%t_att(td_var%i_natt+ji)%c_name))
+
+               CASE("add_offset")
+                  td_var%d_ofs = td_var%t_att(td_var%i_natt+ji)%d_value(1)
+               CASE("scale_factor")
+                  td_var%d_scf = td_var%t_att(td_var%i_natt+ji)%d_value(1)
+               CASE("_FillValue")
+                  td_var%d_fill = td_var%t_att(td_var%i_natt+ji)%d_value(1)
+               CASE("ew_overlap")
+                  td_var%i_ew = INT(td_var%t_att(td_var%i_natt+ji)%d_value(1),i4) 
+               CASE("standard_name")
+                  td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
+               CASE("long_name")
+                  td_var%c_longname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
+               CASE("units")
+                  td_var%c_units = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
+               CASE("grid_point")
+                  td_var%c_point = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
+
+            END SELECT
+         ENDIF
+      ENDDO
+
+      ! update number of attribute
+      td_var%i_natt=td_var%i_natt+il_natt
+
 
    END SUBROUTINE var__add_att_arr
@@ -4850,5 +5481,7 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - use var__add_att_arr subroutine
    !
    !> @param[inout] td_var variable structure
@@ -4862,117 +5495,14 @@
 
       ! local variable
-      INTEGER(i4) :: il_status
-      INTEGER(i4) :: il_ind
-      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
+      TYPE(TATT), DIMENSION(1) :: tl_att
 
       ! loop indices
-      INTEGER(i4) :: ji
       !----------------------------------------------------------------
 
-      ! check if attribute already in variable structure
-      il_ind=0
-      IF( ASSOCIATED(td_var%t_att) )THEN
-         il_ind=att_get_index( td_var%t_att(:), td_att%c_name )
-      ENDIF
-
-      IF( il_ind /= 0 )THEN
-
-         CALL logger_error( &
-         &  " VAR ADD ATT: attribute "//TRIM(td_att%c_name)//&
-         &  ", already in variable "//TRIM(td_var%c_name) )
-
-         DO ji=1,td_var%i_natt
-            CALL logger_debug( &
-            &  " VAR ADD ATT: in variable "//TRIM(td_var%t_att(ji)%c_name) )
-         ENDDO
-
-      ELSE
-         
-         CALL logger_trace( &
-         &  " VAR ADD ATT: add attribute "//TRIM(td_att%c_name)//&
-         &  ", in variable "//TRIM(td_var%c_name) )
-
-         IF( td_var%i_natt > 0 )THEN
-         ! already other attribute in variable structure
-            ALLOCATE( tl_att(td_var%i_natt), stat=il_status )
-            IF(il_status /= 0 )THEN
-
-               CALL logger_error( &
-               &  " VAR ADD ATT: not enough space to put attributes from "//&
-               &  TRIM(td_var%c_name)//" in temporary attribute structure")
-
-            ELSE
-
-               ! save temporary global attribute's variable structure
-               tl_att(:)=att_copy(td_var%t_att(:))
-
-               CALL att_clean(td_var%t_att(:))
-               DEALLOCATE( td_var%t_att )
-               ALLOCATE( td_var%t_att(td_var%i_natt+1), stat=il_status )
-               IF(il_status /= 0 )THEN
-
-                  CALL logger_error( &
-                  &  " VAR ADD ATT: not enough space to put attributes "//&
-                  &  "in variable structure "//TRIM(td_var%c_name) )
-
-               ENDIF
-
-               ! copy attribute in variable before
-               td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:))
-
-               ! clean
-               CALL att_clean(tl_att(:))
-               DEALLOCATE(tl_att)
-               
-            ENDIF
-         ELSE
-         ! no attribute in variable structure
-            IF( ASSOCIATED(td_var%t_att) )THEN
-               CALL att_clean(td_var%t_att(:))
-               DEALLOCATE(td_var%t_att)
-            ENDIF
-            ALLOCATE( td_var%t_att(td_var%i_natt+1), stat=il_status )
-            IF(il_status /= 0 )THEN
-
-               CALL logger_error( &
-               &  " VAR ADD ATT: not enough space to put attributes "//&
-               &  "in variable structure "//TRIM(td_var%c_name) )
-
-            ENDIF
-         ENDIF
-         ! update number of attribute
-         td_var%i_natt=td_var%i_natt+1
-
-         ! add new attribute
-         td_var%t_att(td_var%i_natt)=att_copy(td_att)
-
-         !! add new attribute id
-         !td_var%t_att(td_var%i_natt)%i_id=att_get_unit(td_var%t_att(:))
-
-         ! highlight some attribute
-         IF( ASSOCIATED(td_var%t_att(td_var%i_natt)%d_value) .OR. &
-           & td_var%t_att(td_var%i_natt)%c_value /= "none" )THEN
-            SELECT CASE(TRIM(td_var%t_att(td_var%i_natt)%c_name))
-
-               CASE("add_offset")
-                  td_var%d_ofs = td_var%t_att(td_var%i_natt)%d_value(1)
-               CASE("scale_factor")
-                  td_var%d_scf = td_var%t_att(td_var%i_natt)%d_value(1)
-               CASE("_FillValue")
-                  td_var%d_fill = td_var%t_att(td_var%i_natt)%d_value(1)
-               CASE("ew_overlap")
-                  td_var%i_ew = INT(td_var%t_att(td_var%i_natt)%d_value(1),i4) 
-               CASE("standard_name")
-                  td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt)%c_value)
-               CASE("long_name")
-                  td_var%c_longname = TRIM(td_var%t_att(td_var%i_natt)%c_value)
-               CASE("units")
-                  td_var%c_units = TRIM(td_var%t_att(td_var%i_natt)%c_value)
-               CASE("grid_point")
-                  td_var%c_point = TRIM(td_var%t_att(td_var%i_natt)%c_value)
-
-            END SELECT
-         ENDIF
-      ENDIF
+      ! copy structure in an array
+      tl_att(1)=att_copy(td_att)
+
+      ! 
+      CALL var_add_att( td_var, tl_att(:) )
 
    END SUBROUTINE var__add_att_unit
@@ -4982,5 +5512,8 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - define local attribute structure to avoid mistake 
+   !> with pointer
    !
    !> @param[inout] td_var variable structure
@@ -4996,4 +5529,5 @@
       INTEGER(i4) :: il_ind
 
+      TYPE(TATT)  :: tl_att
       ! loop indices
       !----------------------------------------------------------------
@@ -5007,5 +5541,5 @@
       IF( il_ind == 0 )THEN
 
-         CALL logger_warn( &
+         CALL logger_debug( &
          &  " VAR DEL ATT: no attribute "//TRIM(cd_name)//&
          &  ", in variable "//TRIM(td_var%c_name) )
@@ -5013,5 +5547,6 @@
       ELSE
          
-         CALL var_del_att(td_var, td_var%t_att(il_ind))
+         tl_att=att_copy(td_var%t_att(il_ind))
+         CALL var_del_att(td_var, tl_att)
 
       ENDIF
@@ -5023,5 +5558,8 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013- Initial Version
+   !> @date February, 2015 
+   !> - delete highlight attribute too, when attribute 
+   !> is deleted
    !
    !> @param[inout] td_var variable structure
@@ -5040,5 +5578,4 @@
 
       ! loop indices
-      !INTEGER(i4) :: ji
       !----------------------------------------------------------------
 
@@ -5051,5 +5588,5 @@
       IF( il_ind == 0 )THEN
 
-         CALL logger_warn( &
+         CALL logger_debug( &
          &  " VAR DEL ATT: no attribute "//TRIM(td_att%c_name)//&
          &  ", in variable "//TRIM(td_var%c_name) )
@@ -5103,9 +5640,4 @@
                td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:))
 
-               !! change attribute id
-               !DO ji=1,td_var%i_natt
-               !   td_var%t_att(ji)%i_id=ji
-               !ENDDO
-
                ! clean
                CALL att_clean(tl_att(:))
@@ -5113,4 +5645,27 @@
             ENDIF 
          ENDIF
+
+         ! highlight attribute
+         SELECT CASE( TRIM(td_att%c_name) )
+
+            CASE("add_offset")
+               td_var%d_ofs = 0._dp
+            CASE("scale_factor")
+               td_var%d_scf = 1._dp
+            CASE("_FillValue")
+               td_var%d_fill = 0._dp
+            CASE("ew_overlap")
+               td_var%i_ew = -1 
+            CASE("standard_name")
+               td_var%c_stdname = ''
+            CASE("long_name")
+               td_var%c_longname = ''
+            CASE("units")
+               td_var%c_units = ''
+            CASE("grid_point")
+               td_var%c_point = ''
+
+         END SELECT
+
       ENDIF
 
@@ -5121,5 +5676,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5156,5 +5711,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5195,5 +5750,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5211,5 +5766,5 @@
       !----------------------------------------------------------------
 
-      IF( td_var%i_ndim <= 4 )THEN
+      IF( td_var%i_ndim <= ip_maxdim )THEN
 
          ! check if dimension already used in variable structure
@@ -5227,6 +5782,7 @@
          ELSE
 
-         ! back to unorder dimension array 
-         CALL dim_unorder(td_var%t_dim(:))
+            ! back to disorder dimension array 
+            CALL dim_disorder(td_var%t_dim(:))
+
             ! add new dimension
             td_var%t_dim(td_var%i_ndim+1)=dim_copy(td_dim)
@@ -5253,5 +5809,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5272,5 +5828,5 @@
       !----------------------------------------------------------------
 
-      IF( td_var%i_ndim <= 4 )THEN
+      IF( td_var%i_ndim <= ip_maxdim )THEN
 
          CALL logger_trace( &
@@ -5317,5 +5873,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5360,5 +5916,5 @@
    !>
    !> @author J.Paul
-   !> - June, 2014- Initial Version
+   !> @date June, 2014 - Initial Version
    !
    !> @param[in] td_var array of variables structure
@@ -5386,5 +5942,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var    variable structure
@@ -5493,5 +6049,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -5631,5 +6187,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -5685,5 +6241,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -5761,5 +6317,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variabele structure
@@ -5837,5 +6393,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variabele structure
@@ -5913,5 +6469,5 @@
    !
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variabele structure
@@ -5987,5 +6543,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -6057,5 +6613,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -6080,5 +6636,5 @@
    !>
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !>
    !> @param[in] td_var       array of variable structure
@@ -6145,5 +6701,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var       array of variable structure
@@ -6200,5 +6756,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var array of variable structure
@@ -6239,5 +6795,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var array of variable structure
@@ -6322,5 +6878,7 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - new namelist format to get extra information (interpolation,...)
    !
    !> @param[in] cd_file   configuration file of variable
@@ -6357,5 +6915,4 @@
 
          il_fileid=fct_getunit()
-         CALL logger_trace("VAR DEF EXTRA: open "//TRIM(cd_file))
          OPEN( il_fileid, FILE=TRIM(cd_file), &
          &                FORM='FORMATTED',   &
@@ -6366,5 +6923,6 @@
          CALL fct_err(il_status)
          IF( il_status /= 0 )THEN
-            CALL logger_error("VAR DEF EXTRA: opening file "//TRIM(cd_file))
+            CALL logger_fatal("VAR DEF EXTRA: can not open file "//&
+            &                 TRIM(cd_file))
          ENDIF
 
@@ -6375,5 +6933,5 @@
          DO WHILE( il_status == 0 )
 
-         ! search line do not beginning with comment character
+         ! search line not beginning with comment character
             IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN
                il_nvar=il_nvar+1
@@ -6419,13 +6977,14 @@
                   tg_varextra(ji)%c_axis    =TRIM(fct_split(cl_line,3))
                   tg_varextra(ji)%c_point   =TRIM(fct_split(cl_line,4))
-                  tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,5))
-                  tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6))
-
-                  cl_interp=TRIM(fct_split(cl_line,7))
+
+                  cl_interp='int='//TRIM(fct_split(cl_line,5))
                   tg_varextra(ji)%c_interp(:) = &
                   &  var__get_interp(TRIM(tg_varextra(ji)%c_name), cl_interp)
                   CALL logger_debug("VAR DEF EXTRA: "//&
                   &  TRIM(tg_varextra(ji)%c_name)//&
-                  &  " "//TRIM(cl_interp))
+                  &  " "//TRIM(tg_varextra(ji)%c_interp(1)))
+
+                  tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6))
+                  tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,7))
                ELSE
                   ji=ji-1
@@ -6458,5 +7017,5 @@
    !> @details 
    !> string character format must be : <br/>
-   !> "varname:interp; filter; extrap; > min; < max"<br/>
+   !> "varname:int=interp; flt=filter; ext=extrap; min=min; max=max"<br/>
    !> you could specify only interpolation, filter or extrapolation method, 
    !> whatever the order. you could find more
@@ -6464,6 +7023,10 @@
    !> \ref extrap module.<br/>
    !> Examples: 
-   !> cn_varinfo='Bathymetry:2*hamming(2,3); > 10.'
-   !> cn_varinfo='votemper:cubic; dist_weight; <40.'
+   !> cn_varinfo='Bathymetry:flt=2*hamming(2,3); min=10.'
+   !> cn_varinfo='votemper:int=cubic; ext=dist_weight; max=40.'
+   !>
+   !>
+   !> @warning variable should be define in tg_varextra (ie in configuration
+   !> file, to be able to add information from namelist
    !>
    !> @note If you do not specify a method which is required, default one is
@@ -6471,5 +7034,7 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - get unit and unit factor (to change unit) 
    !
    !> @param[in] cd_varinfo   variable information from namelist
@@ -6486,4 +7051,5 @@
       CHARACTER(LEN=lc), DIMENSION(1)              :: cl_extrap
       CHARACTER(LEN=lc), DIMENSION(5)              :: cl_filter
+      CHARACTER(LEN=lc)                            :: cl_unt
 
       INTEGER(i4)                                  :: il_ind
@@ -6492,4 +7058,5 @@
       REAL(dp)                                     :: dl_min
       REAL(dp)                                     :: dl_max
+      REAL(dp)                                     :: dl_unf
 
       TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE :: tl_varextra
@@ -6508,7 +7075,10 @@
             dl_min=var__get_min(cl_name, cl_method)
             dl_max=var__get_max(cl_name, cl_method)
+            dl_unf=var__get_unf(cl_name, cl_method)
             cl_interp(:)=var__get_interp(cl_name, cl_method)
             cl_extrap(:)=var__get_extrap(cl_name, cl_method)
             cl_filter(:)=var__get_filter(cl_name, cl_method)
+            cl_unt=var__get_unt(cl_name, cl_method)
+
 
             il_ind=var_get_index(tg_varextra(:), TRIM(cl_name))
@@ -6516,4 +7086,6 @@
                IF( dl_min /= dp_fill ) tg_varextra(il_ind)%d_min=dl_min
                IF( dl_max /= dp_fill ) tg_varextra(il_ind)%d_max=dl_max
+               IF( dl_unf /= dp_fill ) tg_varextra(il_ind)%d_unf=dl_unf
+               IF(cl_unt      /='') tg_varextra(il_ind)%c_unt      =cl_unt
                IF(cl_interp(1)/='') tg_varextra(il_ind)%c_interp(:)=cl_interp(:)
                IF(cl_extrap(1)/='') tg_varextra(il_ind)%c_extrap(:)=cl_extrap(:)
@@ -6551,24 +7123,34 @@
                &                               cd_filter=cl_filter(:), &
                &                               dd_min = dl_min, &
-               &                               dd_max = dl_max )
+               &                               dd_max = dl_max, &
+               &                               cd_unt = cl_unt, &
+               &                               dd_unf = dl_unf )
 
             ENDIF
 
             ji=ji+1
-            CALL logger_trace( "VAR CHG EXTRA: name       "//&
+            CALL logger_debug( "VAR CHG EXTRA: name       "//&
             &                  TRIM(tg_varextra(il_ind)%c_name) )
-            CALL logger_trace( "VAR CHG EXTRA: interp     "//&
+            CALL logger_debug( "VAR CHG EXTRA: interp     "//&
             &                  TRIM(tg_varextra(il_ind)%c_interp(1)) )         
-            CALL logger_trace( "VAR CHG EXTRA: filter     "//&
+            CALL logger_debug( "VAR CHG EXTRA: filter     "//&
             &                  TRIM(tg_varextra(il_ind)%c_filter(1)) )         
-            CALL logger_trace( "VAR CHG EXTRA: extrap     "//&
+            CALL logger_debug( "VAR CHG EXTRA: extrap     "//&
             &                  TRIM(tg_varextra(il_ind)%c_extrap(1)) )
             IF( tg_varextra(il_ind)%d_min /= dp_fill )THEN
-               CALL logger_trace( "VAR CHG EXTRA: min value  "//&
+               CALL logger_debug( "VAR CHG EXTRA: min value  "//&
                &                  TRIM(fct_str(tg_varextra(il_ind)%d_min)) )
             ENDIF
             IF( tg_varextra(il_ind)%d_max /= dp_fill )THEN
-               CALL logger_trace( "VAR CHG EXTRA: max value  "//&
+               CALL logger_debug( "VAR CHG EXTRA: max value  "//&
                &                  TRIM(fct_str(tg_varextra(il_ind)%d_max)) )
+            ENDIF
+            IF( TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN
+               CALL logger_debug( "VAR CHG EXTRA: new unit  "//&
+               &                  TRIM(tg_varextra(il_ind)%c_unt) )
+            ENDIF
+            IF( tg_varextra(il_ind)%d_unf /= 1. )THEN
+               CALL logger_debug( "VAR CHG EXTRA: new unit factor  "//&
+               &                  TRIM(fct_str(tg_varextra(il_ind)%d_unf)) )
             ENDIF
          ENDDO
@@ -6593,5 +7175,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -6687,5 +7269,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !>
    !> @param[inout] td_var variable structure
@@ -6808,13 +7390,16 @@
             ENDIF
 
-         CALL logger_trace("VAR GET EXTRA: name       "//TRIM(td_var%c_name))
-         CALL logger_trace("VAR GET EXTRA: stdname    "//TRIM(td_var%c_stdname))
-         CALL logger_trace("VAR GET EXTRA: longname   "//TRIM(td_var%c_longname))
-         CALL logger_trace("VAR GET EXTRA: units      "//TRIM(td_var%c_units))
-         CALL logger_trace("VAR GET EXTRA: point      "//TRIM(td_var%c_point))
-         CALL logger_trace("VAR GET EXTRA: interp     "//TRIM(td_var%c_interp(1)))
-         CALL logger_trace("VAR GET EXTRA: filter     "//TRIM(td_var%c_filter(1)))
-         CALL logger_trace("VAR GET EXTRA: min value  "//TRIM(fct_str(td_var%d_min)))
-         CALL logger_trace("VAR GET EXTRA: max value  "//TRIM(fct_str(td_var%d_max)))
+            ! unt
+            IF( TRIM(td_var%c_unt) == '' .AND. &
+            &   TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN
+               td_var%c_unt=TRIM(tg_varextra(il_ind)%c_unt)
+            ENDIF
+
+            ! units factor
+            IF( td_var%d_unf == 1._dp .AND. &
+            &   tg_varextra(il_ind)%d_unf /= 1._dp )THEN
+               td_var%d_unf=tg_varextra(il_ind)%d_unf
+            ENDIF
+
          ENDIF
 
@@ -6833,8 +7418,11 @@
    !> 
    !> @details
-   !> minimum value is assume to follow sign '>'
+   !> minimum value is assume to follow string "min ="
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "min ="
    !
    !> @param[in] cd_name      variable name
@@ -6867,7 +7455,7 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
-         il_ind=SCAN(TRIM(cl_tmp),'>')
+         il_ind=INDEX(TRIM(cl_tmp),'min')
          IF( il_ind /= 0 )THEN
-            cl_min=TRIM(ADJUSTL(cl_tmp(il_ind+1:)))
+            cl_min=fct_split(cl_tmp,2,'=')
             EXIT
          ENDIF
@@ -6877,5 +7465,5 @@
 
       IF( TRIM(cl_min) /= '' )THEN
-         IF( fct_is_num(cl_min) )THEN
+         IF( fct_is_real(cl_min) )THEN
             READ(cl_min,*) var__get_min
             CALL logger_debug("VAR GET MIN: will use minimum value of "//&
@@ -6894,8 +7482,11 @@
    !> 
    !> @details
-   !> maximum value is assume to follow sign '<'
+   !> maximum value is assume to follow string "max ="
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "max ="
    !
    !> @param[in] cd_name      variable name
@@ -6928,7 +7519,7 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
-         il_ind=SCAN(TRIM(cl_tmp),'<')
+         il_ind=INDEX(TRIM(cl_tmp),'max')
          IF( il_ind /= 0 )THEN
-            cl_max=TRIM(ADJUSTL(cl_tmp(il_ind+1:)))
+            cl_max=fct_split(cl_tmp,2,'=')
             EXIT
          ENDIF
@@ -6938,5 +7529,5 @@
 
       IF( TRIM(cl_max) /= '' )THEN
-         IF( fct_is_num(cl_max) )THEN
+         IF( fct_is_real(cl_max) )THEN
             READ(cl_max,*) var__get_max
             CALL logger_debug("VAR GET MAX: will use maximum value of "//&
@@ -6952,18 +7543,87 @@
    !> @brief
    !> This function check if variable information read in namelist contains 
+   !> units factor value and return it if true. 
+   !> 
+   !> @details
+   !> units factor value is assume to follow string "unf ="
+   !>
+   !> @author J.Paul
+   !> @date June, 2015 - Initial Version
+   !
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist 
+   !> @return untis factor value to be used (FillValue if none)
+   !-------------------------------------------------------------------
+   FUNCTION var__get_unf( cd_name, cd_varinfo )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      REAL(dp) :: var__get_unf
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_unf
+      
+      INTEGER(i4)       :: il_ind
+
+      REAL(dp)          :: rl_unf
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! init
+      cl_unf=''
+      var__get_unf=dp_fill
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'unf')
+         IF( il_ind /= 0 )THEN
+            cl_unf=fct_split(cl_tmp,2,'=')
+            EXIT
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cl_unf) /= '' )THEN
+         rl_unf=math_compute(cl_unf)
+         IF( rl_unf /= dp_fill )THEN
+            var__get_unf = rl_unf
+            CALL logger_debug("VAR GET UNITS FACTOR: will use units factor "//&
+               &  "value of "//TRIM(fct_str(var__get_unf))//" for variable "//&
+               &   TRIM(cd_name) )
+         ELSE
+            CALL logger_error("VAR GET UNITS FACTOR: invalid units factor "//&
+               &  "value for variable "//TRIM(cd_name)//". check namelist." )
+         ENDIF
+      ENDIF
+
+   END FUNCTION var__get_unf
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
    !> interpolation method and return it if true. 
    !> 
    !> @details 
-   !> split namelist information, using ';' as separator.
+   !> interpolation method is assume to follow string "int ="
+   !>
    !> compare method name with the list of interpolation method available (see
    !> module global).
    !> check if factor (*rhoi, /rhoj..) are present.<br/>
    !> Example:<br/> 
-   !> - cubic/rhoi ; dist_weight
-   !> - bilin
+   !> - int=cubic/rhoi ; ext=dist_weight
+   !> - int=bilin
    !> see @ref interp module for more information.
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "int ="
    !
    !> @param[in] cd_name      variable name
@@ -6982,4 +7642,5 @@
       ! local variable
       CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_int
       CHARACTER(LEN=lc) :: cl_factor
       
@@ -7000,6 +7661,16 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'int')
+         IF( il_ind /= 0 )THEN
+            cl_int=fct_split(cl_tmp,2,'=')
+            EXIT
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cl_int) /= '' )THEN
          DO jj=1,ip_ninterp
-            il_ind= INDEX(fct_lower(cl_tmp),TRIM(cp_interp_list(jj)))
+            il_ind= INDEX(fct_lower(cl_int),TRIM(cp_interp_list(jj)))
             IF( il_ind /= 0 )THEN
 
@@ -7009,7 +7680,7 @@
                ! look for factor
                IF( il_ind==1 )THEN
-                  cl_factor=cl_tmp(il_len+1:)
+                  cl_factor=cl_int(il_len+1:)
                ELSE
-                  cl_factor=cl_tmp(1:il_ind-1)
+                  cl_factor=cl_int(1:il_ind-1)
                ENDIF
                il_mul=SCAN(TRIM(cl_factor),'*')
@@ -7052,8 +7723,5 @@
             ENDIF
          ENDDO
-         IF( jj /= ip_ninterp + 1 ) EXIT
-         ji=ji+1
-         cl_tmp=fct_split(cd_varinfo,ji,';')         
-      ENDDO
+      ENDIF
 
    END FUNCTION var__get_interp
@@ -7064,14 +7732,18 @@
    !> 
    !> @details 
-   !> split namelist information, using ';' as separator.
+   !> extrapolation method is assume to follow string "ext ="
+   !> 
    !> compare method name with the list of extrapolation method available (see
    !> module global).<br/>
    !> Example:<br/>
-   !> - cubic ; dist_weight
-   !> - min_error
+   !> - int=cubic ; ext=dist_weight
+   !> - ext=min_error
    !> see @ref extrap module for more information.
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "ext ="
    !
    !> @param[in] cd_name      variable name
@@ -7090,4 +7762,7 @@
       ! local variable
       CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_ext
+
+      INTEGER(i4)       :: il_ind
 
       ! loop indices
@@ -7101,6 +7776,16 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'ext')
+         IF( il_ind /= 0 )THEN
+            cl_ext=fct_split(cl_tmp,2,'=')
+            EXIT
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cl_ext) /= '' )THEN
          DO jj=1,ip_nextrap
-            IF( TRIM(fct_lower(cl_tmp)) == TRIM(cp_extrap_list(jj)) )THEN
+            IF( TRIM(fct_lower(cl_ext)) == TRIM(cp_extrap_list(jj)) )THEN
                var__get_extrap(1)=TRIM(cp_extrap_list(jj))
 
@@ -7111,8 +7796,5 @@
             ENDIF
          ENDDO
-         IF( jj /= ip_nextrap + 1 ) EXIT
-         ji=ji+1
-         cl_tmp=fct_split(cd_varinfo,ji,';')         
-      ENDDO
+      ENDIF
 
 
@@ -7124,17 +7806,21 @@
    !> 
    !> @details 
-   !> split namelist information, using ';' as separator.
+   !> filter method is assume to follow string "flt ="
+   !>
    !> compare method name with the list of filter method available (see
    !> module global).
-   !> look for the number of turn, using '*' separator, and method parameters inside
+   !> look for the number of run, using '*' separator, and method parameters inside
    !> bracket.<br/>
    !> Example:<br/>
-   !> - cubic ; 2*hamming(2,3)
-   !> - hann
+   !> - int=cubic ; flt=2*hamming(2,3)
+   !> - flt=hann
    !> see @ref filter module for more information.
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
-   !
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "flt ="
+   !>
    !> @param[in] cd_name      variable name
    !> @param[in] cd_varinfo   variable information read in namelist 
@@ -7151,4 +7837,5 @@
       ! local variable
       CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_flt
       INTEGER(i4)       :: il_ind
 
@@ -7163,16 +7850,26 @@
       cl_tmp=fct_split(cd_varinfo,ji,';')
       DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'flt')
+         IF( il_ind /= 0 )THEN
+            cl_flt=fct_split(cl_tmp,2,'=')
+            EXIT
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+      
+      IF( TRIM(cl_flt) /= '' )THEN
          DO jj=1,ip_nfilter
-            il_ind=INDEX(fct_lower(cl_tmp),TRIM(cp_filter_list(jj)))
+            il_ind=INDEX(fct_lower(cl_flt),TRIM(cp_filter_list(jj)))
             IF( il_ind /= 0 )THEN
                var__get_filter(1)=TRIM(cp_filter_list(jj))
 
-               ! look for number of turn
-               il_ind=SCAN(fct_lower(cl_tmp),'*')
+               ! look for number of run
+               il_ind=SCAN(fct_lower(cl_flt),'*')
                IF( il_ind /=0 )THEN
-                  IF( fct_is_num(cl_tmp(1:il_ind-1)) )THEN
-                     var__get_filter(2)=TRIM(cl_tmp(1:il_ind-1))
-                  ELSE IF( fct_is_num(cl_tmp(il_ind+1:)) )THEN
-                     var__get_filter(2)=TRIM(cl_tmp(il_ind+1:))
+                  IF( fct_is_num(cl_flt(1:il_ind-1)) )THEN
+                     var__get_filter(2)=TRIM(cl_flt(1:il_ind-1))
+                  ELSE IF( fct_is_num(cl_flt(il_ind+1:)) )THEN
+                     var__get_filter(2)=TRIM(cl_flt(il_ind+1:))
                   ELSE
                      var__get_filter(2)='1'
@@ -7183,16 +7880,16 @@
 
                ! look for filter parameter
-               il_ind=SCAN(fct_lower(cl_tmp),'(')
+               il_ind=SCAN(fct_lower(cl_flt),'(')
                IF( il_ind /=0 )THEN
-                  cl_tmp=TRIM(cl_tmp(il_ind+1:))
-                  il_ind=SCAN(fct_lower(cl_tmp),')')
+                  cl_flt=TRIM(cl_flt(il_ind+1:))
+                  il_ind=SCAN(fct_lower(cl_flt),')')
                   IF( il_ind /=0 )THEN
-                     cl_tmp=TRIM(cl_tmp(1:il_ind-1))
+                     cl_flt=TRIM(cl_flt(1:il_ind-1))
                      ! look for cut-off frequency
-                     var__get_filter(3)=fct_split(cl_tmp,1,',')
+                     var__get_filter(3)=fct_split(cl_flt,1,',')
                      ! look for halo size
-                     var__get_filter(4)=fct_split(cl_tmp,2,',')
+                     var__get_filter(4)=fct_split(cl_flt,2,',')
                      ! look for alpha parameter
-                     var__get_filter(5)=fct_split(cl_tmp,3,',')
+                     var__get_filter(5)=fct_split(cl_flt,3,',')
                   ELSE
                      CALL logger_error("VAR GET FILTER: variable "//&
@@ -7215,10 +7912,61 @@
             ENDIF
          ENDDO
-         IF( jj /= ip_nfilter + 1 ) EXIT
+      ENDIF
+
+   END FUNCTION var__get_filter
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> unit and return it if true. 
+   !> 
+   !> @details 
+   !> unit is assume to follow string "unt ="
+   !>
+   !> @author J.Paul
+   !> @date June, 2015 - Initial Version
+   !
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist
+   !> @return unit string character 
+   !-------------------------------------------------------------------
+   FUNCTION var__get_unt( cd_name, cd_varinfo )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      CHARACTER(LEN=lc)               :: var__get_unt
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      var__get_unt=''
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'unt')
+         IF( il_ind /= 0 )THEN
+            var__get_unt=fct_split(cl_tmp,2,'=')
+            EXIT
+         ENDIF
          ji=ji+1
          cl_tmp=fct_split(cd_varinfo,ji,';')         
       ENDDO
 
-   END FUNCTION var__get_filter
+      IF( TRIM(var__get_unt) /= '' )THEN
+         CALL logger_debug("VAR GET UNIT: will use units "//&
+            &  TRIM(var__get_unt)//" for variable "//&
+            &  TRIM(cd_name) )
+      ENDIF
+
+   END FUNCTION var__get_unt
    !-------------------------------------------------------------------
    !> @brief 
@@ -7227,5 +7975,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_var array of variable structure
@@ -7285,5 +8033,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var variable structure
@@ -7321,4 +8069,55 @@
    !-------------------------------------------------------------------
    !> @brief
+   !> This subroutine replace unit name of the variable,
+   !> and apply unit factor to the value of this variable.
+   !> 
+   !> @details
+   !> new unit name (unt) and unit factor (unf) are read from the namelist.
+   !>
+   !> @note the variable value should be already read.
+   !>
+   !> @author J.Paul
+   !> @date June, 2015 - Initial Version
+   !
+   !> @param[inout] td_var variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var_chg_unit( td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      TYPE(TATT)                :: tl_att
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         !- change value
+         IF( td_var%d_unf /= 1._dp )THEN
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+               td_var%d_value(:,:,:,:)=td_var%d_value(:,:,:,:)*td_var%d_unf
+            END WHERE
+
+            !- change scale factor and offset to avoid mistake
+            tl_att=att_init('scale_factor',1)
+            CALL var_move_att(td_var, tl_att)
+
+            tl_att=att_init('add_offset',0)
+            CALL var_move_att(td_var, tl_att)
+         ENDIF
+
+         !- change unit name 
+         IF( TRIM(td_var%c_unt) /= TRIM(td_var%c_units) .AND. &
+         &   TRIM(td_var%c_unt) /= '' )THEN
+            tl_att=att_init('units',TRIM(td_var%c_unt))
+            CALL var_move_att(td_var,tl_att)
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE var_chg_unit
+   !-------------------------------------------------------------------
+   !> @brief
    !> This subroutine check variable dimension expected, as defined in
    !> file 'variable.cfg'.
@@ -7329,5 +8128,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[inout] td_var    variable structure
@@ -7414,5 +8213,7 @@
    !> 
    !> @author J.Paul
-   !> - August, 2014- Initial Version
+   !> @date August, 2014 - Initial Version
+   !> @date July 2015 
+   !> - do not use dim_disorder anymore
    !
    !> @param[inout] td_var       variable structure
@@ -7438,7 +8239,9 @@
       IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder))
 
+      CALL logger_debug("VAR REORDER: work on "//TRIM(td_var%c_name)//&
+         &  " new dimension order "//TRIM(cl_dimorder))
+
       tl_dim(:)=dim_copy(td_var%t_dim(:))
 
-      CALL dim_unorder(tl_dim(:))
       CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder))
 
@@ -7467,5 +8270,5 @@
    !> 
    !> @author J.Paul
-   !> - September, 2014- Initial Version
+   !> @date September, 2014 - Initial Version
    !
    !> @param[in] td_var array of variable structure 
@@ -7492,5 +8295,5 @@
    !> 
    !> @author J.Paul
-   !> - November, 2014- Initial Version
+   !> @date November, 2014 - Initial Version
    !
    !> @param[in] td_var time variable structure 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/vgrid.f90
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/vgrid.f90	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/src/vgrid.f90	(revision 5682)
@@ -70,4 +70,5 @@
 !> @date Spetember, 2014
 !> - add header
+!> @date June, 2015 - update subroutine with NEMO 3.6
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -118,5 +119,5 @@
    !>
    !> @author G. Madec
-   !> - 03,08-  G. Madec: F90: Free form and module
+   !> @date Marsh,2008 - F90: Free form and module
    !
    !> @note Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
@@ -139,4 +140,5 @@
    !-------------------------------------------------------------------
    SUBROUTINE vgrid_zgr_z( dd_gdepw, dd_gdept, dd_e3w, dd_e3t,          &
+   &                       dd_e3w_1d, dd_e3t_1d, &
    &                       dd_ppkth, dd_ppkth2, dd_ppacr, dd_ppacr2,    &
    &                       dd_ppdzmin, dd_pphmax, dd_pp_to_be_computed, &
@@ -148,4 +150,6 @@
       REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3w
       REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3t
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3w_1d
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3t_1d
 
       REAL(dp)              , INTENT(IN   ) :: dd_ppkth
@@ -226,5 +230,5 @@
          DO jk = 1, il_jpk
             dl_zw = REAL(jk,dp)
-            dl_zt = REAL(jk,dp) + 0.5
+            dl_zt = REAL(jk,dp) + 0.5_dp
             dd_gdepw(jk) = ( dl_zw - 1.0 ) * dl_za1
             dd_gdept(jk) = ( dl_zt - 1.0 ) * dl_za1
@@ -237,5 +241,5 @@
          DO jk = 1, il_jpk
             dl_zw = REAL( jk,dp)
-            dl_zt = REAL( jk,dp) + 0.5
+            dl_zt = REAL( jk,dp) + 0.5_dp
             dd_gdepw(jk) = ( dl_zsur + dl_za0 * dl_zw + &
             &                dl_za1 * dl_zacr * LOG( COSH( (dl_zw-dl_zkth)/dl_zacr ) ) + &
@@ -255,4 +259,17 @@
       ENDIF
 
+   ! need to be like this to compute the pressure gradient with ISF.
+   ! If not, level beneath the ISF are not aligned (sum(e3t) /= depth)
+   ! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively
+      DO jk = 1, il_jpk-1
+         dd_e3t_1d(jk) = dd_gdepw(jk+1)-dd_gdepw(jk) 
+      END DO
+      dd_e3t_1d(il_jpk) = dd_e3t_1d(il_jpk-1) ! we don't care because this level is masked in NEMO
+
+      DO jk = 2, il_jpk
+         dd_e3w_1d(jk) = dd_gdept(jk) - dd_gdept(jk-1) 
+      END DO
+      dd_e3w_1d(1  ) = 2._dp * (dd_gdept(1) - dd_gdepw(1))
+
       ! Control and  print
       ! ==================
@@ -260,6 +277,10 @@
       DO jk = 1, il_jpk
          IF( dd_e3w(jk)  <= 0. .OR. dd_e3t(jk)  <= 0. )then
-            CALL logger_debug("VGRID ZGR Z: e3w or e3t =< 0 ")
+            CALL logger_debug("VGRID ZGR Z: e3w or e3t <= 0 ")
          ENDIF   
+
+         IF( dd_e3w_1d(jk)  <= 0. .OR. dd_e3t_1d(jk)  <= 0. )then
+            CALL logger_debug("VGRID ZGR Z: e3w_1d or e3t_1d <= 0 ")
+         ENDIF
 
          IF( dd_gdepw(jk) < 0. .OR. dd_gdept(jk) < 0. )then
@@ -269,4 +290,43 @@
 
    END SUBROUTINE vgrid_zgr_z
+   !-------------------------------------------------------------------
+   !-------------------------------------------------------------------
+   SUBROUTINE vgrid_zgr_bat( dd_bathy, dd_gdepw, dd_hmin, dd_fill )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_bathy 
+      REAL(dp), DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw 
+      REAL(dp)                , INTENT(IN   ) :: dd_hmin
+      REAL(dp)                , INTENT(IN   ), OPTIONAL :: dd_fill
+
+      ! local
+      INTEGER(i4) :: il_jpk
+      
+      REAL(dp)    :: dl_hmin
+      REAL(dp)    :: dl_fill
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      il_jpk = SIZE(dd_gdepw(:))
+
+      dl_fill=0._dp
+      IF( PRESENT(dd_fill) ) dl_fill=dd_fill
+
+      IF( dd_hmin < 0._dp ) THEN
+         jk = - INT( dd_hmin )     ! from a nb of level
+      ELSE
+         jk = MINLOC( dd_gdepw, mask = dd_gdepw > dd_hmin, dim = 1 )  ! from a depth
+      ENDIF
+      
+      dl_hmin = dd_gdepw(jk+1) ! minimum depth = ik+1 w-levels 
+      WHERE( dd_bathy(:,:) <= 0._wp .OR. dd_bathy(:,:) == dl_fill )
+         dd_bathy(:,:) = dl_fill                         ! min=0     over the lands
+      ELSE WHERE
+         dd_bathy(:,:) = MAX(  dl_hmin , dd_bathy(:,:)  )   ! min=dl_hmin over the oceans
+      END WHERE
+      WRITE(*,*) 'Minimum ocean depth: ', dl_hmin, ' minimum number of ocean levels : ', jk      
+
+   END SUBROUTINE vgrid_zgr_bat
    !-------------------------------------------------------------------
    !> @brief This subroutine set the depth and vertical scale factor in partial step
@@ -313,6 +373,7 @@
    !
    !> @author A. Bozec, G. Madec
-   !> - 02-09 (A. Bozec, G. Madec) F90: Free form and module
-   !> - 02-09 (A. de Miranda)  rigid-lid + islands
+   !> @date February, 2009 - F90: Free form and module
+   !> @date February, 2009 
+   !> - A. de Miranda : rigid-lid + islands
    !>
    !> @note Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
@@ -327,6 +388,7 @@
    !-------------------------------------------------------------------
    SUBROUTINE vgrid_zgr_zps( id_mbathy, dd_bathy, id_jpkmax, &
-   &                         dd_gdepw, dd_e3t,               &
-   &                         dd_e3zps_min, dd_e3zps_rat )
+   &                          dd_gdepw, dd_e3t,               &
+   &                          dd_e3zps_min, dd_e3zps_rat,     &
+   &                          dd_fill )
       IMPLICIT NONE
       ! Argument      
@@ -336,11 +398,13 @@
       REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw
       REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_e3t
-      REAL(dp)                                   :: dd_e3zps_min
-      REAL(dp)                                   :: dd_e3zps_rat
+      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_min
+      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_rat
+      REAL(dp)                   , INTENT(IN   ), OPTIONAL :: dd_fill
 
       ! local variable
       REAL(dp) :: dl_zmax     ! Maximum depth
-      REAL(dp) :: dl_zmin     ! Minimum depth
+      !REAL(dp) :: dl_zmin     ! Minimum depth
       REAL(dp) :: dl_zdepth   ! Ajusted ocean depth to avoid too small e3t 
+      REAL(dp) :: dl_fill     
 
       INTEGER(i4) :: il_jpk
@@ -359,7 +423,14 @@
       il_jpjglo=SIZE(id_mbathy(:,:),DIM=2)
 
+      dl_fill=0._dp
+      IF( PRESENT(dd_fill) ) dl_fill=dd_fill
+
       ! Initialization of constant
-      dl_zmax = dd_gdepw(il_jpk) + dd_e3t(il_jpk)
-      dl_zmin = dd_gdepw(4)
+      dl_zmax = dd_gdepw(il_jpk) + dd_e3t(il_jpk) ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
+
+      ! bounded value of bathy (min already set at the end of zgr_bat)
+      WHERE( dd_bathy(:,:) /= dl_fill )
+         dd_bathy(:,:) = MIN( dl_zmax ,  dd_bathy(:,:) )
+      END WHERE
 
       ! bathymetry in level (from bathy_meter)
@@ -372,19 +443,8 @@
       DO jj = 1, il_jpjglo
          DO ji= 1, il_jpiglo
-            IF( dd_bathy(ji,jj) <= 0. )   id_mbathy(ji,jj) = INT(dd_bathy(ji,jj),i4)
-         END DO
-      END DO
-
-      ! bounded value of bathy
-      ! minimum depth == 3 levels
-      ! maximum depth == gdepw(jpk)+e3t(jpk) 
-      ! i.e. the last ocean level thickness cannot exceed e3t(jpkm1)+e3t(jpk)
-      DO jj = 1, il_jpjglo
-         DO ji= 1, il_jpiglo
-            IF( dd_bathy(ji,jj) <= 0. ) THEN
-               dd_bathy(ji,jj) = 0.e0
-            ELSE
-               dd_bathy(ji,jj) = MAX( dd_bathy(ji,jj), dl_zmin )
-               dd_bathy(ji,jj) = MIN( dd_bathy(ji,jj), dl_zmax )
+            IF( dd_bathy(ji,jj) <= 0._dp )THEN
+               id_mbathy(ji,jj) = INT(dd_bathy(ji,jj),i4)
+            ELSEIF( dd_bathy(ji,jj) == dl_fill )THEN
+               id_mbathy(ji,jj) = 0_i4
             ENDIF
          END DO
@@ -401,5 +461,8 @@
          DO jj = 1, il_jpjglo
             DO ji = 1, il_jpiglo
-               IF( 0. < dd_bathy(ji,jj) .AND. dd_bathy(ji,jj) <= dl_zdepth ) id_mbathy(ji,jj) = jk-1
+               IF( dd_bathy(ji,jj) /= dl_fill )THEN
+                  IF( 0. < dd_bathy(ji,jj) .AND. &
+                  &       dd_bathy(ji,jj) <= dl_zdepth ) id_mbathy(ji,jj) = jk-1
+               ENDIF
             END DO
          END DO
@@ -434,5 +497,5 @@
 
    !> @author G.Madec
-   !> - 03-08 Original code
+   !> @date Marsh, 2008 - Original code
    !
    !> @param[in] id_mbathy 
@@ -543,5 +606,5 @@
    !>
    !> @author J.Paul
-   !> - November, 2013- Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] td_bathy     Bathymetry file structure 
@@ -567,4 +630,6 @@
       REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w 
       REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w_1d 
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t_1d
 
       INTEGER(i4)                                  :: il_status
@@ -710,5 +775,7 @@
       ALLOCATE( dl_gdepw(in_nlevel), dl_gdept(in_nlevel) ) 
       ALLOCATE(   dl_e3w(in_nlevel),   dl_e3t(in_nlevel) ) 
+      ALLOCATE(   dl_e3w_1d(in_nlevel),   dl_e3t_1d(in_nlevel) ) 
       CALL vgrid_zgr_z( dl_gdepw(:), dl_gdept(:), dl_e3w(:), dl_e3t(:), &
+      &                 dl_e3w_1d, dl_e3t_1d, &
       &                 dn_ppkth, dn_ppkth2, dn_ppacr, dn_ppacr2,       &
       &                 dn_ppdzmin, dn_pphmax, dn_pp_to_be_computed,    &
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam	(revision 5682)
@@ -19,6 +19,6 @@
 
 &namvar
+   cn_varfile=
    cn_varinfo=
-   cn_varfile=
 /
 
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam	(revision 5682)
@@ -60,8 +60,9 @@
    cn_west  = 
    ln_oneseg= 
-   in_extrap= 
 /
 
 &namout
    cn_fileout="boundary_out.nc"      
+   dn_dayofs=
+   ln_extrap=
 /
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam	(revision 5682)
@@ -12,4 +12,10 @@
    cn_coord0=
    in_perio0=
+/
+
+&namfin
+   cn_coord1=
+   cn_bathy1=
+   in_perio1=
 /
 
@@ -34,11 +40,4 @@
 /
 
-&namfin
-   cn_coord1=
-   cn_bathy1=
-   in_perio1=
-   in_extrap=
-/
-
 &namvar
    cn_varinfo=
@@ -53,3 +52,8 @@
 &namout
    cn_fileout="restart_out.nc"      
+   ln_extrap=
+   in_nipro=
+   in_njproc=
+   in_nproc=
+   cn_type=
 /
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-amm12.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-amm12.cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-amm12.cfg	(revision 5682)
@@ -1,2 +1,2 @@
 preprocess.prop{fpp.defs} = \
-  key_bdy key_tide key_vectopt_loop key_amm_12km key_dynspg_ts key_ldfslp key_zdfgls key_vvl key_diainstant key_mpp_mpi key_iomput
+  key_bdy key_tide key_dynspg_ts key_ldfslp key_zdfgls key_vvl key_diainstant key_mpp_mpi key_iomput
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-gyre.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-gyre.cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-gyre.cfg	(revision 5682)
@@ -1,2 +1,2 @@
 preprocess.prop{fpp.defs} = \
-  key_gyre key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi
+  key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_nosignedzero
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-gyre_pisces.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-gyre_pisces.cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-gyre_pisces.cfg	(revision 5682)
@@ -1,2 +1,2 @@
 preprocess.prop{fpp.defs} = \
-  key_gyre key_dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi
+  key_dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_lim.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_lim.cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_lim.cfg	(revision 5682)
@@ -1,2 +1,2 @@
 preprocess.prop{fpp.defs} = \
-  key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi
+  key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_asminc
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_lim3.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_lim3.cfg	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_lim3.cfg	(revision 5682)
@@ -0,0 +1,2 @@
+preprocess.prop{fpp.defs} = \
+  key_trabbl key_lim3 key_vvl key_dynspg_ts key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_asminc
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_lim_cfc.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_lim_cfc.cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_lim_cfc.cfg	(revision 5682)
@@ -1,2 +1,2 @@
 preprocess.prop{fpp.defs} = \
-  key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi
+  key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_lim_pisces.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_lim_pisces.cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_lim_pisces.cfg	(revision 5682)
@@ -1,2 +1,2 @@
 preprocess.prop{fpp.defs} = \
-  key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_iomput key_mpp_mpi
+  key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_iomput key_mpp_mpi
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_off_pisces.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_off_pisces.cfg	(revision 5659)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_off_pisces.cfg	(revision 5682)
@@ -1,2 +1,2 @@
 preprocess.prop{fpp.defs} = \
-  key_trabbl key_orca_r2 key_ldfslp key_traldf_c2d key_traldf_eiv key_top key_offline key_pisces key_iomput key_mpp_mpi
+  key_trabbl key_ldfslp key_traldf_c2d key_traldf_eiv key_top key_offline key_pisces key_iomput key_mpp_mpi
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_sam_lim.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_sam_lim.cfg	(revision 5659)
+++ 	(revision )
@@ -1,2 +1,0 @@
-preprocess.prop{fpp.defs} = \
-  key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi
Index: branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_sas_lim.cfg
===================================================================
--- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_sas_lim.cfg	(revision 5682)
+++ branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/fcm-make/inc/keys-orca2_sas_lim.cfg	(revision 5682)
@@ -0,0 +1,2 @@
+preprocess.prop{fpp.defs} = \
+  key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi
